141e761 · hakyll · git.iko.soy

hakyll.cabal+3−5

compare with master

unifiedsplit

@@ -112,17 +112,15 @@ Library

112 Hakyll.Core.Writable.CopyFile

113 Hakyll.Core.Writable.WritableTuple

114 Hakyll.Main

115− Hakyll.Web.Blaze

116 Hakyll.Web.CompressCss

115 Hakyll.Web.CompressCss

117− Hakyll.Web.Feed

116+ -- Hakyll.Web.Feed

118 Hakyll.Web.Page

117 Hakyll.Web.Page

119− Hakyll.Web.Page.List

118+ -- Hakyll.Web.Page.List

120 Hakyll.Web.Page.Metadata

119 Hakyll.Web.Page.Metadata

121− Hakyll.Web.Page.Read

122 Hakyll.Web.Pandoc

120 Hakyll.Web.Pandoc

123 Hakyll.Web.Pandoc.Biblio

121 Hakyll.Web.Pandoc.Biblio

124 Hakyll.Web.Pandoc.FileType

122 Hakyll.Web.Pandoc.FileType

125− Hakyll.Web.Tags

123+ -- Hakyll.Web.Tags

126 Hakyll.Web.Template

124 Hakyll.Web.Template

127 Hakyll.Web.Template.Context

125 Hakyll.Web.Template.Context

128 Hakyll.Web.Template.Read

126 Hakyll.Web.Template.Read

src/Hakyll.hs+8−12

@@ -20,20 +20,18 @@ module Hakyll

20 , module Hakyll.Core.Writable.CopyFile

21 , module Hakyll.Core.Writable.WritableTuple

22 , module Hakyll.Main

23− , module Hakyll.Web.Blaze

24 , module Hakyll.Web.CompressCss

23 , module Hakyll.Web.CompressCss

25− , module Hakyll.Web.Feed

24+ -- , module Hakyll.Web.Feed

26 , module Hakyll.Web.Page

25 , module Hakyll.Web.Page

27− , module Hakyll.Web.Page.List

26+ -- , module Hakyll.Web.Page.List

28− , module Hakyll.Web.Page.Metadata

29− , module Hakyll.Web.Page.Read

30 , module Hakyll.Web.Pandoc

27 , module Hakyll.Web.Pandoc

31 , module Hakyll.Web.Pandoc.Biblio

28 , module Hakyll.Web.Pandoc.Biblio

32 , module Hakyll.Web.Pandoc.FileType

29 , module Hakyll.Web.Pandoc.FileType

33 , module Hakyll.Web.Urls

30 , module Hakyll.Web.Urls

34 , module Hakyll.Web.Urls.Relativize

31 , module Hakyll.Web.Urls.Relativize

35− , module Hakyll.Web.Tags

32+ -- , module Hakyll.Web.Tags

36 , module Hakyll.Web.Template

33 , module Hakyll.Web.Template

34+ , module Hakyll.Web.Template.Context

37 , module Hakyll.Web.Template.Read

35 , module Hakyll.Web.Template.Read

38 , module Hakyll.Web.Util.Html

36 , module Hakyll.Web.Util.Html

39 ) where

37 ) where

@@ -56,19 +54,17 @@ import Hakyll.Core.Writable

56import Hakyll.Core.Writable.CopyFile

54import Hakyll.Core.Writable.CopyFile

57import Hakyll.Core.Writable.WritableTuple

55import Hakyll.Core.Writable.WritableTuple

58import Hakyll.Main

56import Hakyll.Main

59−import Hakyll.Web.Blaze

60import Hakyll.Web.CompressCss

57import Hakyll.Web.CompressCss

61−import Hakyll.Web.Feed

58+-- import Hakyll.Web.Feed

62import Hakyll.Web.Page

59import Hakyll.Web.Page

63−import Hakyll.Web.Page.List

60+-- import Hakyll.Web.Page.List

64−import Hakyll.Web.Page.Metadata

65−import Hakyll.Web.Page.Read

66import Hakyll.Web.Pandoc

61import Hakyll.Web.Pandoc

67import Hakyll.Web.Pandoc.Biblio

62import Hakyll.Web.Pandoc.Biblio

68import Hakyll.Web.Pandoc.FileType

63import Hakyll.Web.Pandoc.FileType

69import Hakyll.Web.Urls

64import Hakyll.Web.Urls

70import Hakyll.Web.Urls.Relativize

65import Hakyll.Web.Urls.Relativize

71−import Hakyll.Web.Tags

66+-- import Hakyll.Web.Tags

72import Hakyll.Web.Template

67import Hakyll.Web.Template

68+import Hakyll.Web.Template.Context

73import Hakyll.Web.Template.Read

69import Hakyll.Web.Template.Read

74import Hakyll.Web.Util.Html

70import Hakyll.Web.Util.Html

src/Hakyll/Core/Compiler.hs+18−6

@@ -95,6 +95,7 @@ module Hakyll.Core.Compiler

95 , getIdentifier

96 , getRoute

97 , getRouteFor

98+ , getResourceBody

98 , getResourceString

99 , getResourceString

99 , getResourceLBS

100 , getResourceLBS

100 , getResourceWith

101 , getResourceWith

@@ -190,25 +191,36 @@ getRouteFor = fromJob $ \identifier -> CompilerM $ do

190 routes <- compilerRoutes <$> ask

191 routes <- compilerRoutes <$> ask

191 return $ runRoutes routes identifier

192 return $ runRoutes routes identifier

192

193

194+

195+--------------------------------------------------------------------------------

