diff options
Diffstat (limited to 'src/Hakyll/Web')
| -rw-r--r-- | src/Hakyll/Web/Feed.hs | 2 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc.hs | 33 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc/Biblio.hs | 4 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc/FileType.hs | 43 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 33 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/List.hs | 2 |
6 files changed, 81 insertions, 36 deletions
diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs index 794ded5..c5f8e0b 100644 --- a/src/Hakyll/Web/Feed.hs +++ b/src/Hakyll/Web/Feed.hs @@ -77,6 +77,8 @@ renderFeed feedPath itemPath config itemContext items = do itemContext' = mconcat [ constField "root" (feedRoot config) + , constField "authorName" (feedAuthorName config) + , constField "authorEmail" (feedAuthorEmail config) , itemContext ] diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs index 78df1df..f6e9ff1 100644 --- a/src/Hakyll/Web/Pandoc.hs +++ b/src/Hakyll/Web/Pandoc.hs @@ -26,6 +26,7 @@ import Control.Applicative ((<$>)) import qualified Data.Set as S import Data.Traversable (traverse) import Text.Pandoc +import Text.Pandoc.Error (PandocError (..)) -------------------------------------------------------------------------------- @@ -36,23 +37,33 @@ import Hakyll.Web.Pandoc.FileType -------------------------------------------------------------------------------- -- | Read a string using pandoc, with the default options -readPandoc :: Item String -- ^ String to read - -> Item Pandoc -- ^ Resulting document +readPandoc + :: Item String -- ^ String to read + -> Compiler (Item Pandoc) -- ^ Resulting document readPandoc = readPandocWith defaultHakyllReaderOptions -------------------------------------------------------------------------------- -- | Read a string using pandoc, with the supplied options -readPandocWith :: ReaderOptions -- ^ Parser options - -> Item String -- ^ String to read - -> Item Pandoc -- ^ Resulting document -readPandocWith ropt item = fmap (reader ropt (itemFileType item)) item +readPandocWith + :: ReaderOptions -- ^ Parser options + -> Item String -- ^ String to read + -> Compiler (Item Pandoc) -- ^ Resulting document +readPandocWith ropt item = + case traverse (reader ropt (itemFileType item)) item of + Left (ParseFailure err) -> fail $ + "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ err + Left (ParsecError _ err) -> fail $ + "Hakyll.Web.Pandoc.readPandocWith: parse failed: " ++ show err + Right item' -> return item' where reader ro t = case t of + DocBook -> readDocBook ro Html -> readHtml ro LaTeX -> readLaTeX ro LiterateHaskell t' -> reader (addExt ro Ext_literate_haskell) t' Markdown -> readMarkdown ro + MediaWiki -> readMediaWiki ro OrgMode -> readOrg ro Rst -> readRST ro Textile -> readTextile ro @@ -80,15 +91,17 @@ writePandocWith wopt = fmap $ writeHtmlString wopt -------------------------------------------------------------------------------- -- | Render the resource using pandoc -renderPandoc :: Item String -> Item String +renderPandoc :: Item String -> Compiler (Item String) renderPandoc = renderPandocWith defaultHakyllReaderOptions defaultHakyllWriterOptions -------------------------------------------------------------------------------- -- | Render the resource using pandoc -renderPandocWith :: ReaderOptions -> WriterOptions -> Item String -> Item String -renderPandocWith ropt wopt = writePandocWith wopt . readPandocWith ropt +renderPandocWith + :: ReaderOptions -> WriterOptions -> Item String -> Compiler (Item String) +renderPandocWith ropt wopt item = + writePandocWith wopt <$> readPandocWith ropt item -------------------------------------------------------------------------------- @@ -127,7 +140,7 @@ pandocCompilerWithTransformM :: ReaderOptions -> WriterOptions -> Compiler (Item String) pandocCompilerWithTransformM ropt wopt f = writePandocWith wopt <$> - (traverse f =<< readPandocWith ropt <$> getResourceBody) + (traverse f =<< readPandocWith ropt =<< getResourceBody) -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs index c85512f..53e3419 100644 --- a/src/Hakyll/Web/Pandoc/Biblio.hs +++ b/src/Hakyll/Web/Pandoc/Biblio.hs @@ -104,8 +104,8 @@ readPandocBiblio ropt csl biblio item = do -- actual page. If we don't do this, pandoc won't even consider them -- citations! let Biblio refs = itemBody biblio - pandoc = itemBody $ readPandocWith ropt item - pandoc' = processCites style refs pandoc + pandoc <- itemBody <$> readPandocWith ropt item + let pandoc' = processCites style refs pandoc return $ fmap (const pandoc') item diff --git a/src/Hakyll/Web/Pandoc/FileType.hs b/src/Hakyll/Web/Pandoc/FileType.hs index 46c8e24..3636e41 100644 --- a/src/Hakyll/Web/Pandoc/FileType.hs +++ b/src/Hakyll/Web/Pandoc/FileType.hs @@ -22,10 +22,12 @@ import Hakyll.Core.Item data FileType = Binary | Css + | DocBook | Html | LaTeX | LiterateHaskell FileType | Markdown + | MediaWiki | OrgMode | PlainText | Rst @@ -38,29 +40,32 @@ data FileType fileType :: FilePath -> FileType fileType = uncurry fileType' . splitExtension where - fileType' _ ".css" = Css - fileType' _ ".htm" = Html - fileType' _ ".html" = Html - fileType' f ".lhs" = LiterateHaskell $ case fileType f of + fileType' _ ".css" = Css + fileType' _ ".dbk" = DocBook + fileType' _ ".htm" = Html + fileType' _ ".html" = Html + fileType' f ".lhs" = LiterateHaskell $ case fileType f of -- If no extension is given, default to Markdown + LiterateHaskell Binary -> Markdown -- Otherwise, LaTeX + LiterateHaskell or whatever the user specified x -> x - fileType' _ ".markdown" = Markdown - fileType' _ ".md" = Markdown - fileType' _ ".mdn" = Markdown - fileType' _ ".mdown" = Markdown - fileType' _ ".mdwn" = Markdown - fileType' _ ".mkd" = Markdown - fileType' _ ".mkdwn" = Markdown - fileType' _ ".org" = OrgMode - fileType' _ ".page" = Markdown - fileType' _ ".rst" = Rst - fileType' _ ".tex" = LaTeX - fileType' _ ".text" = PlainText - fileType' _ ".textile" = Textile - fileType' _ ".txt" = PlainText - fileType' _ _ = Binary -- Treat unknown files as binary + fileType' _ ".markdown" = Markdown + fileType' _ ".mediawiki" = MediaWiki + fileType' _ ".md" = Markdown + fileType' _ ".mdn" = Markdown + fileType' _ ".mdown" = Markdown + fileType' _ ".mdwn" = Markdown + fileType' _ ".mkd" = Markdown + fileType' _ ".mkdwn" = Markdown + fileType' _ ".org" = OrgMode + fileType' _ ".page" = Markdown + fileType' _ ".rst" = Rst + fileType' _ ".tex" = LaTeX + fileType' _ ".text" = PlainText + fileType' _ ".textile" = Textile + fileType' _ ".txt" = PlainText + fileType' _ ".wiki" = MediaWiki + fileType' _ _ = Binary -- Treat unknown files as binary -------------------------------------------------------------------------------- diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs index 2da76d4..a0f2779 100644 --- a/src/Hakyll/Web/Template/Context.hs +++ b/src/Hakyll/Web/Template/Context.hs @@ -4,6 +4,7 @@ module Hakyll.Web.Template.Context ( ContextField (..) , Context (..) , field + , boolField , constField , listField , listFieldWith @@ -22,12 +23,13 @@ module Hakyll.Web.Template.Context , modificationTimeField , modificationTimeFieldWith , teaserField + , teaserFieldWithSeparator , missingField ) where -------------------------------------------------------------------------------- -import Control.Applicative (Alternative (..), (<$>)) +import Control.Applicative (Alternative (..), (<$>), pure) import Control.Monad (msum) import Data.List (intercalate) import qualified Data.Map as M @@ -35,7 +37,7 @@ import Data.Monoid (Monoid (..)) import Data.Time.Clock (UTCTime (..)) import Data.Time.Format (formatTime, parseTime) import System.FilePath (takeBaseName, splitDirectories) -import System.Locale (TimeLocale, defaultTimeLocale) +import Data.Time.Locale.Compat (TimeLocale, defaultTimeLocale) -------------------------------------------------------------------------------- @@ -98,6 +100,17 @@ field key value = field' key (fmap StringField . value) -------------------------------------------------------------------------------- +-- | Creates a 'field' to use with the @$if()$@ template macro. +boolField + :: String + -> (Item a -> Bool) + -> Context a +boolField name f = field name (\i -> if f i + then pure (error $ unwords ["no string value for bool field:",name]) + else empty) + + +-------------------------------------------------------------------------------- -- | Creates a 'field' that does not depend on the 'Item' constField :: String -> String -> Context a constField key = field key . const . return @@ -306,9 +319,21 @@ modificationTimeFieldWith locale key fmt = field key $ \i -> do teaserField :: String -- ^ Key to use -> Snapshot -- ^ Snapshot to load -> Context String -- ^ Resulting context -teaserField key snapshot = field key $ \item -> do +teaserField = teaserFieldWithSeparator teaserSeparator + + +-------------------------------------------------------------------------------- +-- | A context with "teaser" key which contain a teaser of the item, defined as +-- the snapshot content before the teaser separator. The item is loaded from the +-- given snapshot (which should be saved in the user code before any templates +-- are applied). +teaserFieldWithSeparator :: String -- ^ Separator to use + -> String -- ^ Key to use + -> Snapshot -- ^ Snapshot to load + -> Context String -- ^ Resulting context +teaserFieldWithSeparator separator key snapshot = field key $ \item -> do body <- itemBody <$> loadSnapshot (itemIdentifier item) snapshot - case needlePrefix teaserSeparator body of + case needlePrefix separator body of Nothing -> fail $ "Hakyll.Web.Template.Context: no teaser defined for " ++ show (itemIdentifier item) diff --git a/src/Hakyll/Web/Template/List.hs b/src/Hakyll/Web/Template/List.hs index 1f2a570..4d769fc 100644 --- a/src/Hakyll/Web/Template/List.hs +++ b/src/Hakyll/Web/Template/List.hs @@ -22,7 +22,7 @@ module Hakyll.Web.Template.List import Control.Monad (liftM) import Data.List (intersperse, sortBy) import Data.Ord (comparing) -import System.Locale (defaultTimeLocale) +import Data.Time.Locale.Compat (defaultTimeLocale) -------------------------------------------------------------------------------- |