on master help sign in
Deprecate things, basics now work
commit141e761ce11d4d4ae9e9b86201249dbd549e2924 authorJasper Van der Jeugt <m@jaspervdj.be> dateSat 10 Nov 2012, 18:11 (14 years ago) parent260e4e2
18 files changed+223−359
hakyll.cabal+3−5 src/Hakyll.hs+8−12 src/Hakyll/Core/Compiler.hs+18−6 src/Hakyll/Core/ResourceProvider/Metadata.hs+11−5 src/Hakyll/Web/Blaze.hs−35 src/Hakyll/Web/Feed.hs+1 src/Hakyll/Web/Page.hs+29−80 src/Hakyll/Web/Page/Internal.hs+4−46 src/Hakyll/Web/Page/List.hs+1 src/Hakyll/Web/Page/Metadata.hs+7−3 src/Hakyll/Web/Page/Read.hs−61 src/Hakyll/Web/Pandoc.hs+48−37 src/Hakyll/Web/Pandoc/Biblio.hs+20−6 src/Hakyll/Web/Pandoc/FileType.hs+15−8 src/Hakyll/Web/Tags.hs+1 src/Hakyll/Web/Template.hs+16−27 src/Hakyll/Web/Template/Context.hs+20−13 src/Hakyll/Web/Urls/Relativize.hs+21−15
hakyll.cabal+3−5
@@ -112,17 +112,15 @@ Library
112112 Hakyll.Core.Writable.CopyFile
113113 Hakyll.Core.Writable.WritableTuple
114114 Hakyll.Main
115− Hakyll.Web.Blaze
116115 Hakyll.Web.CompressCss
117− Hakyll.Web.Feed
116+ -- Hakyll.Web.Feed
118117 Hakyll.Web.Page
119− Hakyll.Web.Page.List
118+ -- Hakyll.Web.Page.List
120119 Hakyll.Web.Page.Metadata
121− Hakyll.Web.Page.Read
122120 Hakyll.Web.Pandoc
123121 Hakyll.Web.Pandoc.Biblio
124122 Hakyll.Web.Pandoc.FileType
125− Hakyll.Web.Tags
123+ -- Hakyll.Web.Tags
126124 Hakyll.Web.Template
127125 Hakyll.Web.Template.Context
128126 Hakyll.Web.Template.Read
src/Hakyll.hs+8−12
@@ -20,20 +20,18 @@ module Hakyll
2020 , module Hakyll.Core.Writable.CopyFile
2121 , module Hakyll.Core.Writable.WritableTuple
2222 , module Hakyll.Main
23− , module Hakyll.Web.Blaze
2423 , module Hakyll.Web.CompressCss
25− , module Hakyll.Web.Feed
24+ -- , module Hakyll.Web.Feed
2625 , module Hakyll.Web.Page
27− , module Hakyll.Web.Page.List
28− , module Hakyll.Web.Page.Metadata
29− , module Hakyll.Web.Page.Read
26+ -- , module Hakyll.Web.Page.List
3027 , module Hakyll.Web.Pandoc
3128 , module Hakyll.Web.Pandoc.Biblio
3229 , module Hakyll.Web.Pandoc.FileType
3330 , module Hakyll.Web.Urls
3431 , module Hakyll.Web.Urls.Relativize
35− , module Hakyll.Web.Tags
32+ -- , module Hakyll.Web.Tags
3633 , module Hakyll.Web.Template
34+ , module Hakyll.Web.Template.Context
3735 , module Hakyll.Web.Template.Read
3836 , module Hakyll.Web.Util.Html
3937 ) where
@@ -56,19 +54,17 @@ import Hakyll.Core.Writable
5654import Hakyll.Core.Writable.CopyFile
5755import Hakyll.Core.Writable.WritableTuple
5856import Hakyll.Main
59−import Hakyll.Web.Blaze
6057import Hakyll.Web.CompressCss
61−import Hakyll.Web.Feed
58+-- import Hakyll.Web.Feed
6259import Hakyll.Web.Page
63−import Hakyll.Web.Page.List
64−import Hakyll.Web.Page.Metadata
65−import Hakyll.Web.Page.Read
60+-- import Hakyll.Web.Page.List
6661import Hakyll.Web.Pandoc
6762import Hakyll.Web.Pandoc.Biblio
6863import Hakyll.Web.Pandoc.FileType
6964import Hakyll.Web.Urls
7065import Hakyll.Web.Urls.Relativize
71−import Hakyll.Web.Tags
66+-- import Hakyll.Web.Tags
7267import Hakyll.Web.Template
68+import Hakyll.Web.Template.Context
7369import Hakyll.Web.Template.Read
7470import Hakyll.Web.Util.Html
src/Hakyll/Core/Compiler.hs+18−6
@@ -95,6 +95,7 @@ module Hakyll.Core.Compiler
9595 , getIdentifier
9696 , getRoute
9797 , getRouteFor
98+ , getResourceBody
9899 , getResourceString
99100 , getResourceLBS
100101 , getResourceWith
@@ -190,25 +191,36 @@ getRouteFor = fromJob $ \identifier -> CompilerM $ do
190191 routes <- compilerRoutes <$> ask
191192 return $ runRoutes routes identifier
192193
194+
195+--------------------------------------------------------------------------------
196+-- | Get the body of the underlying resource
197+getResourceBody :: Compiler a String
198+getResourceBody = getResourceWith resourceBody
199+
200+
201+
202+--------------------------------------------------------------------------------
193203-- | Get the resource we are compiling as a string
194−--
195204getResourceString :: Compiler a String
196−getResourceString = getResourceWith resourceString
205+getResourceString = getResourceWith $ const resourceString
206+
197207
208+--------------------------------------------------------------------------------
198209-- | Get the resource we are compiling as a lazy bytestring
199210--
200211getResourceLBS :: Compiler a ByteString
201−getResourceLBS = getResourceWith resourceLBS
212+getResourceLBS = getResourceWith $ const resourceLBS
202213
214+
215+--------------------------------------------------------------------------------
203216-- | Overloadable function for 'getResourceString' and 'getResourceLBS'
204−--
205−getResourceWith :: (Identifier a -> IO b) -> Compiler c b
217+getResourceWith :: (ResourceProvider -> Identifier a -> IO b) -> Compiler c b
206218getResourceWith reader = fromJob $ \_ -> CompilerM $ do
207219 provider <- compilerResourceProvider <$> ask
208220 r <- compilerIdentifier <$> ask
209221 let filePath = toFilePath r
210222 if resourceExists provider r
211− then liftIO $ reader $ castIdentifier r
223+ then liftIO $ reader provider $ castIdentifier r
212224 else throwError $ error' filePath
213225 where
214226 error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "
src/Hakyll/Core/ResourceProvider/Metadata.hs+11−5
@@ -6,7 +6,7 @@ module Hakyll.Core.ResourceProvider.Metadata
66
77
88--------------------------------------------------------------------------------
9−import Control.Applicative ((<$>), (<*), (<*>))
9+import Control.Applicative
1010import Control.Arrow (second)
1111import qualified Data.ByteString.Char8 as BC
1212import qualified Data.Map as M
@@ -79,17 +79,23 @@ inlineSpace :: Parser Char
7979inlineSpace = P.oneOf ['\t', ' '] <?> "space"
8080
8181
82+--------------------------------------------------------------------------------
83+-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
84+newline :: Parser String
85+newline = P.string "\n" <|> P.string "\r\n"
86+
87+
8288--------------------------------------------------------------------------------
8389-- | Parse a single metadata field
8490metadataField :: Parser (String, String)
8591metadataField = do
8692 key <- P.manyTill P.alphaNum $ P.char ':'
8793 P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
88− value <- P.manyTill P.anyChar P.newline
94+ value <- P.manyTill P.anyChar newline
8995 trailing' <- P.many trailing
9096 return (key, trim $ value ++ concat trailing')
9197 where
92− trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar P.newline
98+ trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar newline
9399
94100
95101--------------------------------------------------------------------------------
@@ -102,11 +108,11 @@ metadata = P.many metadataField
102108-- | Parse a metadata block, including delimiters and trailing newlines
103109metadataBlock :: Parser [(String, String)]
104110metadataBlock = do
105− open <- P.many1 (P.char '-') <* P.many inlineSpace <* P.newline
111+ open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline
106112 metadata' <- metadata
107113 _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']
108114 P.skipMany inlineSpace
109− P.skipMany1 P.newline
115+ P.skipMany1 newline
110116 return metadata'
111117
112118
src/Hakyll/Web/Blaze.hsdeleted−35
@@ -1,35 +0,0 @@
1−-- | Module providing BlazeHtml support for hakyll
2−--
3−module Hakyll.Web.Blaze
4− ( getFieldHtml
5− , getFieldHtml'
6− , getBodyHtml
7− , getBodyHtml'
8− ) where
9−
10−import Text.Blaze.Html (Html, toHtml)
11−import Text.Blaze.Internal (preEscapedString)
12−
13−import Hakyll.Web.Page
14−import Hakyll.Web.Page.Metadata
15−
16−-- | Get a field from a page and convert it to HTML. This version does not
17−-- escape the given HTML
18−--
19−getFieldHtml :: String -> Page a -> Html
20−getFieldHtml key = preEscapedString . getField key
21−
22−-- | Version of 'getFieldHtml' that escapes the HTML content
23−--
24−getFieldHtml' :: String -> Page a -> Html
25−getFieldHtml' key = toHtml . getField key
26−
27−-- | Get the body as HTML
28−--
29−getBodyHtml :: Page String -> Html
30−getBodyHtml = preEscapedString . pageBody
31−
32−-- | Version of 'getBodyHtml' that escapes the HTML content
33−--
34−getBodyHtml' :: Page String -> Html
35−getBodyHtml' = toHtml . pageBody
src/Hakyll/Web/Feed.hs+1
@@ -1,3 +1,4 @@
1+-- TODO: port
12-- | A Module that allows easy rendering of RSS feeds.
23--
34-- The main rendering functions (@renderRss@, @renderAtom@) all assume that
src/Hakyll/Web/Page.hs+29−80
@@ -1,3 +1,4 @@
1+--------------------------------------------------------------------------------
12-- | A page is a key-value mapping, representing a page on your site
23--
34-- A page is an important concept in Hakyll. It is a key-value mapping, and has
@@ -47,109 +48,57 @@
4748-- we simply list all @key: value@ pairs, and end with @---@ again. This page
4849-- contains three metadata fields and a body. The body is given in markdown
4950-- format, which can be easily rendered to HTML by Hakyll, using pandoc.
50−--
51−{-# LANGUAGE DeriveDataTypeable #-}
5251module Hakyll.Web.Page
53− ( Page (..)
54− , fromBody
55− , fromMap
56− , toMap
52+ ( Page
5753 , readPageCompiler
5854 , pageCompiler
5955 , pageCompilerWith
6056 , pageCompilerWithPandoc
61− , pageCompilerWithFields
62− , addDefaultFields
6357 ) where
6458
65−import Prelude hiding (id)
66−import Control.Category (id)
67−import Control.Arrow (arr, (>>^), (&&&), (>>>))
68−import System.FilePath (takeBaseName, takeDirectory)
69−import qualified Data.Map as M
7059
71−import Text.Pandoc (Pandoc, ParserState, WriterOptions)
60+--------------------------------------------------------------------------------
61+import Control.Arrow (arr, (>>>))
62+import Control.Category (id)
63+import Prelude hiding (id)
64+import Text.Pandoc (Pandoc, ParserState, WriterOptions)
7265
73−import Hakyll.Core.Identifier
74−import Hakyll.Core.Compiler
75−import Hakyll.Web.Page.Internal
76−import Hakyll.Web.Page.Read
77−import Hakyll.Web.Page.Metadata
78−import Hakyll.Web.Pandoc
79−import Hakyll.Web.Template
80−import Hakyll.Web.Urls
8166
82−-- | Create a page from a body, without metadata
83−--
84−fromBody :: a -> Page a
85−fromBody = Page M.empty
67+--------------------------------------------------------------------------------
68+import Hakyll.Core.Compiler
69+import Hakyll.Web.Page.Internal
70+import Hakyll.Web.Pandoc
71+
8672
73+--------------------------------------------------------------------------------
8774-- | Read a page (do not render it)
88−--
89−readPageCompiler :: Compiler () (Page String)
90−readPageCompiler = getResourceString >>^ readPage
75+readPageCompiler :: Compiler () Page
76+readPageCompiler = getResourceBody
77+{-# DEPRECATED readPageCompiler "Use getResourceBody" #-}
9178
92−-- | Read a page, add default fields, substitute fields and render using pandoc
93−--
94−pageCompiler :: Compiler () (Page String)
79+
80+--------------------------------------------------------------------------------
81+-- | Read a page render using pandoc
82+pageCompiler :: Compiler () Page
9583pageCompiler =
9684 pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions
9785
86+
87+--------------------------------------------------------------------------------
9888-- | A version of 'pageCompiler' which allows you to specify your own pandoc
9989-- options
100−--
101−pageCompilerWith :: ParserState -> WriterOptions
102− -> Compiler () (Page String)
90+pageCompilerWith :: ParserState -> WriterOptions -> Compiler () Page
10391pageCompilerWith state options = pageCompilerWithPandoc state options id
10492
93+
94+--------------------------------------------------------------------------------
10595-- | An extension of 'pageCompilerWith' which allows you to specify a custom
106−-- pandoc transformer for the content
107−--
96+-- pandoc transformation for the content
10897pageCompilerWithPandoc :: ParserState -> WriterOptions
10998 -> (Pandoc -> Pandoc)
110− -> Compiler () (Page String)
99+ -> Compiler () Page
111100pageCompilerWithPandoc state options f = cached cacheName $
112− readPageCompiler >>> addDefaultFields >>> arr applySelf
113− >>> pageReadPandocWith state
114− >>> arr (fmap (writePandocWith options . f))
101+ readPageCompiler >>> pageReadPandocWith state >>>
102+ arr (writePandocWith options . f)
115103 where
116104 cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"
117−
118−-- | This is another, even more advanced version of 'pageCompilerWithPandoc'.
119−-- This function allows you to provide an arrow which is applied before the
120−-- fields in a page are rendered. This means you can use this extra customizable
121−-- stage to add custom fields which are inserted in the page.
122−--
123−pageCompilerWithFields :: ParserState -> WriterOptions
124− -> (Pandoc -> Pandoc)
125− -> Compiler (Page String) (Page String)
126− -> Compiler () (Page String)
127−pageCompilerWithFields state options f g =
128− readPageCompiler >>> addDefaultFields >>> g >>> arr applySelf
129− >>> pageReadPandocWith state
130− >>> arr (fmap (writePandocWith options . f))
131−
132−-- | Add a number of default metadata fields to a page. These fields include:
133−--
134−-- * @$url$@
135−--
136−-- * @$category$@
137−--
138−-- * @$title$@
139−--
140−-- * @$path$@
141−--
142−addDefaultFields :: Compiler (Page a) (Page a)
143−addDefaultFields = (getRoute &&& id >>^ uncurry addRoute)
144− >>> (getIdentifier &&& id >>^ uncurry addIdentifier)
145− where
146− -- Add root and url, based on route
147− addRoute Nothing = id
148− addRoute (Just r) = trySetField "url" (toUrl r)
149−
150− -- Add title and category, based on identifier
151− addIdentifier i = trySetField "title" (takeBaseName p)
152− . trySetField "category" (takeBaseName $ takeDirectory p)
153− . trySetField "path" p
154− where
155− p = toFilePath i
src/Hakyll/Web/Page/Internal.hs+4−46
@@ -1,50 +1,8 @@
1−-- | Internal representation of the page datatype
2−--
3−{-# LANGUAGE DeriveDataTypeable #-}
1+--------------------------------------------------------------------------------
42module Hakyll.Web.Page.Internal
5− ( Page (..)
6− , fromMap
7− , toMap
3+ ( Page
84 ) where
95
10−import Control.Applicative ((<$>), (<*>))
11−import Data.Monoid (Monoid, mempty, mappend)
126
13−import Data.Map (Map)
14−import Data.Binary (Binary, get, put)
15−import Data.Typeable (Typeable)
16−import qualified Data.Map as M
17−
18−import Hakyll.Core.Writable
19−
20−-- | Type used to represent pages
21−--
22−data Page a = Page
23− { pageMetadata :: Map String String
24− , pageBody :: a
25− } deriving (Eq, Show, Typeable)
26−
27−instance Monoid a => Monoid (Page a) where
28− mempty = Page M.empty mempty
29− mappend (Page m1 b1) (Page m2 b2) =
30− Page (M.union m1 m2) (mappend b1 b2)
31−
32−instance Functor Page where
33− fmap f (Page m b) = Page m (f b)
34−
35−instance Binary a => Binary (Page a) where
36− put (Page m b) = put m >> put b
37− get = Page <$> get <*> get
38−
39−instance Writable a => Writable (Page a) where
40− write p (Page _ b) = write p b
41−
42−-- | Create a metadata page, without a body
43−--
44−fromMap :: Monoid a => Map String String -> Page a
45−fromMap m = Page m mempty
46−
47−-- | Convert a page to a map. The body will be placed in the @body@ key.
48−--
49−toMap :: Page String -> Map String String
50−toMap (Page m b) = M.insert "body" b m
7+--------------------------------------------------------------------------------
8+type Page = String
src/Hakyll/Web/Page/List.hs+1
@@ -1,3 +1,4 @@
1+-- TODO: Port
12-- | Provides an easy way to combine several pages in a list. The applications
23-- are obvious:
34--
src/Hakyll/Web/Page/Metadata.hs+7−3
@@ -1,7 +1,8 @@
11-- | Provides various functions to manipulate the metadata fields of a page
2−--
2+-- TODO: PORT
33module Hakyll.Web.Page.Metadata
4− ( getField
4+ (
5+ {- getField
56 , getFieldMaybe
67 , setField
78 , trySetField
@@ -17,8 +18,10 @@ module Hakyll.Web.Page.Metadata
1718 , copyBodyToField
1819 , copyBodyFromField
1920 , comparePagesByDate
21+ -}
2022 ) where
2123
24+{-
2225import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))
2326import Control.Category (id)
2427import Control.Monad (msum)
@@ -209,7 +212,7 @@ renderModificationTimeWith :: TimeLocale
209212 -> Compiler (Page String) (Page String)
210213 -- ^ Resulting compiler
211214renderModificationTimeWith locale key format =
212− id &&& (getResourceWith resourceModificationTime) >>>
215+ id &&& (getResourceWith $ const resourceModificationTime) >>>
213216 setFieldA key (arr (formatTime locale format))
214217
215218-- | Copy the body of a page to a metadata field
@@ -233,3 +236,4 @@ comparePagesByDate :: Page a -> Page a -> Ordering
233236comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale
234237 where
235238 zero = UTCTime (ModifiedJulianDay 0) 0
239+-}
src/Hakyll/Web/Page/Read.hsdeleted−61
@@ -1,61 +0,0 @@
1−-- | Module providing a function to parse a page from a file
2−--
3−module Hakyll.Web.Page.Read
4− ( readPage
5− ) where
6−
7−import Control.Applicative ((<$>), (<*>), (<*), (<|>))
8−import qualified Data.Map as M
9−
10−import Text.Parsec.Char (alphaNum, anyChar, char, oneOf, string)
11−import Text.Parsec.Combinator (choice, many1, manyTill, option, skipMany1)
12−import Text.Parsec.Prim (many, parse, skipMany, (<?>))
13−import Text.Parsec.String (Parser)
14−
15−import Hakyll.Core.Util.String
16−import Hakyll.Web.Page.Internal
17−
18−-- | Space or tab, no newline
19−inlineSpace :: Parser Char
20−inlineSpace = oneOf ['\t', ' '] <?> "space"
21−
22−-- | Parse Windows newlines as well (i.e. "\n" or "\r\n")
23−newline :: Parser String
24−newline = string "\n" -- Unix
25− <|> string "\r\n" -- DOS
26−
27−-- | Parse a single metadata field
28−--
29−metadataField :: Parser (String, String)
30−metadataField = do
31− key <- manyTill alphaNum $ char ':'
32− skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key
33− value <- manyTill anyChar newline
34− trailing' <- many trailing
35− return (key, trim $ value ++ concat trailing')
36− where
37− trailing = (++) <$> many1 inlineSpace <*> manyTill anyChar newline
38−
39−-- | Parse a metadata block, including delimiters and trailing newlines
40−--
41−metadata :: Parser [(String, String)]
42−metadata = do
43− open <- many1 (char '-') <* many inlineSpace <* newline
44− metadata' <- many metadataField
45− _ <- choice $ map (string . replicate (length open)) ['-', '.']
46− skipMany inlineSpace
47− skipMany1 newline
48− return metadata'
49−
50−-- | Parse a Hakyll page
51−--
52−page :: Parser ([(String, String)], String)
53−page = do
54− metadata' <- option [] metadata
55− body <- many anyChar
56− return (metadata', body)
57−
58−readPage :: String -> Page String
59−readPage input = case parse page "page" input of
60− Left err -> error (show err)
61− Right (md, b) -> Page (M.fromList md) b
src/Hakyll/Web/Pandoc.hs+48−37
@@ -1,5 +1,5 @@
1−-- | Module exporting pandoc bindings
2−--
1+--------------------------------------------------------------------------------
2+-- | Module exporting convenientpandoc bindings
33module Hakyll.Web.Pandoc
44 ( -- * The basic building blocks
55 readPandoc
@@ -19,34 +19,38 @@ module Hakyll.Web.Pandoc
1919 , defaultHakyllWriterOptions
2020 ) where
2121
22−import Prelude hiding (id)
23−import Control.Applicative ((<$>))
24−import Control.Arrow ((>>>), (>>^), (&&&), (***))
25−import Control.Category (id)
26−import Data.Maybe (fromMaybe)
2722
28−import Text.Pandoc
23+--------------------------------------------------------------------------------
24+import Control.Arrow ((&&&), (***), (>>>), (>>^))
25+import Control.Category (id)
26+import Data.Maybe (fromMaybe)
27+import Prelude hiding (id)
28+import Text.Pandoc
2929
30−import Hakyll.Core.Compiler
31−import Hakyll.Core.Identifier
32−import Hakyll.Core.Util.Arrow
33−import Hakyll.Web.Pandoc.FileType
34−import Hakyll.Web.Page.Internal
3530
31+--------------------------------------------------------------------------------
32+import Hakyll.Core.Compiler
33+import Hakyll.Core.Identifier
34+import Hakyll.Core.Util.Arrow
35+import Hakyll.Web.Page.Internal
36+import Hakyll.Web.Pandoc.FileType
37+
38+
39+--------------------------------------------------------------------------------
3640-- | Read a string using pandoc, with the default options
37−--
3841readPandoc :: FileType -- ^ Determines how parsing happens
3942 -> Maybe (Identifier a) -- ^ Optional, for better error messages
40− -> String -- ^ String to read
43+ -> Page -- ^ String to read
4144 -> Pandoc -- ^ Resulting document
4245readPandoc = readPandocWith defaultHakyllParserState
4346
47+
48+--------------------------------------------------------------------------------
4449-- | Read a string using pandoc, with the supplied options
45−--
4650readPandocWith :: ParserState -- ^ Parser options
4751 -> FileType -- ^ Determines parsing method
4852 -> Maybe (Identifier a) -- ^ Optional, for better error messages
49− -> String -- ^ String to read
53+ -> Page -- ^ String to read
5054 -> Pandoc -- ^ Resulting document
5155readPandocWith state fileType' id' = case fileType' of
5256 Html -> readHtml state
@@ -60,54 +64,60 @@ readPandocWith state fileType' id' = case fileType' of
6064 "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++
6165 "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id')
6266
67+
68+--------------------------------------------------------------------------------
6369-- | Write a document (as HTML) using pandoc, with the default options
64−--
6570writePandoc :: Pandoc -- ^ Document to write
66− -> String -- ^ Resulting HTML
71+ -> Page -- ^ Resulting HTML
6772writePandoc = writePandocWith defaultHakyllWriterOptions
6873
74+
75+--------------------------------------------------------------------------------
6976-- | Write a document (as HTML) using pandoc, with the supplied options
70−--
7177writePandocWith :: WriterOptions -- ^ Writer options for pandoc
7278 -> Pandoc -- ^ Document to write
73− -> String -- ^ Resulting HTML
79+ -> Page -- ^ Resulting HTML
7480writePandocWith = writeHtmlString
7581
82+
83+--------------------------------------------------------------------------------
7684-- | Read the resource using pandoc
77−--
78−pageReadPandoc :: Compiler (Page String) (Page Pandoc)
85+pageReadPandoc :: Compiler Page Pandoc
7986pageReadPandoc = pageReadPandocWith defaultHakyllParserState
8087
88+
89+--------------------------------------------------------------------------------
8190-- | Read the resource using pandoc
82−--
83−pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc)
91+pageReadPandocWith :: ParserState -> Compiler Page Pandoc
8492pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA
8593
94+
95+--------------------------------------------------------------------------------
8696-- | Read the resource using pandoc. This is a (rarely needed) variant, which
8797-- comes in very useful when the parser state is the result of some arrow.
88−--
89−pageReadPandocWithA :: Compiler (ParserState, Page String) (Page Pandoc)
98+pageReadPandocWithA :: Compiler (ParserState, Page) Pandoc
9099pageReadPandocWithA =
91100 id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'
92101 where
93− pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) <$> p
102+ pageReadPandocWithA' (s, (p, (i, t))) = readPandocWith s t (Just i) p
103+
94104
105+--------------------------------------------------------------------------------
95106-- | Render the resource using pandoc
96−--
97−pageRenderPandoc :: Compiler (Page String) (Page String)
107+pageRenderPandoc :: Compiler Page Page
98108pageRenderPandoc =
99109 pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions
100110
111+
112+--------------------------------------------------------------------------------
101113-- | Render the resource using pandoc
102−--
103−pageRenderPandocWith :: ParserState
104− -> WriterOptions
105− -> Compiler (Page String) (Page String)
114+pageRenderPandocWith :: ParserState -> WriterOptions -> Compiler Page Page
106115pageRenderPandocWith state options =
107− pageReadPandocWith state >>^ fmap (writePandocWith options)
116+ pageReadPandocWith state >>^ writePandocWith options
117+
108118
119+--------------------------------------------------------------------------------
109120-- | The default reader options for pandoc parsing in hakyll
110−--
111121defaultHakyllParserState :: ParserState
112122defaultHakyllParserState = defaultParserState
113123 { -- The following option causes pandoc to read smart typography, a nice
@@ -115,8 +125,9 @@ defaultHakyllParserState = defaultParserState
115125 stateSmart = True
116126 }
117127
128+
129+--------------------------------------------------------------------------------
118130-- | The default writer options for pandoc rendering in hakyll
119−--
120131defaultHakyllWriterOptions :: WriterOptions
121132defaultHakyllWriterOptions = defaultWriterOptions
122133 { -- This option causes literate haskell to be written using '>' marks in
src/Hakyll/Web/Pandoc/Biblio.hs+20−6
@@ -1,3 +1,4 @@
1+--------------------------------------------------------------------------------
12-- | Wraps pandocs bibiliography handling
23--
34-- In order to add a bibliography, you will need a bibliography file (e.g.
@@ -6,7 +7,6 @@
67-- refer to these files when you use 'pageReadPandocBiblio'. This function also
78-- takes a parser state for completeness -- you can use
89-- 'defaultHakyllParserState' if you're unsure.
9−--
1010{-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}
1111module Hakyll.Web.Pandoc.Biblio
1212 ( CSL
@@ -16,30 +16,41 @@ module Hakyll.Web.Pandoc.Biblio
1616 , pageReadPandocBiblio
1717 ) where
1818
19+
20+--------------------------------------------------------------------------------
1921import Control.Applicative ((<$>))
2022import Control.Arrow (arr, returnA, (>>>))
2123import Data.Typeable (Typeable)
22−
2324import Data.Binary (Binary (..))
2425import Text.Pandoc (Pandoc, ParserState (..))
2526import Text.Pandoc.Biblio (processBiblio)
2627import qualified Text.CSL as CSL
2728
29+
30+--------------------------------------------------------------------------------
2831import Hakyll.Core.Compiler
2932import Hakyll.Core.Identifier
3033import Hakyll.Core.Writable
3134import Hakyll.Web.Page
3235import Hakyll.Web.Pandoc
3336
37+
38+--------------------------------------------------------------------------------
3439newtype CSL = CSL FilePath
3540 deriving (Binary, Show, Typeable, Writable)
3641
42+
43+--------------------------------------------------------------------------------
3744cslCompiler :: Compiler () CSL
3845cslCompiler = getIdentifier >>> arr (CSL . toFilePath)
3946
47+
48+--------------------------------------------------------------------------------
4049newtype Biblio = Biblio [CSL.Reference]
4150 deriving (Show, Typeable)
4251
52+
53+--------------------------------------------------------------------------------
4354instance Binary Biblio where
4455 -- Ugly.
4556 get = Biblio . read <$> get
@@ -48,14 +59,18 @@ instance Binary Biblio where
4859instance Writable Biblio where
4960 write _ _ = return ()
5061
62+
63+--------------------------------------------------------------------------------
5164biblioCompiler :: Compiler () Biblio
5265biblioCompiler = getIdentifier >>>
5366 arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio
5467
68+
69+--------------------------------------------------------------------------------
5570pageReadPandocBiblio :: ParserState
5671 -> Identifier CSL
5772 -> Identifier Biblio
58− -> Compiler (Page String) (Page Pandoc)
73+ -> Compiler Page Pandoc
5974pageReadPandocBiblio state csl refs = proc page -> do
6075 CSL csl' <- require_ csl -< ()
6176 Biblio refs' <- require_ refs -< ()
@@ -64,9 +79,8 @@ pageReadPandocBiblio state csl refs = proc page -> do
6479 -- citations!
6580 let cits = map CSL.refId refs'
6681 state' = state {stateCitations = stateCitations state ++ cits}
67− pandocPage <- pageReadPandocWithA -< (state', page)
68− let pandoc = pageBody pandocPage
82+ pandoc <- pageReadPandocWithA -< (state', page)
6983 pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)
70− returnA -< pandocPage {pageBody = pandoc'}
84+ returnA -< pandoc'
7185 where
7286 processBiblio' (c, r, p) = processBiblio c Nothing r p
src/Hakyll/Web/Pandoc/FileType.hs+15−8
@@ -1,20 +1,25 @@
1+--------------------------------------------------------------------------------
12-- | A module dealing with pandoc file extensions and associated file types
2−--
33module Hakyll.Web.Pandoc.FileType
44 ( FileType (..)
55 , fileType
66 , getFileType
77 ) where
88
9−import System.FilePath (takeExtension)
10−import Control.Arrow ((>>^))
119
12−import Hakyll.Core.Identifier
13−import Hakyll.Core.Compiler
10+--------------------------------------------------------------------------------
11+import Control.Arrow ((>>^))
12+import System.FilePath (takeExtension)
1413
14+
15+--------------------------------------------------------------------------------
16+import Hakyll.Core.Compiler
17+import Hakyll.Core.Identifier
18+
19+
20+--------------------------------------------------------------------------------
1521-- | Datatype to represent the different file types Hakyll can deal with by
1622-- default
17−--
1823data FileType
1924 = Binary
2025 | Css
@@ -28,8 +33,9 @@ data FileType
2833 | Textile
2934 deriving (Eq, Ord, Show, Read)
3035
36+
37+--------------------------------------------------------------------------------
3138-- | Get the file type for a certain file. The type is determined by extension.
32−--
3339fileType :: FilePath -> FileType
3440fileType = fileType' . takeExtension
3541 where
@@ -53,7 +59,8 @@ fileType = fileType' . takeExtension
5359 fileType' ".txt" = PlainText
5460 fileType' _ = Binary -- Treat unknown files as binary
5561
62+
63+--------------------------------------------------------------------------------
5664-- | Get the file type for the current file
57−--
5865getFileType :: Compiler a FileType
5966getFileType = getIdentifier >>^ fileType . toFilePath
src/Hakyll/Web/Tags.hs+1
@@ -1,3 +1,4 @@
1+-- TODO: port
12-- | Module containing some specialized functions to deal with tags.
23-- This Module follows certain conventions. My advice is to stick with them if
34-- possible.
src/Hakyll/Web/Template.hs+16−27
@@ -63,8 +63,6 @@
6363module Hakyll.Web.Template
6464 ( Template
6565 , applyTemplate
66− , applyTemplateToPage
67− , applySelf
6866 , templateCompiler
6967 , templateCompilerWith
7068 , applyTemplateCompiler
@@ -76,16 +74,19 @@ import Control.Arrow
7674import Control.Category (id)
7775import qualified Data.Map as M
7876import Data.Maybe (fromMaybe)
77+import Data.Tuple (swap)
7978import Prelude hiding (id)
8079import System.FilePath (takeExtension)
8180import Text.Hamlet (HamletSettings,
8281 defaultHamletSettings)
8382
83+
8484--------------------------------------------------------------------------------
8585import Hakyll.Core.Compiler
8686import Hakyll.Core.Identifier
8787import Hakyll.Core.Util.Arrow
8888import Hakyll.Web.Page.Internal
89+import Hakyll.Web.Template.Context
8990import Hakyll.Web.Template.Internal
9091import Hakyll.Web.Template.Read
9192
@@ -94,12 +95,12 @@ import Hakyll.Web.Template.Read
9495applyTemplate :: forall a b. (ArrowChoice a, ArrowMap a)
9596 => a (String, b) String
9697 -> a (Template, b) String
97−applyTemplate field =
98+applyTemplate context =
9899 arr (\(tpl, x) -> [(e, x) | e <- unTemplate tpl]) >>>
99100 mapA applyElement >>^ concat
100101 where
101102 applyElement :: a (TemplateElement, b) String
102− applyElement = unElement >>> (id ||| field)
103+ applyElement = unElement >>> (id ||| context)
103104
104105 unElement :: a (TemplateElement, b) (Either String (String, b))
105106 unElement = arr $ \(e, x) -> case e of
@@ -108,24 +109,6 @@ applyTemplate field =
108109 Key k -> Right (k, x)
109110
110111
111−--------------------------------------------------------------------------------
112−-- | TODO: Remove
113−applyTemplateToPage :: Template -> Page String -> Page String
114−applyTemplateToPage tpl page =
115− fmap (const $ applyTemplate pageField (tpl, page)) page
116− where
117− pageField (k, p) = fromMaybe ("$" ++ k ++ "$") $ M.lookup k $ toMap p
118−{-# DEPRECATED applyTemplateToPage "Use applyTemplate" #-}
119−
120−
121−--------------------------------------------------------------------------------
122−-- | Apply a page as it's own template. This is often very useful to fill in
123−-- certain keys like @$root@ and @$url@.
124−applySelf :: Page String -> Page String
125−applySelf page = applyTemplateToPage (readTemplate $ pageBody page) page
126−{-# DEPRECATED applySelf "Use applyTemplate" #-}
127−
128−
129112--------------------------------------------------------------------------------
130113-- | Read a template. If the extension of the file we're compiling is
131114-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed
@@ -133,8 +116,9 @@ applySelf page = applyTemplateToPage (readTemplate $ pageBody page) page
133116templateCompiler :: Compiler () Template
134117templateCompiler = templateCompilerWith defaultHamletSettings
135118
119+
120+--------------------------------------------------------------------------------
136121-- | Version of 'templateCompiler' that enables custom settings.
137−--
138122templateCompilerWith :: HamletSettings -> Compiler () Template
139123templateCompilerWith settings =
140124 cached "Hakyll.Web.Template.templateCompilerWith" $
@@ -149,7 +133,12 @@ templateCompilerWith settings =
149133
150134
151135--------------------------------------------------------------------------------
152−applyTemplateCompiler :: Identifier Template -- ^ Template
153− -> Compiler (Page String) (Page String) -- ^ Compiler
154−applyTemplateCompiler identifier = require identifier $
155− flip applyTemplateToPage
136+applyTemplateCompiler :: Identifier Template -- ^ Template
137+ -> Context Page -- ^ Context
138+ -> Compiler Page Page -- ^ Compiler
139+applyTemplateCompiler identifier context = requireA identifier $
140+ arr swap >>> applyTemplate context'
141+ where
142+ context' = proc (k, x) -> do
143+ id' <- getIdentifier -< ()
144+ context -< (k, (id', x))
src/Hakyll/Web/Template/Context.hs+20−13
@@ -13,60 +13,67 @@ module Hakyll.Web.Template.Context
1313
1414
1515--------------------------------------------------------------------------------
16−import Control.Applicative (empty, (<|>))
16+import Control.Applicative (empty, (<|>))
1717import Control.Arrow
18−import System.FilePath (takeBaseName, takeDirectory)
18+import System.FilePath (takeBaseName, takeDirectory)
1919
2020
2121--------------------------------------------------------------------------------
2222import Hakyll.Core.Compiler
2323import Hakyll.Core.Identifier
24+import Hakyll.Web.Page.Internal
2425import Hakyll.Web.Urls
2526
2627
2728--------------------------------------------------------------------------------
28−type Context a = Compiler (String, a) String
29+type Context a = Compiler (String, (Identifier a, a)) String
2930
3031
3132--------------------------------------------------------------------------------
32−field :: String -> Compiler a String -> Context a
33−field key value = arr checkKey >>> empty ||| value
33+field :: String -> Compiler (Identifier a, a) String -> Context a
34+field key value = arr checkKey >>> (empty ||| value)
3435 where
3536 checkKey (k, x)
36− | k == key = Left ()
37+ | k /= key = Left ()
3738 | otherwise = Right x
3839
3940
4041--------------------------------------------------------------------------------
41−defaultContext :: Context (Identifier String, String)
42+defaultContext :: Context Page
4243defaultContext =
4344 bodyField "body" <|>
4445 urlField "url" <|>
4546 pathField "path" <|>
4647 categoryField "category" <|>
47− titleField "title"
48+ titleField "title" <|>
49+ missingField
4850
4951
5052--------------------------------------------------------------------------------
51−bodyField :: String -> Context (Identifier String, String)
53+bodyField :: String -> Context Page
5254bodyField key = field key $ arr snd
5355
5456
5557--------------------------------------------------------------------------------
56−urlField :: String -> Context (Identifier a, a)
58+urlField :: String -> Context a
5759urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl
5860
5961
6062--------------------------------------------------------------------------------
61−pathField :: String -> Context (Identifier a, a)
63+pathField :: String -> Context a
6264pathField key = field key $ arr $ toFilePath . fst
6365
6466
6567--------------------------------------------------------------------------------
66−categoryField :: String -> Context (Identifier a, a)
68+categoryField :: String -> Context a
6769categoryField key = pathField key >>^ (takeBaseName . takeDirectory)
6870
6971
7072--------------------------------------------------------------------------------
71−titleField :: String -> Context (Identifier a, a)
73+titleField :: String -> Context a
7274titleField key = pathField key >>^ takeBaseName
75+
76+
77+--------------------------------------------------------------------------------
78+missingField :: Context a
79+missingField = arr $ \(k, _) -> "$" ++ k ++ "$"
src/Hakyll/Web/Urls/Relativize.hs+21−15
@@ -1,3 +1,4 @@
1+--------------------------------------------------------------------------------
12-- | This module exposes a function which can relativize URL's on a webpage.
23--
34-- This means that one can deploy the resulting site on
@@ -13,36 +14,41 @@
1314-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:
1415--
1516-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />
16−--
1717module Hakyll.Web.Urls.Relativize
1818 ( relativizeUrlsCompiler
1919 , relativizeUrls
2020 ) where
2121
22−import Prelude hiding (id)
23−import Control.Category (id)
24−import Control.Arrow ((&&&), (>>^))
25−import Data.List (isPrefixOf)
2622
27−import Hakyll.Core.Compiler
28−import Hakyll.Web.Page
29−import Hakyll.Web.Urls
23+--------------------------------------------------------------------------------
24+import Control.Arrow ((&&&), (>>^))
25+import Control.Category (id)
26+import Data.List (isPrefixOf)
27+import Prelude hiding (id)
28+
29+
30+--------------------------------------------------------------------------------
31+import Hakyll.Core.Compiler
32+import Hakyll.Web.Page
33+import Hakyll.Web.Urls
34+
3035
36+--------------------------------------------------------------------------------
3137-- | Compiler form of 'relativizeUrls' which automatically picks the right root
3238-- path
33−--
34−relativizeUrlsCompiler :: Compiler (Page String) (Page String)
39+relativizeUrlsCompiler :: Compiler Page Page
3540relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize
3641 where
3742 relativize Nothing = id
38− relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)
43+ relativize (Just r) = relativizeUrls $ toSiteRoot r
44+
3945
46+--------------------------------------------------------------------------------
4047-- | Relativize URL's in HTML
41−--
4248relativizeUrls :: String -- ^ Path to the site root
43− -> String -- ^ HTML to relativize
44− -> String -- ^ Resulting HTML
49+ -> Page -- ^ HTML to relativize
50+ -> Page -- ^ Resulting HTML
4551relativizeUrls root = withUrls rel
4652 where
4753 isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x)
48− rel x = if isRel x then root ++ x else x
54+ rel x = if isRel x then root ++ x else x