196+-- | Get the body of the underlying resource

197+getResourceBody :: Compiler a String

198+getResourceBody = getResourceWith resourceBody

199+

200+

201+

202+--------------------------------------------------------------------------------

193-- | Get the resource we are compiling as a string

203-- | Get the resource we are compiling as a string

194−--

195getResourceString :: Compiler a String

204getResourceString :: Compiler a String

196−getResourceString = getResourceWith resourceString

205+getResourceString = getResourceWith $ const resourceString

206+

197

207

208+--------------------------------------------------------------------------------

198-- | Get the resource we are compiling as a lazy bytestring

209-- | Get the resource we are compiling as a lazy bytestring

199--

210--

200getResourceLBS :: Compiler a ByteString

211getResourceLBS :: Compiler a ByteString

201−getResourceLBS = getResourceWith resourceLBS

212+getResourceLBS = getResourceWith $ const resourceLBS

202

213

214+

215+--------------------------------------------------------------------------------

203-- | Overloadable function for 'getResourceString' and 'getResourceLBS'

216-- | 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

206getResourceWith reader = fromJob $ \_ -> CompilerM $ do

218getResourceWith reader = fromJob $ \_ -> CompilerM $ do

207 provider <- compilerResourceProvider <$> ask

219 provider <- compilerResourceProvider <$> ask

208 r <- compilerIdentifier <$> ask

220 r <- compilerIdentifier <$> ask

209 let filePath = toFilePath r

221 let filePath = toFilePath r

210 if resourceExists provider r

222 if resourceExists provider r

211− then liftIO $ reader $ castIdentifier r

223+ then liftIO $ reader provider $ castIdentifier r

212 else throwError $ error' filePath

224 else throwError $ error' filePath

213 where

225 where

214 error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "

226 error' id' = "Hakyll.Core.Compiler.getResourceWith: resource "

src/Hakyll/Core/ResourceProvider/Metadata.hs+11−5

@@ -6,7 +6,7 @@ module Hakyll.Core.ResourceProvider.Metadata

6

7

8--------------------------------------------------------------------------------

9−import Control.Applicative ((<$>), (<*), (<*>))

9+import Control.Applicative

10import Control.Arrow (second)

11import qualified Data.ByteString.Char8 as BC

12import qualified Data.Map as M

@@ -79,17 +79,23 @@ inlineSpace :: Parser Char

79inlineSpace = P.oneOf ['\t', ' '] <?> "space"

80

81

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+

82--------------------------------------------------------------------------------

88--------------------------------------------------------------------------------

83-- | Parse a single metadata field

89-- | Parse a single metadata field

84metadataField :: Parser (String, String)

90metadataField :: Parser (String, String)

85metadataField = do

91metadataField = do

86 key <- P.manyTill P.alphaNum $ P.char ':'

92 key <- P.manyTill P.alphaNum $ P.char ':'

87 P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key

93 P.skipMany1 inlineSpace <?> "space followed by metadata for: " ++ key

88− value <- P.manyTill P.anyChar P.newline

94+ value <- P.manyTill P.anyChar newline

89 trailing' <- P.many trailing

95 trailing' <- P.many trailing

