diff options
Diffstat (limited to 'src/Hakyll')
| -rw-r--r-- | src/Hakyll/Core/Compiler.hs | 24 | ||||
| -rw-r--r-- | src/Hakyll/Core/ResourceProvider/Metadata.hs | 16 | ||||
| -rw-r--r-- | src/Hakyll/Web/Blaze.hs | 35 | ||||
| -rw-r--r-- | src/Hakyll/Web/Feed.hs | 1 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page.hs | 109 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page/Internal.hs | 50 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page/List.hs | 1 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page/Metadata.hs | 10 | ||||
| -rw-r--r-- | src/Hakyll/Web/Page/Read.hs | 61 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc.hs | 85 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc/Biblio.hs | 26 | ||||
| -rw-r--r-- | src/Hakyll/Web/Pandoc/FileType.hs | 23 | ||||
| -rw-r--r-- | src/Hakyll/Web/Tags.hs | 1 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template.hs | 43 | ||||
| -rw-r--r-- | src/Hakyll/Web/Template/Context.hs | 33 | ||||
| -rw-r--r-- | src/Hakyll/Web/Urls/Relativize.hs | 36 |
16 files changed, 212 insertions, 342 deletions
diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs index 840f3bd..ee3f90e 100644 --- a/src/Hakyll/Core/Compiler.hs +++ b/src/Hakyll/Core/Compiler.hs @@ -95,6 +95,7 @@ module Hakyll.Core.Compiler , getIdentifier , getRoute , getRouteFor + , getResourceBody , getResourceString , getResourceLBS , getResourceWith @@ -190,25 +191,36 @@ getRouteFor = fromJob $ \identifier -> CompilerM $ do routes <- compilerRoutes <$> ask return $ runRoutes routes identifier + +-------------------------------------------------------------------------------- +-- | Get the body of the underlying resource +getResourceBody :: Compiler a String +getResourceBody = getResourceWith resourceBody + + + +-------------------------------------------------------------------------------- -- | Get the resource we are compiling as a string --- getResourceString :: Compiler a String -getResourceString = getResourceWith resourceString +getResourceString = getResourceWith $ const resourceString + +-------------------------------------------------------------------------------- -- | Get the resource we are compiling as a lazy bytestring -- getResourceLBS :: Compiler a ByteString -getResourceLBS = getResourceWith resourceLBS +getResourceLBS = getResourceWith $ const resourceLBS + +-------------------------------------------------------------------------------- -- | Overloadable function for 'getResourceString' and 'getResourceLBS' --- -getResourceWith :: (Identifier a -> IO b) -> Compiler c b +getResourceWith :: (ResourceProvider -> Identifier a -> IO b) -> Compiler c b getResourceWith reader = fromJob $ \_ -> CompilerM $ do provider <- compilerResourceProvider <$> ask r <- compilerIdentifier <$> ask let filePath = toFilePath r if resourceExists provider r - then liftIO $ reader $ castIdentifier r + then liftIO $ reader provider $ castIdentifier r else throwError $ error' filePath where error' id' = "Hakyll.Core.Compiler.getResourceWith: resource " diff --git a/src/Hakyll/Core/ResourceProvider/Metadata.hs b/src/Hakyll/Core/ResourceProvider/Metadata.hs index e297f2c..2b0615c 100644 --- a/src/Hakyll/Core/ResourceProvider/Metadata.hs +++ b/src/Hakyll/Core/ResourceProvider/Metadata.hs @@ -6,7 +6,7 @@ module Hakyll.Core.ResourceProvider.Metadata -------------------------------------------------------------------------------- -import Control.Applicative ((<$>), (<*), (<*>)) +import Control.Applicative import Control.Arrow (second) import qualified Data.ByteString.Char8 as BC import qualified Data.Map as M @@ -80,16 +80,22 @@ inlineSpace = P.oneOf ['\t', ' '] <?> "space" -------------------------------------------------------------------------------- +-- | Parse Windows newlines as well (i.e. "\n" or "\r\n") +newline :: Parser String +newline = P.string "\n" <|> P.string "\r\n" + + +-------------------------------------------------------------------------------- -- | Parse a single metadata field metadataField :: Parser (String, String) metadataField = do key <- P.manyTill P.alphaNum $ P.char ':' P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key - value <- P.manyTill P.anyChar P.newline + value <- P.manyTill P.anyChar newline trailing' <- P.many trailing return (key, trim $ value ++ concat trailing') where - trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar P.newline + trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar newline -------------------------------------------------------------------------------- @@ -102,11 +108,11 @@ metadata = P.many metadataField -- | Parse a metadata block, including delimiters and trailing newlines metadataBlock :: Parser [(String, String)] metadataBlock = do - open <- P.many1 (P.char '-') <* P.many inlineSpace <* P.newline + open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline metadata' <- metadata _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.'] P.skipMany inlineSpace - P.skipMany1 P.newline + P.skipMany1 newline return metadata' diff --git a/src/Hakyll/Web/Blaze.hs b/src/Hakyll/Web/Blaze.hs deleted file mode 100644 index 8a22585..0000000 --- a/src/Hakyll/Web/Blaze.hs +++ /dev/null @@ -1,35 +0,0 @@ --- | Module providing BlazeHtml support for hakyll --- -module Hakyll.Web.Blaze - ( getFieldHtml - , getFieldHtml' - , getBodyHtml - , getBodyHtml' - ) where - -import Text.Blaze.Html (Html, toHtml) -import Text.Blaze.Internal (preEscapedString) - -import Hakyll.Web.Page -import Hakyll.Web.Page.Metadata - --- | Get a field from a page and convert it to HTML. This version does not --- escape the given HTML --- -getFieldHtml :: String -> Page a -> Html -getFieldHtml key = preEscapedString . getField key - --- | Version of 'getFieldHtml' that escapes the HTML content --- -getFieldHtml' :: String -> Page a -> Html -getFieldHtml' key = toHtml . getField key - --- | Get the body as HTML --- -getBodyHtml :: Page String -> Html -getBodyHtml = preEscapedString . pageBody - --- | Version of 'getBodyHtml' that escapes the HTML content --- -getBodyHtml' :: Page String -> Html -getBodyHtml' = toHtml . pageBody diff --git a/src/Hakyll/Web/Feed.hs b/src/Hakyll/Web/Feed.hs index 218f28c..2cb3292 100644 --- a/src/Hakyll/Web/Feed.hs +++ b/src/Hakyll/Web/Feed.hs @@ -1,3 +1,4 @@ +-- TODO: port -- | A Module that allows easy rendering of RSS feeds. -- -- The main rendering functions (@renderRss@, @renderAtom@) all assume that diff --git a/src/Hakyll/Web/Page.hs b/src/Hakyll/Web/Page.hs index 7f2430f..fc17735 100644 --- a/src/Hakyll/Web/Page.hs +++ b/src/Hakyll/Web/Page.hs @@ -1,3 +1,4 @@ +-------------------------------------------------------------------------------- -- | A page is a key-value mapping, representing a page on your site -- -- A page is an important concept in Hakyll. It is a key-value mapping, and has @@ -47,109 +48,57 @@ -- we simply list all @key: value@ pairs, and end with @---@ again. This page -- contains three metadata fields and a body. The body is given in markdown -- format, which can be easily rendered to HTML by Hakyll, using pandoc. --- -{-# LANGUAGE DeriveDataTypeable #-} module Hakyll.Web.Page - ( Page (..) - , fromBody - , fromMap - , toMap + ( Page , readPageCompiler , pageCompiler , pageCompilerWith , pageCompilerWithPandoc - , pageCompilerWithFields - , addDefaultFields ) where -import Prelude hiding (id) -import Control.Category (id) -import Control.Arrow (arr, (>>^), (&&&), (>>>)) -import System.FilePath (takeBaseName, takeDirectory) -import qualified Data.Map as M -import Text.Pandoc (Pandoc, ParserState, WriterOptions) +-------------------------------------------------------------------------------- +import Control.Arrow (arr, (>>>)) +import Control.Category (id) +import Prelude hiding (id) +import Text.Pandoc (Pandoc, ParserState, WriterOptions) -import Hakyll.Core.Identifier -import Hakyll.Core.Compiler -import Hakyll.Web.Page.Internal -import Hakyll.Web.Page.Read -import Hakyll.Web.Page.Metadata -import Hakyll.Web.Pandoc -import Hakyll.Web.Template -import Hakyll.Web.Urls --- | Create a page from a body, without metadata --- -fromBody :: a -> Page a -fromBody = Page M.empty +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler +import Hakyll.Web.Page.Internal +import Hakyll.Web.Pandoc + +-------------------------------------------------------------------------------- -- | Read a page (do not render it) --- -readPageCompiler :: Compiler () (Page String) -readPageCompiler = getResourceString >>^ readPage +readPageCompiler :: Compiler () Page +readPageCompiler = getResourceBody +{-# DEPRECATED readPageCompiler "Use getResourceBody" #-} --- | Read a page, add default fields, substitute fields and render using pandoc --- -pageCompiler :: Compiler () (Page String) + +-------------------------------------------------------------------------------- +-- | Read a page render using pandoc +pageCompiler :: Compiler () Page pageCompiler = pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions + +-------------------------------------------------------------------------------- -- | A version of 'pageCompiler' which allows you to specify your own pandoc -- options --- -pageCompilerWith :: ParserState -> WriterOptions - -> Compiler () (Page String) +pageCompilerWith :: ParserState -> WriterOptions -> Compiler () Page pageCompilerWith state options = pageCompilerWithPandoc state options id + +-------------------------------------------------------------------------------- -- | An extension of 'pageCompilerWith' which allows you to specify a custom --- pandoc transformer for the content --- +-- pandoc transformation for the content pageCompilerWithPandoc :: ParserState -> WriterOptions -> (Pandoc -> Pandoc) - -> Compiler () (Page String) + -> Compiler () Page pageCompilerWithPandoc state options f = cached cacheName $ - readPageCompiler >>> addDefaultFields >>> arr applySelf - >>> pageReadPandocWith state - >>> arr (fmap (writePandocWith options . f)) + readPageCompiler >>> pageReadPandocWith state >>> + arr (writePandocWith options . f) where cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc" - --- | This is another, even more advanced version of 'pageCompilerWithPandoc'. --- This function allows you to provide an arrow which is applied before the --- fields in a page are rendered. This means you can use this extra customizable --- stage to add custom fields which are inserted in the page. --- -pageCompilerWithFields :: ParserState -> WriterOptions - -> (Pandoc -> Pandoc) - -> Compiler (Page String) (Page String) - -> Compiler () (Page String) -pageCompilerWithFields state options f g = - readPageCompiler >>> addDefaultFields >>> g >>> arr applySelf - >>> pageReadPandocWith state - >>> arr (fmap (writePandocWith options . f)) - --- | Add a number of default metadata fields to a page. These fields include: --- --- * @$url$@ --- --- * @$category$@ --- --- * @$title$@ --- --- * @$path$@ --- -addDefaultFields :: Compiler (Page a) (Page a) -addDefaultFields = (getRoute &&& id >>^ uncurry addRoute) - >>> (getIdentifier &&& id >>^ uncurry addIdentifier) - where - -- Add root and url, based on route - addRoute Nothing = id - addRoute (Just r) = trySetField "url" (toUrl r) - - -- Add title and category, based on identifier - addIdentifier i = trySetField "title" (takeBaseName p) - . trySetField "category" (takeBaseName $ takeDirectory p) - . trySetField "path" p - where - p = toFilePath i diff --git a/src/Hakyll/Web/Page/Internal.hs b/src/Hakyll/Web/Page/Internal.hs index 55067ed..04cf08a 100644 --- a/src/Hakyll/Web/Page/Internal.hs +++ b/src/Hakyll/Web/Page/Internal.hs @@ -1,50 +1,8 @@ --- | Internal representation of the page datatype --- -{-# LANGUAGE DeriveDataTypeable #-} +-------------------------------------------------------------------------------- module Hakyll.Web.Page.Internal - ( Page (..) - , fromMap - , toMap + ( Page ) where -import Control.Applicative ((<$>), (<*>)) -import Data.Monoid (Monoid, mempty, mappend) -import Data.Map (Map) -import Data.Binary (Binary, get, put) -import Data.Typeable (Typeable) -import qualified Data.Map as M - -import Hakyll.Core.Writable - --- | Type used to represent pages --- -data Page a = Page - { pageMetadata :: Map String String - , pageBody :: a - } deriving (Eq, Show, Typeable) - -instance Monoid a => Monoid (Page a) where - mempty = Page M.empty mempty - mappend (Page m1 b1) (Page m2 b2) = - Page (M.union m1 m2) (mappend b1 b2) - -instance Functor Page where - fmap f (Page m b) = Page m (f b) - -instance Binary a => Binary (Page a) where - put (Page m b) = put m >> put b - get = Page <$> get <*> get - -instance Writable a => Writable (Page a) where - write p (Page _ b) = write p b - --- | Create a metadata page, without a body --- -fromMap :: Monoid a => Map String String -> Page a -fromMap m = Page m mempty - --- | Convert a page to a map. The body will be placed in the @body@ key. --- -toMap :: Page String -> Map String String -toMap (Page m b) = M.insert "body" b m +-------------------------------------------------------------------------------- +type Page = String diff --git a/src/Hakyll/Web/Page/List.hs b/src/Hakyll/Web/Page/List.hs index 24721e7..20c178c 100644 --- a/src/Hakyll/Web/Page/List.hs +++ b/src/Hakyll/Web/Page/List.hs @@ -1,3 +1,4 @@ +-- TODO: Port -- | Provides an easy way to combine several pages in a list. The applications -- are obvious: -- diff --git a/src/Hakyll/Web/Page/Metadata.hs b/src/Hakyll/Web/Page/Metadata.hs index 8605aea..d9f330e 100644 --- a/src/Hakyll/Web/Page/Metadata.hs +++ b/src/Hakyll/Web/Page/Metadata.hs @@ -1,7 +1,8 @@ -- | Provides various functions to manipulate the metadata fields of a page --- +-- TODO: PORT module Hakyll.Web.Page.Metadata - ( getField + ( + {- getField , getFieldMaybe , setField , trySetField @@ -17,8 +18,10 @@ module Hakyll.Web.Page.Metadata , copyBodyToField , copyBodyFromField , comparePagesByDate + -} ) where +{- import Control.Arrow (Arrow, arr, (>>>), (***), (&&&)) import Control.Category (id) import Control.Monad (msum) @@ -209,7 +212,7 @@ renderModificationTimeWith :: TimeLocale -> Compiler (Page String) (Page String) -- ^ Resulting compiler renderModificationTimeWith locale key format = - id &&& (getResourceWith resourceModificationTime) >>> + id &&& (getResourceWith $ const resourceModificationTime) >>> setFieldA key (arr (formatTime locale format)) -- | Copy the body of a page to a metadata field @@ -233,3 +236,4 @@ comparePagesByDate :: Page a -> Page a -> Ordering comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale where zero = UTCTime (ModifiedJulianDay 0) 0 +-} diff --git a/src/Hakyll/Web/Page/Read.hs b/src/Hakyll/Web/Page/Read.hs deleted file mode 100644 index 40a4cd5..0000000 --- a/src/Hakyll/Web/Page/Read.hs +++ /dev/null @@ -1,61 +0,0 @@ --- | Module providing a function to parse a page from a file --- -module Hakyll.Web.Page.Read - ( readPage - ) where - -import Control.Applicative ((<$>), (<*>), (<*), (<|>)) -import qualified Data.Map as M - -import Text.Parsec.Char (alphaNum, anyChar, char, oneOf, string) -import Text.Parsec.Combinator (choice, many1, manyTill, option, skipMany1) -import Text.Parsec.Prim (many, parse, skipMany, (<?>)) -import Text.Parsec.String (Parser) - -import Hakyll.Core.Util.String -import Hakyll.Web.Page.Internal - --- | Space or tab, no newline -inlineSpace :: Parser Char -inlineSpace = oneOf ['\t', ' '] <?> "space" - --- | Parse Windows newlines as well (i.e. "\n" or "\r\n") -newline :: Parser String -newline = string "\n" -- Unix - <|> string "\r\n" -- DOS - --- | Parse a single metadata field --- -metadataField :: Parser (String, String) -metadataField = do - key <- manyTill alphaNum $ char ':' - skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key - value <- manyTill anyChar newline - trailing' <- many trailing - return (key, trim $ value ++ concat trailing') - where - trailing = (++) <$> many1 inlineSpace <*> manyTill anyChar newline - --- | Parse a metadata block, including delimiters and trailing newlines --- -metadata :: Parser [(String, String)] -metadata = do - open <- many1 (char '-') <* many inlineSpace <* newline - metadata' <- many metadataField - _ <- choice $ map (string . replicate (length open)) ['-', '.'] - skipMany inlineSpace - skipMany1 newline - return metadata' - --- | Parse a Hakyll page --- -page :: Parser ([(String, String)], String) -page = do - metadata' <- option [] metadata - body <- many anyChar - return (metadata', body) - -readPage :: String -> Page String -readPage input = case parse page "page" input of - Left err -> error (show err) - Right (md, b) -> Page (M.fromList md) b diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs index 8b0e0de..7ebf4a2 100644 --- a/src/Hakyll/Web/Pandoc.hs +++ b/src/Hakyll/Web/Pandoc.hs @@ -1,5 +1,5 @@ --- | Module exporting pandoc bindings --- +-------------------------------------------------------------------------------- +-- | Module exporting convenientpandoc bindings module Hakyll.Web.Pandoc ( -- * The basic building blocks readPandoc @@ -19,34 +19,38 @@ module Hakyll.Web.Pandoc , defaultHakyllWriterOptions ) where -import Prelude hiding (id) -import Control.Applicative ((<$>)) -import Control.Arrow ((>>>), (>>^), (&&&), (***)) -import Control.Category (id) -import Data.Maybe (fromMaybe) -import Text.Pandoc +-------------------------------------------------------------------------------- +import Control.Arrow ((&&&), (***), (>>>), (>>^)) +import Control.Category (id) +import Data.Maybe (fromMaybe) +import Prelude hiding (id) +import Text.Pandoc -import Hakyll.Core.Compiler -import Hakyll.Core.Identifier -import Hakyll.Core.Util.Arrow -import Hakyll.Web.Pandoc.FileType -import Hakyll.Web.Page.Internal +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler +import Hakyll.Core.Identifier +import Hakyll.Core.Util.Arrow +import Hakyll.Web.Page.Internal +import Hakyll.Web.Pandoc.FileType + + +-------------------------------------------------------------------------------- -- | Read a string using pandoc, with the default options --- readPandoc :: FileType -- ^ Determines how parsing happens -> Maybe (Identifier a) -- ^ Optional, for better error messages - -> String -- ^ String to read + -> Page -- ^ String to read -> Pandoc -- ^ Resulting document readPandoc = readPandocWith defaultHakyllParserState + +-------------------------------------------------------------------------------- -- | Read a string using pandoc, with the supplied options --- readPandocWith :: ParserState -- ^ Parser options -> FileType -- ^ Determines parsing method -> Maybe (Identifier a) -- ^ Optional, for better error messages - -> String -- ^ String to read + -> Page -- ^ String to read -> Pandoc -- ^ Resulting document readPandocWith state fileType' id' = case fileType' of Html -> readHtml state @@ -60,54 +64,60 @@ readPandocWith state fileType' id' = case fileType' of "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++ "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id') + +-------------------------------------------------------------------------------- -- | Write a document (as HTML) using pandoc, with the default options --- writePandoc :: Pandoc -- ^ Document to write - -> String -- ^ Resulting HTML + -> Page -- ^ Resulting HTML writePandoc = writePandocWith defaultHakyllWriterOptions + +-------------------------------------------------------------------------------- -- | Write a document (as HTML) using pandoc, with the supplied options --- writePandocWith :: WriterOptions -- ^ Writer options for pandoc -> Pandoc -- ^ Document to write - -> String -- ^ Resulting HTML + -> Page -- ^ Resulting HTML writePandocWith = writeHtmlString + +-------------------------------------------------------------------------------- -- | Read the resource using pandoc --- -pageReadPandoc :: Compiler (Page String) (Page Pandoc) +pageReadPandoc :: Compiler Page Pandoc pageReadPandoc = pageReadPandocWith defaultHakyllParserState + +-------------------------------------------------------------------------------- -- | Read the resource using pandoc --- -pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc) +pageReadPandocWith :: ParserState -> Compiler Page Pandoc pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA + +-------------------------------------------------------------------------------- -- | Read the resource using pandoc. This is a (rarely needed) variant, which -- comes in very useful when the parser state is the result of some arrow. --- -pageReadPandocWithA :: Compiler (ParserState, Page String) (Page Pandoc) +pageReadPandocWithA :: Compiler (ParserState, Page) Pandoc pageReadPandocWithA = id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA' where - pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) <$> p + pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) p + +-------------------------------------------------------------------------------- -- | Render the resource using pandoc --- -pageRenderPandoc :: Compiler (Page String) (Page String) +pageRenderPandoc :: Compiler Page Page pageRenderPandoc = pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions + +-------------------------------------------------------------------------------- -- | Render the resource using pandoc --- -pageRenderPandocWith :: ParserState - -> WriterOptions - -> Compiler (Page String) (Page String) +pageRenderPandocWith :: ParserState -> WriterOptions -> Compiler Page Page pageRenderPandocWith state options = - pageReadPandocWith state >>^ fmap (writePandocWith options) + pageReadPandocWith state >>^ writePandocWith options + +-------------------------------------------------------------------------------- -- | The default reader options for pandoc parsing in hakyll --- defaultHakyllParserState :: ParserState defaultHakyllParserState = defaultParserState { -- The following option causes pandoc to read smart typography, a nice @@ -115,8 +125,9 @@ defaultHakyllParserState = defaultParserState stateSmart = True } + +-------------------------------------------------------------------------------- -- | The default writer options for pandoc rendering in hakyll --- defaultHakyllWriterOptions :: WriterOptions defaultHakyllWriterOptions = defaultWriterOptions { -- This option causes literate haskell to be written using '>' marks in diff --git a/src/Hakyll/Web/Pandoc/Biblio.hs b/src/Hakyll/Web/Pandoc/Biblio.hs index 64a702b..699ba31 100644 --- a/src/Hakyll/Web/Pandoc/Biblio.hs +++ b/src/Hakyll/Web/Pandoc/Biblio.hs @@ -1,3 +1,4 @@ +-------------------------------------------------------------------------------- -- | Wraps pandocs bibiliography handling -- -- In order to add a bibliography, you will need a bibliography file (e.g. @@ -6,7 +7,6 @@ -- refer to these files when you use 'pageReadPandocBiblio'. This function also -- takes a parser state for completeness -- you can use -- 'defaultHakyllParserState' if you're unsure. --- {-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-} module Hakyll.Web.Pandoc.Biblio ( CSL @@ -16,30 +16,41 @@ module Hakyll.Web.Pandoc.Biblio , pageReadPandocBiblio ) where + +-------------------------------------------------------------------------------- import Control.Applicative ((<$>)) import Control.Arrow (arr, returnA, (>>>)) import Data.Typeable (Typeable) - import Data.Binary (Binary (..)) import Text.Pandoc (Pandoc, ParserState (..)) import Text.Pandoc.Biblio (processBiblio) import qualified Text.CSL as CSL + +-------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Identifier import Hakyll.Core.Writable import Hakyll.Web.Page import Hakyll.Web.Pandoc + +-------------------------------------------------------------------------------- newtype CSL = CSL FilePath deriving (Binary, Show, Typeable, Writable) + +-------------------------------------------------------------------------------- cslCompiler :: Compiler () CSL cslCompiler = getIdentifier >>> arr (CSL . toFilePath) + +-------------------------------------------------------------------------------- newtype Biblio = Biblio [CSL.Reference] deriving (Show, Typeable) + +-------------------------------------------------------------------------------- instance Binary Biblio where -- Ugly. get = Biblio . read <$> get @@ -48,14 +59,18 @@ instance Binary Biblio where instance Writable Biblio where write _ _ = return () + +-------------------------------------------------------------------------------- biblioCompiler :: Compiler () Biblio biblioCompiler = getIdentifier >>> arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio + +-------------------------------------------------------------------------------- pageReadPandocBiblio :: ParserState -> Identifier CSL -> Identifier Biblio - -> Compiler (Page String) (Page Pandoc) + -> Compiler Page Pandoc pageReadPandocBiblio state csl refs = proc page -> do CSL csl' <- require_ csl -< () Biblio refs' <- require_ refs -< () @@ -64,9 +79,8 @@ pageReadPandocBiblio state csl refs = proc page -> do -- citations! let cits = map CSL.refId refs' state' = state {stateCitations = stateCitations state ++ cits} - pandocPage <- pageReadPandocWithA -< (state', page) - let pandoc = pageBody pandocPage + pandoc <- pageReadPandocWithA -< (state', page) pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc) - returnA -< pandocPage {pageBody = pandoc'} + returnA -< pandoc' where processBiblio' (c, r, p) = processBiblio c Nothing r p diff --git a/src/Hakyll/Web/Pandoc/FileType.hs b/src/Hakyll/Web/Pandoc/FileType.hs index bde0e4e..db24da7 100644 --- a/src/Hakyll/Web/Pandoc/FileType.hs +++ b/src/Hakyll/Web/Pandoc/FileType.hs @@ -1,20 +1,25 @@ +-------------------------------------------------------------------------------- -- | A module dealing with pandoc file extensions and associated file types --- module Hakyll.Web.Pandoc.FileType ( FileType (..) , fileType , getFileType ) where -import System.FilePath (takeExtension) -import Control.Arrow ((>>^)) -import Hakyll.Core.Identifier -import Hakyll.Core.Compiler +-------------------------------------------------------------------------------- +import Control.Arrow ((>>^)) +import System.FilePath (takeExtension) + +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler +import Hakyll.Core.Identifier + + +-------------------------------------------------------------------------------- -- | Datatype to represent the different file types Hakyll can deal with by -- default --- data FileType = Binary | Css @@ -28,8 +33,9 @@ data FileType | Textile deriving (Eq, Ord, Show, Read) + +-------------------------------------------------------------------------------- -- | Get the file type for a certain file. The type is determined by extension. --- fileType :: FilePath -> FileType fileType = fileType' . takeExtension where @@ -53,7 +59,8 @@ fileType = fileType' . takeExtension fileType' ".txt" = PlainText fileType' _ = Binary -- Treat unknown files as binary + +-------------------------------------------------------------------------------- -- | Get the file type for the current file --- getFileType :: Compiler a FileType getFileType = getIdentifier >>^ fileType . toFilePath diff --git a/src/Hakyll/Web/Tags.hs b/src/Hakyll/Web/Tags.hs index 4ea2ca0..af3c3ba 100644 --- a/src/Hakyll/Web/Tags.hs +++ b/src/Hakyll/Web/Tags.hs @@ -1,3 +1,4 @@ +-- TODO: port -- | Module containing some specialized functions to deal with tags. -- This Module follows certain conventions. My advice is to stick with them if -- possible. diff --git a/src/Hakyll/Web/Template.hs b/src/Hakyll/Web/Template.hs index 5b7256a..e23b532 100644 --- a/src/Hakyll/Web/Template.hs +++ b/src/Hakyll/Web/Template.hs @@ -63,8 +63,6 @@ module Hakyll.Web.Template ( Template , applyTemplate - , applyTemplateToPage - , applySelf , templateCompiler , templateCompilerWith , applyTemplateCompiler @@ -76,16 +74,19 @@ import Control.Arrow import Control.Category (id) import qualified Data.Map as M import Data.Maybe (fromMaybe) +import Data.Tuple (swap) import Prelude hiding (id) import System.FilePath (takeExtension) import Text.Hamlet (HamletSettings, defaultHamletSettings) + -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Identifier import Hakyll.Core.Util.Arrow import Hakyll.Web.Page.Internal +import Hakyll.Web.Template.Context import Hakyll.Web.Template.Internal import Hakyll.Web.Template.Read @@ -94,12 +95,12 @@ import Hakyll.Web.Template.Read applyTemplate :: forall a b. (ArrowChoice a, ArrowMap a) => a (String, b) String -> a (Template, b) String -applyTemplate field = +applyTemplate context = arr (\(tpl, x) -> [(e, x) | e <- unTemplate tpl]) >>> mapA applyElement >>^ concat where applyElement :: a (TemplateElement, b) String - applyElement = unElement >>> (id ||| field) + applyElement = unElement >>> (id ||| context) unElement :: a (TemplateElement, b) (Either String (String, b)) unElement = arr $ \(e, x) -> case e of @@ -109,32 +110,15 @@ applyTemplate field = -------------------------------------------------------------------------------- --- | TODO: Remove -applyTemplateToPage :: Template -> Page String -> Page String -applyTemplateToPage tpl page = - fmap (const $ applyTemplate pageField (tpl, page)) page - where - pageField (k, p) = fromMaybe ("$" ++ k ++ "$") $ M.lookup k $ toMap p -{-# DEPRECATED applyTemplateToPage "Use applyTemplate" #-} - - --------------------------------------------------------------------------------- --- | Apply a page as it's own template. This is often very useful to fill in --- certain keys like @$root@ and @$url@. -applySelf :: Page String -> Page String -applySelf page = applyTemplateToPage (readTemplate $ pageBody page) page -{-# DEPRECATED applySelf "Use applyTemplate" #-} - - --------------------------------------------------------------------------------- -- | Read a template. If the extension of the file we're compiling is -- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed -- as such. templateCompiler :: Compiler () Template templateCompiler = templateCompilerWith defaultHamletSettings + +-------------------------------------------------------------------------------- -- | Version of 'templateCompiler' that enables custom settings. --- templateCompilerWith :: HamletSettings -> Compiler () Template templateCompilerWith settings = cached "Hakyll.Web.Template.templateCompilerWith" $ @@ -149,7 +133,12 @@ templateCompilerWith settings = -------------------------------------------------------------------------------- -applyTemplateCompiler :: Identifier Template -- ^ Template - -> Compiler (Page String) (Page String) -- ^ Compiler -applyTemplateCompiler identifier = require identifier $ - flip applyTemplateToPage +applyTemplateCompiler :: Identifier Template -- ^ Template + -> Context Page -- ^ Context + -> Compiler Page Page -- ^ Compiler +applyTemplateCompiler identifier context = requireA identifier $ + arr swap >>> applyTemplate context' + where + context' = proc (k, x) -> do + id' <- getIdentifier -< () + context -< (k, (id', x)) diff --git a/src/Hakyll/Web/Template/Context.hs b/src/Hakyll/Web/Template/Context.hs index 17db7ca..4273b79 100644 --- a/src/Hakyll/Web/Template/Context.hs +++ b/src/Hakyll/Web/Template/Context.hs @@ -13,60 +13,67 @@ module Hakyll.Web.Template.Context -------------------------------------------------------------------------------- -import Control.Applicative (empty, (<|>)) +import Control.Applicative (empty, (<|>)) import Control.Arrow -import System.FilePath (takeBaseName, takeDirectory) +import System.FilePath (takeBaseName, takeDirectory) -------------------------------------------------------------------------------- import Hakyll.Core.Compiler import Hakyll.Core.Identifier +import Hakyll.Web.Page.Internal import Hakyll.Web.Urls -------------------------------------------------------------------------------- -type Context a = Compiler (String, a) String +type Context a = Compiler (String, (Identifier a, a)) String -------------------------------------------------------------------------------- -field :: String -> Compiler a String -> Context a -field key value = arr checkKey >>> empty ||| value +field :: String -> Compiler (Identifier a, a) String -> Context a +field key value = arr checkKey >>> (empty ||| value) where checkKey (k, x) - | k == key = Left () + | k /= key = Left () | otherwise = Right x -------------------------------------------------------------------------------- -defaultContext :: Context (Identifier String, String) +defaultContext :: Context Page defaultContext = bodyField "body" <|> urlField "url" <|> pathField "path" <|> categoryField "category" <|> - titleField "title" + titleField "title" <|> + missingField -------------------------------------------------------------------------------- -bodyField :: String -> Context (Identifier String, String) +bodyField :: String -> Context Page bodyField key = field key $ arr snd -------------------------------------------------------------------------------- -urlField :: String -> Context (Identifier a, a) +urlField :: String -> Context a urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl -------------------------------------------------------------------------------- -pathField :: String -> Context (Identifier a, a) +pathField :: String -> Context a pathField key = field key $ arr $ toFilePath . fst -------------------------------------------------------------------------------- -categoryField :: String -> Context (Identifier a, a) +categoryField :: String -> Context a categoryField key = pathField key >>^ (takeBaseName . takeDirectory) -------------------------------------------------------------------------------- -titleField :: String -> Context (Identifier a, a) +titleField :: String -> Context a titleField key = pathField key >>^ takeBaseName + + +-------------------------------------------------------------------------------- +missingField :: Context a +missingField = arr $ \(k, _) -> "$" ++ k ++ "$" diff --git a/src/Hakyll/Web/Urls/Relativize.hs b/src/Hakyll/Web/Urls/Relativize.hs index 0f833fc..0251cfe 100644 --- a/src/Hakyll/Web/Urls/Relativize.hs +++ b/src/Hakyll/Web/Urls/Relativize.hs @@ -1,3 +1,4 @@ +-------------------------------------------------------------------------------- -- | This module exposes a function which can relativize URL's on a webpage. -- -- This means that one can deploy the resulting site on @@ -13,36 +14,41 @@ -- will result in (suppose your blogpost is located at @\/posts\/foo.html@: -- -- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" /> --- module Hakyll.Web.Urls.Relativize ( relativizeUrlsCompiler , relativizeUrls ) where -import Prelude hiding (id) -import Control.Category (id) -import Control.Arrow ((&&&), (>>^)) -import Data.List (isPrefixOf) -import Hakyll.Core.Compiler -import Hakyll.Web.Page -import Hakyll.Web.Urls +-------------------------------------------------------------------------------- +import Control.Arrow ((&&&), (>>^)) +import Control.Category (id) +import Data.List (isPrefixOf) +import Prelude hiding (id) + + +-------------------------------------------------------------------------------- +import Hakyll.Core.Compiler +import Hakyll.Web.Page +import Hakyll.Web.Urls + +-------------------------------------------------------------------------------- -- | Compiler form of 'relativizeUrls' which automatically picks the right root -- path --- -relativizeUrlsCompiler :: Compiler (Page String) (Page String) +relativizeUrlsCompiler :: Compiler Page Page relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize where relativize Nothing = id - relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r) + relativize (Just r) = relativizeUrls $ toSiteRoot r + +-------------------------------------------------------------------------------- -- | Relativize URL's in HTML --- relativizeUrls :: String -- ^ Path to the site root - -> String -- ^ HTML to relativize - -> String -- ^ Resulting HTML + -> Page -- ^ HTML to relativize + -> Page -- ^ Resulting HTML relativizeUrls root = withUrls rel where isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x) - rel x = if isRel x then root ++ x else x + rel x = if isRel x then root ++ x else x |