90 return (key, trim $ value ++ concat trailing')

96 return (key, trim $ value ++ concat trailing')

91 where

97 where

92− trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar P.newline

98+ trailing = (++) <$> P.many1 inlineSpace <*> P.manyTill P.anyChar newline

93

99

94

100

95--------------------------------------------------------------------------------

101--------------------------------------------------------------------------------

@@ -102,11 +108,11 @@ metadata = P.many metadataField

102-- | Parse a metadata block, including delimiters and trailing newlines

108-- | Parse a metadata block, including delimiters and trailing newlines

103metadataBlock :: Parser [(String, String)]

109metadataBlock :: Parser [(String, String)]

104metadataBlock = do

110metadataBlock = do

105− open <- P.many1 (P.char '-') <* P.many inlineSpace <* P.newline

111+ open <- P.many1 (P.char '-') <* P.many inlineSpace <* newline

106 metadata' <- metadata

112 metadata' <- metadata

107 _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']

113 _ <- P.choice $ map (P.string . replicate (length open)) ['-', '.']

108 P.skipMany inlineSpace

114 P.skipMany inlineSpace

109− P.skipMany1 P.newline

115+ P.skipMany1 newline

110 return metadata'

116 return metadata'

111

117

112

118

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

1-- | A Module that allows easy rendering of RSS feeds.

2-- | A Module that allows easy rendering of RSS feeds.

2--

3--

3-- The main rendering functions (@renderRss@, @renderAtom@) all assume that

4-- The main rendering functions (@renderRss@, @renderAtom@) all assume that

src/Hakyll/Web/Page.hs+29−80

@@ -1,3 +1,4 @@

1+--------------------------------------------------------------------------------

1-- | A page is a key-value mapping, representing a page on your site

2-- | A page is a key-value mapping, representing a page on your site

2--

3--

3-- A page is an important concept in Hakyll. It is a key-value mapping, and has

4-- A page is an important concept in Hakyll. It is a key-value mapping, and has

@@ -47,109 +48,57 @@

47-- we simply list all @key: value@ pairs, and end with @---@ again. This page

48-- we simply list all @key: value@ pairs, and end with @---@ again. This page

48-- contains three metadata fields and a body. The body is given in markdown

49-- contains three metadata fields and a body. The body is given in markdown

49-- format, which can be easily rendered to HTML by Hakyll, using pandoc.

50-- format, which can be easily rendered to HTML by Hakyll, using pandoc.

50−--

51−{-# LANGUAGE DeriveDataTypeable #-}

52module Hakyll.Web.Page

51module Hakyll.Web.Page

53− ( Page (..)

52+ ( Page

54− , fromBody

55− , fromMap

56− , toMap

57 , readPageCompiler

53 , readPageCompiler

58 , pageCompiler

54 , pageCompiler

59 , pageCompilerWith

55 , pageCompilerWith

60 , pageCompilerWithPandoc

56 , pageCompilerWithPandoc

61− , pageCompilerWithFields

62− , addDefaultFields

63 ) where

57 ) where

64

58

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

70

59

60+--------------------------------------------------------------------------------

61+import Control.Arrow (arr, (>>>))

62+import Control.Category (id)

63+import Prelude hiding (id)

71−import Text.Pandoc (Pandoc, ParserState, WriterOptions)

64+import Text.Pandoc (Pandoc, ParserState, WriterOptions)

72

65

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

81

66

82−-- | Create a page from a body, without metadata

67+--------------------------------------------------------------------------------

83−--

68+import Hakyll.Core.Compiler

84−fromBody :: a -> Page a

69+import Hakyll.Web.Page.Internal

85−fromBody = Page M.empty

70+import Hakyll.Web.Pandoc

71+

86

72

73+--------------------------------------------------------------------------------

87-- | Read a page (do not render it)

74-- | Read a page (do not render it)

88−--

89−readPageCompiler :: Compiler () (Page String)

75+readPageCompiler :: Compiler () Page

90−readPageCompiler = getResourceString >>^ readPage

76+readPageCompiler = getResourceBody

77+{-# DEPRECATED readPageCompiler "Use getResourceBody" #-}

91

78

79+

80+--------------------------------------------------------------------------------

92−-- | Read a page, add default fields, substitute fields and render using pandoc

81+-- | Read a page render using pandoc

93−--

94−pageCompiler :: Compiler () (Page String)

82+pageCompiler :: Compiler () Page

95pageCompiler =

83pageCompiler =

96 pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions

84 pageCompilerWith defaultHakyllParserState defaultHakyllWriterOptions

97

85

86+

87+--------------------------------------------------------------------------------

98-- | A version of 'pageCompiler' which allows you to specify your own pandoc

88-- | A version of 'pageCompiler' which allows you to specify your own pandoc

99-- options

89-- options

100−--

101−pageCompilerWith :: ParserState -> WriterOptions

90+pageCompilerWith :: ParserState -> WriterOptions -> Compiler () Page

102− -> Compiler () (Page String)

103pageCompilerWith state options = pageCompilerWithPandoc state options id

91pageCompilerWith state options = pageCompilerWithPandoc state options id

104

92

93+

94+--------------------------------------------------------------------------------

105-- | An extension of 'pageCompilerWith' which allows you to specify a custom

95-- | An extension of 'pageCompilerWith' which allows you to specify a custom

106−-- pandoc transformer for the content

96+-- pandoc transformation for the content

107−--

108pageCompilerWithPandoc :: ParserState -> WriterOptions

97pageCompilerWithPandoc :: ParserState -> WriterOptions

109 -> (Pandoc -> Pandoc)

98 -> (Pandoc -> Pandoc)

110− -> Compiler () (Page String)

99+ -> Compiler () Page

111pageCompilerWithPandoc state options f = cached cacheName $

100pageCompilerWithPandoc state options f = cached cacheName $

112− readPageCompiler >>> addDefaultFields >>> arr applySelf

113− >>> pageReadPandocWith state

101+ readPageCompiler >>> pageReadPandocWith state >>>

114− >>> arr (fmap (writePandocWith options . f))

102+ arr (writePandocWith options . f)

115 where

103 where

116 cacheName = "Hakyll.Web.Page.pageCompilerWithPandoc"

104 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

1+--------------------------------------------------------------------------------

2−--

3−{-# LANGUAGE DeriveDataTypeable #-}

4module Hakyll.Web.Page.Internal

2module Hakyll.Web.Page.Internal

5− ( Page (..)

3+ ( Page

6− , fromMap

7− , toMap

8 ) where

4 ) where

9

5

10−import Control.Applicative ((<$>), (<*>))

11−import Data.Monoid (Monoid, mempty, mappend)

12

6

13−import Data.Map (Map)

7+--------------------------------------------------------------------------------

14−import Data.Binary (Binary, get, put)

8+type Page = String

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

src/Hakyll/Web/Page/List.hs+1

@@ -1,3 +1,4 @@

1+-- TODO: Port

1-- | Provides an easy way to combine several pages in a list. The applications

2-- | Provides an easy way to combine several pages in a list. The applications

2-- are obvious:

3-- are obvious:

3--

4--

src/Hakyll/Web/Page/Metadata.hs+7−3

@@ -1,7 +1,8 @@

1-- | Provides various functions to manipulate the metadata fields of a page

2−--

2+-- TODO: PORT

3module Hakyll.Web.Page.Metadata

4+ (

4− ( getField

5+ {- getField

5 , getFieldMaybe

6 , getFieldMaybe

6 , setField

7 , setField

7 , trySetField

8 , trySetField

@@ -17,8 +18,10 @@ module Hakyll.Web.Page.Metadata

17 , copyBodyToField

18 , copyBodyToField

18 , copyBodyFromField

19 , copyBodyFromField

19 , comparePagesByDate

20 , comparePagesByDate

21+ -}

20 ) where

22 ) where

21

23

24+{-

22import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))

25import Control.Arrow (Arrow, arr, (>>>), (***), (&&&))

23import Control.Category (id)

26import Control.Category (id)

24import Control.Monad (msum)

27import Control.Monad (msum)

@@ -209,7 +212,7 @@ renderModificationTimeWith :: TimeLocale

209 -> Compiler (Page String) (Page String)

212 -> Compiler (Page String) (Page String)

210 -- ^ Resulting compiler

213 -- ^ Resulting compiler

211renderModificationTimeWith locale key format =

214renderModificationTimeWith locale key format =

212− id &&& (getResourceWith resourceModificationTime) >>>

215+ id &&& (getResourceWith $ const resourceModificationTime) >>>

213 setFieldA key (arr (formatTime locale format))

216 setFieldA key (arr (formatTime locale format))

214

217

215-- | Copy the body of a page to a metadata field

218-- | Copy the body of a page to a metadata field

@@ -233,3 +236,4 @@ comparePagesByDate :: Page a -> Page a -> Ordering

233comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale

236comparePagesByDate = comparing $ fromMaybe zero . getUTCMaybe defaultTimeLocale

234 where

237 where

235 zero = UTCTime (ModifiedJulianDay 0) 0

238 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+--------------------------------------------------------------------------------

1−-- | Module exporting pandoc bindings

2+-- | Module exporting convenientpandoc bindings

2−--

3module Hakyll.Web.Pandoc

4 ( -- * The basic building blocks

5 readPandoc

@@ -19,34 +19,38 @@ module Hakyll.Web.Pandoc

19 , defaultHakyllWriterOptions

20 ) where

21

22−import Prelude hiding (id)

23−import Control.Applicative ((<$>))

24−import Control.Arrow ((>>>), (>>^), (&&&), (***))

25−import Control.Category (id)

26−import Data.Maybe (fromMaybe)

27

22

23+--------------------------------------------------------------------------------

24+import Control.Arrow ((&&&), (***), (>>>), (>>^))

25+import Control.Category (id)

26+import Data.Maybe (fromMaybe)

27+import Prelude hiding (id)

28−import Text.Pandoc

28+import Text.Pandoc

29

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

35

30

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+--------------------------------------------------------------------------------

36-- | Read a string using pandoc, with the default options

40-- | Read a string using pandoc, with the default options

37−--

38readPandoc :: FileType -- ^ Determines how parsing happens

41readPandoc :: FileType -- ^ Determines how parsing happens

39 -> Maybe (Identifier a) -- ^ Optional, for better error messages

42 -> Maybe (Identifier a) -- ^ Optional, for better error messages

40− -> String -- ^ String to read

43+ -> Page -- ^ String to read

41 -> Pandoc -- ^ Resulting document

44 -> Pandoc -- ^ Resulting document

42readPandoc = readPandocWith defaultHakyllParserState

45readPandoc = readPandocWith defaultHakyllParserState

43

46

47+

48+--------------------------------------------------------------------------------

44-- | Read a string using pandoc, with the supplied options

49-- | Read a string using pandoc, with the supplied options

45−--

46readPandocWith :: ParserState -- ^ Parser options

50readPandocWith :: ParserState -- ^ Parser options

47 -> FileType -- ^ Determines parsing method

51 -> FileType -- ^ Determines parsing method

48 -> Maybe (Identifier a) -- ^ Optional, for better error messages

52 -> Maybe (Identifier a) -- ^ Optional, for better error messages

49− -> String -- ^ String to read

53+ -> Page -- ^ String to read

50 -> Pandoc -- ^ Resulting document

54 -> Pandoc -- ^ Resulting document

51readPandocWith state fileType' id' = case fileType' of

55readPandocWith state fileType' id' = case fileType' of

52 Html -> readHtml state

56 Html -> readHtml state

@@ -60,54 +64,60 @@ readPandocWith state fileType' id' = case fileType' of

60 "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++

64 "Hakyll.Web.readPandocWith: I don't know how to read a file of the " ++

61 "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id')

65 "type " ++ show t ++ fromMaybe "" (fmap ((" for: " ++) . show) id')

62

66

67+

68+--------------------------------------------------------------------------------

63-- | Write a document (as HTML) using pandoc, with the default options

69-- | Write a document (as HTML) using pandoc, with the default options

64−--

65writePandoc :: Pandoc -- ^ Document to write

70writePandoc :: Pandoc -- ^ Document to write

66− -> String -- ^ Resulting HTML

71+ -> Page -- ^ Resulting HTML

67writePandoc = writePandocWith defaultHakyllWriterOptions

72writePandoc = writePandocWith defaultHakyllWriterOptions

68

73

74+

75+--------------------------------------------------------------------------------

69-- | Write a document (as HTML) using pandoc, with the supplied options

76-- | Write a document (as HTML) using pandoc, with the supplied options

70−--

71writePandocWith :: WriterOptions -- ^ Writer options for pandoc

77writePandocWith :: WriterOptions -- ^ Writer options for pandoc

72 -> Pandoc -- ^ Document to write

78 -> Pandoc -- ^ Document to write

73− -> String -- ^ Resulting HTML

79+ -> Page -- ^ Resulting HTML

74writePandocWith = writeHtmlString

80writePandocWith = writeHtmlString

75

81

82+

83+--------------------------------------------------------------------------------

76-- | Read the resource using pandoc

84-- | Read the resource using pandoc

77−--

78−pageReadPandoc :: Compiler (Page String) (Page Pandoc)

85+pageReadPandoc :: Compiler Page Pandoc

79pageReadPandoc = pageReadPandocWith defaultHakyllParserState

86pageReadPandoc = pageReadPandocWith defaultHakyllParserState

80

87

88+

89+--------------------------------------------------------------------------------

81-- | Read the resource using pandoc

90-- | Read the resource using pandoc

82−--

83−pageReadPandocWith :: ParserState -> Compiler (Page String) (Page Pandoc)

91+pageReadPandocWith :: ParserState -> Compiler Page Pandoc

84pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA

92pageReadPandocWith state = constA state &&& id >>> pageReadPandocWithA

85

93

94+

95+--------------------------------------------------------------------------------

86-- | Read the resource using pandoc. This is a (rarely needed) variant, which

96-- | Read the resource using pandoc. This is a (rarely needed) variant, which

87-- comes in very useful when the parser state is the result of some arrow.

97-- 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

90pageReadPandocWithA =

99pageReadPandocWithA =

91 id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'

100 id *** id &&& getIdentifier &&& getFileType >>^ pageReadPandocWithA'

92 where

101 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+

94

104

105+--------------------------------------------------------------------------------

95-- | Render the resource using pandoc

106-- | Render the resource using pandoc

96−--

97−pageRenderPandoc :: Compiler (Page String) (Page String)

107+pageRenderPandoc :: Compiler Page Page

98pageRenderPandoc =

108pageRenderPandoc =

99 pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions

109 pageRenderPandocWith defaultHakyllParserState defaultHakyllWriterOptions

100

110

111+

112+--------------------------------------------------------------------------------

101-- | Render the resource using pandoc

113-- | Render the resource using pandoc

102−--

103−pageRenderPandocWith :: ParserState

114+pageRenderPandocWith :: ParserState -> WriterOptions -> Compiler Page Page

104− -> WriterOptions

105− -> Compiler (Page String) (Page String)

106pageRenderPandocWith state options =

115pageRenderPandocWith state options =

107− pageReadPandocWith state >>^ fmap (writePandocWith options)

116+ pageReadPandocWith state >>^ writePandocWith options

117+

108

118

119+--------------------------------------------------------------------------------

109-- | The default reader options for pandoc parsing in hakyll

120-- | The default reader options for pandoc parsing in hakyll

110−--

111defaultHakyllParserState :: ParserState

121defaultHakyllParserState :: ParserState

112defaultHakyllParserState = defaultParserState

122defaultHakyllParserState = defaultParserState

113 { -- The following option causes pandoc to read smart typography, a nice

123 { -- The following option causes pandoc to read smart typography, a nice

@@ -115,8 +125,9 @@ defaultHakyllParserState = defaultParserState

115 stateSmart = True

125 stateSmart = True

116 }

126 }

117

127

128+

129+--------------------------------------------------------------------------------

118-- | The default writer options for pandoc rendering in hakyll

130-- | The default writer options for pandoc rendering in hakyll

119−--

120defaultHakyllWriterOptions :: WriterOptions

131defaultHakyllWriterOptions :: WriterOptions

121defaultHakyllWriterOptions = defaultWriterOptions

132defaultHakyllWriterOptions = defaultWriterOptions

122 { -- This option causes literate haskell to be written using '>' marks in

133 { -- This option causes literate haskell to be written using '>' marks in

src/Hakyll/Web/Pandoc/Biblio.hs+20−6

@@ -1,3 +1,4 @@

1+--------------------------------------------------------------------------------

1-- | Wraps pandocs bibiliography handling

2-- | Wraps pandocs bibiliography handling

2--

3--

3-- In order to add a bibliography, you will need a bibliography file (e.g.

4-- In order to add a bibliography, you will need a bibliography file (e.g.

@@ -6,7 +7,6 @@

6-- refer to these files when you use 'pageReadPandocBiblio'. This function also

7-- refer to these files when you use 'pageReadPandocBiblio'. This function also

7-- takes a parser state for completeness -- you can use

8-- takes a parser state for completeness -- you can use

8-- 'defaultHakyllParserState' if you're unsure.

9-- 'defaultHakyllParserState' if you're unsure.

9−--

10{-# LANGUAGE Arrows, DeriveDataTypeable, GeneralizedNewtypeDeriving #-}

11module Hakyll.Web.Pandoc.Biblio

12 ( CSL

@@ -16,30 +16,41 @@ module Hakyll.Web.Pandoc.Biblio

16 , pageReadPandocBiblio

17 ) where

18

19+

20+--------------------------------------------------------------------------------

19import Control.Applicative ((<$>))

21import Control.Applicative ((<$>))

20import Control.Arrow (arr, returnA, (>>>))

22import Control.Arrow (arr, returnA, (>>>))

21import Data.Typeable (Typeable)

23import Data.Typeable (Typeable)

22−

23import Data.Binary (Binary (..))

24import Data.Binary (Binary (..))

24import Text.Pandoc (Pandoc, ParserState (..))

25import Text.Pandoc (Pandoc, ParserState (..))

25import Text.Pandoc.Biblio (processBiblio)

26import Text.Pandoc.Biblio (processBiblio)

26import qualified Text.CSL as CSL

27import qualified Text.CSL as CSL

27

28

29+

30+--------------------------------------------------------------------------------

28import Hakyll.Core.Compiler

31import Hakyll.Core.Compiler

29import Hakyll.Core.Identifier

32import Hakyll.Core.Identifier

30import Hakyll.Core.Writable

33import Hakyll.Core.Writable

31import Hakyll.Web.Page

34import Hakyll.Web.Page

32import Hakyll.Web.Pandoc

35import Hakyll.Web.Pandoc

33

36

37+

38+--------------------------------------------------------------------------------

34newtype CSL = CSL FilePath

39newtype CSL = CSL FilePath

35 deriving (Binary, Show, Typeable, Writable)

40 deriving (Binary, Show, Typeable, Writable)

36

41

42+

43+--------------------------------------------------------------------------------

37cslCompiler :: Compiler () CSL

44cslCompiler :: Compiler () CSL

38cslCompiler = getIdentifier >>> arr (CSL . toFilePath)

45cslCompiler = getIdentifier >>> arr (CSL . toFilePath)

39

46

47+

48+--------------------------------------------------------------------------------

40newtype Biblio = Biblio [CSL.Reference]

49newtype Biblio = Biblio [CSL.Reference]

41 deriving (Show, Typeable)

50 deriving (Show, Typeable)

42

51

52+

53+--------------------------------------------------------------------------------

43instance Binary Biblio where

54instance Binary Biblio where

44 -- Ugly.

55 -- Ugly.

45 get = Biblio . read <$> get

56 get = Biblio . read <$> get

@@ -48,14 +59,18 @@ instance Binary Biblio where

48instance Writable Biblio where

59instance Writable Biblio where

49 write _ _ = return ()

60 write _ _ = return ()

50

61

62+

63+--------------------------------------------------------------------------------

51biblioCompiler :: Compiler () Biblio

64biblioCompiler :: Compiler () Biblio

52biblioCompiler = getIdentifier >>>

65biblioCompiler = getIdentifier >>>

53 arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio

66 arr toFilePath >>> unsafeCompiler CSL.readBiblioFile >>> arr Biblio

54

67

68+

69+--------------------------------------------------------------------------------

55pageReadPandocBiblio :: ParserState

70pageReadPandocBiblio :: ParserState

56 -> Identifier CSL

71 -> Identifier CSL

57 -> Identifier Biblio

72 -> Identifier Biblio

58− -> Compiler (Page String) (Page Pandoc)

73+ -> Compiler Page Pandoc

59pageReadPandocBiblio state csl refs = proc page -> do

74pageReadPandocBiblio state csl refs = proc page -> do

60 CSL csl' <- require_ csl -< ()

75 CSL csl' <- require_ csl -< ()

61 Biblio refs' <- require_ refs -< ()

76 Biblio refs' <- require_ refs -< ()

@@ -64,9 +79,8 @@ pageReadPandocBiblio state csl refs = proc page -> do

64 -- citations!

79 -- citations!

65 let cits = map CSL.refId refs'

80 let cits = map CSL.refId refs'

66 state' = state {stateCitations = stateCitations state ++ cits}

81 state' = state {stateCitations = stateCitations state ++ cits}

67− pandocPage <- pageReadPandocWithA -< (state', page)

82+ pandoc <- pageReadPandocWithA -< (state', page)

68− let pandoc = pageBody pandocPage

69 pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)

83 pandoc' <- unsafeCompiler processBiblio' -< (csl', refs', pandoc)

70− returnA -< pandocPage {pageBody = pandoc'}

84+ returnA -< pandoc'

71 where

85 where

72 processBiblio' (c, r, p) = processBiblio c Nothing r p

86 processBiblio' (c, r, p) = processBiblio c Nothing r p

src/Hakyll/Web/Pandoc/FileType.hs+15−8

@@ -1,20 +1,25 @@

1+--------------------------------------------------------------------------------

1-- | A module dealing with pandoc file extensions and associated file types

2-- | A module dealing with pandoc file extensions and associated file types

2−--

3module Hakyll.Web.Pandoc.FileType

4 ( FileType (..)

5 , fileType

6 , getFileType

7 ) where

8

9−import System.FilePath (takeExtension)

10−import Control.Arrow ((>>^))

11

9

12−import Hakyll.Core.Identifier

10+--------------------------------------------------------------------------------

13−import Hakyll.Core.Compiler

11+import Control.Arrow ((>>^))

12+import System.FilePath (takeExtension)

14

13

14+

15+--------------------------------------------------------------------------------

16+import Hakyll.Core.Compiler

17+import Hakyll.Core.Identifier

18+

19+

20+--------------------------------------------------------------------------------

15-- | Datatype to represent the different file types Hakyll can deal with by

21-- | Datatype to represent the different file types Hakyll can deal with by

16-- default

22-- default

17−--

18data FileType

23data FileType

19 = Binary

24 = Binary

20 | Css

25 | Css

@@ -28,8 +33,9 @@ data FileType

28 | Textile

33 | Textile

29 deriving (Eq, Ord, Show, Read)

34 deriving (Eq, Ord, Show, Read)

30

35

36+

37+--------------------------------------------------------------------------------

31-- | Get the file type for a certain file. The type is determined by extension.

38-- | Get the file type for a certain file. The type is determined by extension.

32−--

33fileType :: FilePath -> FileType

39fileType :: FilePath -> FileType

34fileType = fileType' . takeExtension

40fileType = fileType' . takeExtension

35 where

41 where

@@ -53,7 +59,8 @@ fileType = fileType' . takeExtension

53 fileType' ".txt" = PlainText

59 fileType' ".txt" = PlainText

54 fileType' _ = Binary -- Treat unknown files as binary

60 fileType' _ = Binary -- Treat unknown files as binary

55

61

62+

63+--------------------------------------------------------------------------------

56-- | Get the file type for the current file

64-- | Get the file type for the current file

57−--

58getFileType :: Compiler a FileType

65getFileType :: Compiler a FileType

59getFileType = getIdentifier >>^ fileType . toFilePath

66getFileType = getIdentifier >>^ fileType . toFilePath

src/Hakyll/Web/Tags.hs+1

@@ -1,3 +1,4 @@

1+-- TODO: port

1-- | Module containing some specialized functions to deal with tags.

2-- | Module containing some specialized functions to deal with tags.

2-- This Module follows certain conventions. My advice is to stick with them if

3-- This Module follows certain conventions. My advice is to stick with them if

3-- possible.

4-- possible.

src/Hakyll/Web/Template.hs+16−27

@@ -63,8 +63,6 @@

63module Hakyll.Web.Template

64 ( Template

65 , applyTemplate

66− , applyTemplateToPage

67− , applySelf

68 , templateCompiler

66 , templateCompiler

69 , templateCompilerWith

67 , templateCompilerWith

70 , applyTemplateCompiler

68 , applyTemplateCompiler

@@ -76,16 +74,19 @@ import Control.Arrow

76import Control.Category (id)

74import Control.Category (id)

77import qualified Data.Map as M

75import qualified Data.Map as M

78import Data.Maybe (fromMaybe)

76import Data.Maybe (fromMaybe)

77+import Data.Tuple (swap)

79import Prelude hiding (id)

78import Prelude hiding (id)

80import System.FilePath (takeExtension)

79import System.FilePath (takeExtension)

81import Text.Hamlet (HamletSettings,

80import Text.Hamlet (HamletSettings,

82 defaultHamletSettings)

81 defaultHamletSettings)

83

82

83+

84--------------------------------------------------------------------------------

85import Hakyll.Core.Compiler

86import Hakyll.Core.Identifier

87import Hakyll.Core.Util.Arrow

88import Hakyll.Web.Page.Internal

89+import Hakyll.Web.Template.Context

89import Hakyll.Web.Template.Internal

90import Hakyll.Web.Template.Internal

90import Hakyll.Web.Template.Read

91import Hakyll.Web.Template.Read

91

92

@@ -94,12 +95,12 @@ import Hakyll.Web.Template.Read

94applyTemplate :: forall a b. (ArrowChoice a, ArrowMap a)

95applyTemplate :: forall a b. (ArrowChoice a, ArrowMap a)

95 => a (String, b) String

96 => a (String, b) String

96 -> a (Template, b) String

97 -> a (Template, b) String

97−applyTemplate field =

98+applyTemplate context =

98 arr (\(tpl, x) -> [(e, x) | e <- unTemplate tpl]) >>>

99 arr (\(tpl, x) -> [(e, x) | e <- unTemplate tpl]) >>>

99 mapA applyElement >>^ concat

100 mapA applyElement >>^ concat

100 where

101 where

101 applyElement :: a (TemplateElement, b) String

102 applyElement :: a (TemplateElement, b) String

102− applyElement = unElement >>> (id ||| field)

103+ applyElement = unElement >>> (id ||| context)

103

104

104 unElement :: a (TemplateElement, b) (Either String (String, b))

105 unElement :: a (TemplateElement, b) (Either String (String, b))

105 unElement = arr $ \(e, x) -> case e of

106 unElement = arr $ \(e, x) -> case e of

@@ -108,24 +109,6 @@ applyTemplate field =

108 Key k -> Right (k, x)

109 Key k -> Right (k, x)

109

110

111

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−

129--------------------------------------------------------------------------------

112--------------------------------------------------------------------------------

130-- | Read a template. If the extension of the file we're compiling is

113-- | Read a template. If the extension of the file we're compiling is

131-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed

114-- @.hml@ or @.hamlet@, it will be considered as a Hamlet template, and parsed

@@ -133,8 +116,9 @@ applySelf page = applyTemplateToPage (readTemplate $ pageBody page) page

133templateCompiler :: Compiler () Template

116templateCompiler :: Compiler () Template

134templateCompiler = templateCompilerWith defaultHamletSettings

117templateCompiler = templateCompilerWith defaultHamletSettings

135

118

119+

120+--------------------------------------------------------------------------------

136-- | Version of 'templateCompiler' that enables custom settings.

121-- | Version of 'templateCompiler' that enables custom settings.

137−--

138templateCompilerWith :: HamletSettings -> Compiler () Template

122templateCompilerWith :: HamletSettings -> Compiler () Template

139templateCompilerWith settings =

123templateCompilerWith settings =

140 cached "Hakyll.Web.Template.templateCompilerWith" $

124 cached "Hakyll.Web.Template.templateCompilerWith" $

@@ -149,7 +133,12 @@ templateCompilerWith settings =

149

133

150

134

151--------------------------------------------------------------------------------

135--------------------------------------------------------------------------------

152−applyTemplateCompiler :: Identifier Template -- ^ Template

136+applyTemplateCompiler :: Identifier Template -- ^ Template

137+ -> Context Page -- ^ Context

153− -> Compiler (Page String) (Page String) -- ^ Compiler

138+ -> Compiler Page Page -- ^ Compiler

154−applyTemplateCompiler identifier = require identifier $

139+applyTemplateCompiler identifier context = requireA identifier $

155− flip applyTemplateToPage

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

13

14

15--------------------------------------------------------------------------------

16−import Control.Applicative (empty, (<|>))

16+import Control.Applicative (empty, (<|>))

17import Control.Arrow

18−import System.FilePath (takeBaseName, takeDirectory)

18+import System.FilePath (takeBaseName, takeDirectory)

19

20

21--------------------------------------------------------------------------------

22import Hakyll.Core.Compiler

23import Hakyll.Core.Identifier

24+import Hakyll.Web.Page.Internal

24import Hakyll.Web.Urls

25import Hakyll.Web.Urls

25

26

27

27--------------------------------------------------------------------------------

28--------------------------------------------------------------------------------

28−type Context a = Compiler (String, a) String

29+type Context a = Compiler (String, (Identifier a, a)) String

29

30

31

31--------------------------------------------------------------------------------

32--------------------------------------------------------------------------------

32−field :: String -> Compiler a String -> Context a

33+field :: String -> Compiler (Identifier a, a) String -> Context a

33−field key value = arr checkKey >>> empty ||| value

34+field key value = arr checkKey >>> (empty ||| value)

34 where

35 where

35 checkKey (k, x)

36 checkKey (k, x)

36− | k == key = Left ()

37+ | k /= key = Left ()

37 | otherwise = Right x

38 | otherwise = Right x

38

39

40

40--------------------------------------------------------------------------------

41--------------------------------------------------------------------------------

41−defaultContext :: Context (Identifier String, String)

42+defaultContext :: Context Page

42defaultContext =

43defaultContext =

43 bodyField "body" <|>

44 bodyField "body" <|>

44 urlField "url" <|>

45 urlField "url" <|>

45 pathField "path" <|>

46 pathField "path" <|>

46 categoryField "category" <|>

47 categoryField "category" <|>

47− titleField "title"

48+ titleField "title" <|>

49+ missingField

48

50

49

51

50--------------------------------------------------------------------------------

52--------------------------------------------------------------------------------

51−bodyField :: String -> Context (Identifier String, String)

53+bodyField :: String -> Context Page

52bodyField key = field key $ arr snd

54bodyField key = field key $ arr snd

53

55

54

56

55--------------------------------------------------------------------------------

57--------------------------------------------------------------------------------

56−urlField :: String -> Context (Identifier a, a)

58+urlField :: String -> Context a

57urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl

59urlField key = field key $ fst ^>> getRouteFor >>^ maybe empty toUrl

58

60

59

61

60--------------------------------------------------------------------------------

62--------------------------------------------------------------------------------

61−pathField :: String -> Context (Identifier a, a)

63+pathField :: String -> Context a

62pathField key = field key $ arr $ toFilePath . fst

64pathField key = field key $ arr $ toFilePath . fst

63

65

64

66

65--------------------------------------------------------------------------------

67--------------------------------------------------------------------------------

66−categoryField :: String -> Context (Identifier a, a)

68+categoryField :: String -> Context a

67categoryField key = pathField key >>^ (takeBaseName . takeDirectory)

69categoryField key = pathField key >>^ (takeBaseName . takeDirectory)

68

70

69

71

70--------------------------------------------------------------------------------

72--------------------------------------------------------------------------------

71−titleField :: String -> Context (Identifier a, a)

73+titleField :: String -> Context a

72titleField key = pathField key >>^ takeBaseName

74titleField 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+--------------------------------------------------------------------------------

1-- | This module exposes a function which can relativize URL's on a webpage.

2-- | This module exposes a function which can relativize URL's on a webpage.

2--

3--

3-- This means that one can deploy the resulting site on

4-- This means that one can deploy the resulting site on

@@ -13,36 +14,41 @@

13-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:

14-- will result in (suppose your blogpost is located at @\/posts\/foo.html@:

14--

15--

15-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />

16-- > <img src="../images/lolcat.png" alt="Funny zomgroflcopter" />

16−--

17module Hakyll.Web.Urls.Relativize

18 ( relativizeUrlsCompiler

19 , relativizeUrls

20 ) where

21

22−import Prelude hiding (id)

23−import Control.Category (id)

24−import Control.Arrow ((&&&), (>>^))

25−import Data.List (isPrefixOf)

26

22

23+--------------------------------------------------------------------------------

24+import Control.Arrow ((&&&), (>>^))

25+import Control.Category (id)

26+import Data.List (isPrefixOf)

27+import Prelude hiding (id)

28+

29+

30+--------------------------------------------------------------------------------

27−import Hakyll.Core.Compiler

31+import Hakyll.Core.Compiler

28−import Hakyll.Web.Page

32+import Hakyll.Web.Page

29−import Hakyll.Web.Urls

33+import Hakyll.Web.Urls

34+

30

35

36+--------------------------------------------------------------------------------

31-- | Compiler form of 'relativizeUrls' which automatically picks the right root

37-- | Compiler form of 'relativizeUrls' which automatically picks the right root

32-- path

38-- path

33−--

34−relativizeUrlsCompiler :: Compiler (Page String) (Page String)

39+relativizeUrlsCompiler :: Compiler Page Page

35relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize

40relativizeUrlsCompiler = getRoute &&& id >>^ uncurry relativize

36 where

41 where

37 relativize Nothing = id

42 relativize Nothing = id

38− relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)

43+ relativize (Just r) = relativizeUrls $ toSiteRoot r

44+

39

45

46+--------------------------------------------------------------------------------

40-- | Relativize URL's in HTML

47-- | Relativize URL's in HTML

41−--

42relativizeUrls :: String -- ^ Path to the site root

48relativizeUrls :: String -- ^ Path to the site root

43− -> String -- ^ HTML to relativize

49+ -> Page -- ^ HTML to relativize

44− -> String -- ^ Resulting HTML

50+ -> Page -- ^ Resulting HTML

45relativizeUrls root = withUrls rel

51relativizeUrls root = withUrls rel

46 where

52 where

47 isRel x = "/" `isPrefixOf` x && not ("//" `isPrefixOf` x)

53 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