6bcad27 · hakyll · git.iko.soy

hakyll.cabal−1

@@ -24,7 +24,6 @@ library

2424 ghc-options: -Wall

2525 hs-source-dirs: src/

2626 build-depends: base >= 4 && < 5,

27− template >= 0.1.1,

2827 filepath >= 1.1,

2928 directory >= 1,

3029 containers >= 0.1,

src/Network/Hakyll/SimpleServer.hs+1−1

@@ -48,7 +48,7 @@ instance Show Request where

4848readRequest :: Handle -> Server Request

4949readRequest handle = do

5050 requestLine <- liftIO $ hGetLine handle

51− let [method, uri, version] = map trim $ split " " requestLine

51+ let [method, uri, version] = map trim $ splitRegex " " requestLine

5252 return $ Request { requestMethod = B.pack method

5353 , requestURI = B.pack uri

5454 , requestVersion = B.pack version

src/Text/Hakyll/CompressCSS.hs+5−5

@@ -3,7 +3,7 @@ module Text.Hakyll.CompressCSS

33 ) where

44

55import Data.List (isPrefixOf)

6−import Text.Hakyll.Regex (substitute)

6+import Text.Hakyll.Regex (substituteRegex)

77

88-- | Compress CSS to speed up your site.

99compressCSS :: String -> String

@@ -13,13 +13,13 @@ compressCSS = compressSeparators

1313

1414-- | Compresses certain forms of separators.

1515compressSeparators :: String -> String

16−compressSeparators = substitute "; *}" "}"

17− . substitute " *([{};:]) *" "\\1"

18− . substitute ";;*" ";"

16+compressSeparators = substituteRegex "; *}" "}"

17+ . substituteRegex " *([{};:]) *" "\\1"

18+ . substituteRegex ";;*" ";"

1919

2020-- | Compresses all whitespace.

2121compressWhitespace :: String -> String

22−compressWhitespace = substitute "[ \t\n][ \t\n]*" " "

22+compressWhitespace = substituteRegex "[ \t\n][ \t\n]*" " "

2323

2424-- | Function that strips CSS comments away.

2525stripComments :: String -> String

src/Text/Hakyll/Context.hs+14−12

@@ -1,20 +1,23 @@

11-- | Module containing various functions to manipulate contexts.

22module Text.Hakyll.Context

3− ( ContextManipulation

3+ ( Context

4+ , ContextManipulation

45 , renderValue

56 , renderDate

67 ) where

78

89import qualified Data.Map as M

9−import qualified Data.ByteString.Lazy.Char8 as B

10+import Data.Map (Map)

1011

1112import System.Locale (defaultTimeLocale)

1213import System.FilePath (takeFileName)

13−import Text.Template (Context)

1414import Data.Time.Format (parseTime, formatTime)

1515import Data.Time.Clock (UTCTime)

1616import Data.Maybe (fromMaybe)

17−import Text.Hakyll.Regex (substitute)

17+import Text.Hakyll.Regex (substituteRegex)

18+

19+-- | Type for a context.

20+type Context = Map String String

1821

1922-- | Type for context manipulating functions.

2023type ContextManipulation = Context -> Context

@@ -22,11 +25,11 @@ type ContextManipulation = Context -> Context

2225-- | Do something with a value of a context.

2326renderValue :: String -- ^ Key of which the value should be copied.

2427 -> String -- ^ Key the value should be copied to.

25− -> (B.ByteString -> B.ByteString) -- ^ Function to apply on the value.

28+ -> (String -> String) -- ^ Function to apply on the value.

2629 -> ContextManipulation

27−renderValue src dst f context = case M.lookup (B.pack src) context of

30+renderValue src dst f context = case M.lookup src context of

2831 Nothing -> context

29− (Just value) -> M.insert (B.pack dst) (f value) context

32+ (Just value) -> M.insert dst (f value) context

3033

3134-- | When the context has a key called `path` in a `yyyy-mm-dd-title.extension`

3235-- format (default for pages), this function can render the date.

@@ -34,12 +37,11 @@ renderDate :: String -- ^ Key in which the rendered date should be placed.

3437 -> String -- ^ Format to use on the date.

3538 -> String -- ^ Default value when the date cannot be parsed.

3639 -> ContextManipulation

37−renderDate key format defaultValue context =

38− M.insert (B.pack key) (B.pack value) context

40+renderDate key format defaultValue context = M.insert key value context

3941 where value = fromMaybe defaultValue pretty

40− pretty = do filePath <- M.lookup (B.pack "path") context

41− let dateString = substitute "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"

42− (takeFileName $ B.unpack filePath)

42+ pretty = do filePath <- M.lookup "path" context

43+ let dateString = substituteRegex "^([0-9]*-[0-9]*-[0-9]*).*" "\\1"

44+ (takeFileName filePath)

4345 time <- parseTime defaultTimeLocale

4446 "%Y-%m-%d"

4547 dateString :: Maybe UTCTime

src/Text/Hakyll/Page.hs+17−22

@@ -8,7 +8,6 @@ module Text.Hakyll.Page

88

99import qualified Data.Map as M

1010import qualified Data.List as L

11−import qualified Data.ByteString.Lazy.Char8 as B

1211import Data.Maybe (fromMaybe)

1312

1413import System.FilePath (FilePath, takeExtension)

@@ -16,10 +15,10 @@ import System.IO

1615

1716import Text.Hakyll.File

1817import Text.Hakyll.Util (trim)

18+import Text.Hakyll.Context (Context)

1919import Text.Hakyll.Renderable

2020import Text.Pandoc

2121

22−import Text.Template (Context)

2322

2423-- | A Page is basically key-value mapping. Certain keys have special

2524-- meanings, like for example url, body and title.

@@ -31,26 +30,22 @@ fromContext = Page

3130

3231-- | Obtain a value from a page. Will resturn an empty string when nothing is

3332-- found.

34−getValue :: String -> Page -> B.ByteString

35−getValue str (Page page) = fromMaybe B.empty $ M.lookup (B.pack str) page

36−

37−-- | Auxiliary function to pack a pair.

38−packPair :: (String, String) -> (B.ByteString, B.ByteString)

39−packPair (a, b) = (B.pack a, B.pack b)

33+getValue :: String -> Page -> String

34+getValue str (Page page) = fromMaybe [] $ M.lookup str page

4035

4136-- | Get the URL for a certain page. This should always be defined. If

4237-- not, it will error.

4338getPageURL :: Page -> String

44−getPageURL (Page page) = B.unpack $ fromMaybe (error "No page url") $ M.lookup (B.pack "url") page

39+getPageURL (Page page) = fromMaybe (error "No page url") $ M.lookup "url" page

4540

4641-- | Get the original page path.

4742getPagePath :: Page -> String

48−getPagePath (Page page) = B.unpack $ fromMaybe (error "No page path") $ M.lookup (B.pack "path") page

43+getPagePath (Page page) = fromMaybe (error "No page path") $ M.lookup "path" page

4944

5045-- | Get the body for a certain page. When not defined, the body will be

5146-- empty.

52−getBody :: Page -> B.ByteString

53−getBody (Page page) = fromMaybe B.empty $ M.lookup (B.pack "body") page

47+getBody :: Page -> String

48+getBody (Page page) = fromMaybe [] $ M.lookup "body" page

5449

5550-- | The default writer options for pandoc rendering.

5651writerOptions :: WriterOptions

@@ -86,13 +81,13 @@ cachePage page@(Page mapping) = do

8681 makeDirectories destination

8782 handle <- openFile destination WriteMode

8883 hPutStrLn handle "---"

89− mapM_ (writePair handle) $ M.toList $ M.delete (B.pack "body") mapping

84+ mapM_ (writePair handle) $ M.toList $ M.delete "body" mapping

9085 hPutStrLn handle "---"

91− B.hPut handle $ getBody page

86+ hPutStr handle $ getBody page

9287 hClose handle

93− where writePair h (k, v) = B.hPut h k >>

94− B.hPut h (B.pack ": ") >>

95− B.hPut h v >>

88+ where writePair h (k, v) = hPutStr h k >>

89+ hPutStr h ": " >>

90+ hPutStr h v >>

9691 hPutStrLn h ""

9792

9893-- | Read a page from a file. Metadata is supported, and if the filename

@@ -114,13 +109,13 @@ readPage pagePath = do

114109 else hGetContents handle >>= \b -> return ([], line ++ b)

115110

116111 -- Render file

117− let rendered = B.pack $ (renderFunction $ takeExtension path) body

112+ let rendered = (renderFunction $ takeExtension path) body

118113 seq rendered $ hClose handle

119114 let page = fromContext $ M.fromList $

120− [ (B.pack "body", rendered)

121− , packPair ("url", url)

122− , packPair ("path", pagePath)

123− ] ++ map packPair context

115+ [ ("body", rendered)

116+ , ("url", url)

117+ , ("path", pagePath)

118+ ] ++ context

124119

125120 -- Cache if needed

126121 if getFromCache then return () else cachePage page

src/Text/Hakyll/Regex.hs+17−17

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

11-- | A module that exports a simple regex interface. This code is mostly copied

22-- from the regex-compat package at hackage.

33module Text.Hakyll.Regex

4− ( split

5− , substitute

4+ ( splitRegex

5+ , substituteRegex

66 ) where

77

88import Text.Regex.TDFA

@@ -13,10 +13,10 @@ matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String])

1313matchRegexAll p str = matchM p str

1414

1515-- | Replaces every occurance of the given regexp with the replacement string.

16−subRegex :: Regex -- ^ Search pattern

17− -> String -- ^ Input string

18− -> String -- ^ Replacement text

19− -> String -- ^ Output string

16+subRegex :: Regex -- ^ Search pattern

17+ -> String -- ^ Input string

18+ -> String -- ^ Replacement text

19+ -> String -- ^ Output string

2020subRegex _ "" _ = ""

2121subRegex regexp inp replacement =

2222 let -- bre matches a backslash then capture either a backslash or some digits

@@ -43,9 +43,9 @@ subRegex regexp inp replacement =

4343

4444-- | Splits a string based on a regular expression. The regular expression

4545-- should identify one delimiter.

46−splitRegex :: Regex -> String -> [String]

47−splitRegex _ [] = []

48−splitRegex delim strIn = loop strIn where

46+splitRegex' :: Regex -> String -> [String]

47+splitRegex' _ [] = []

48+splitRegex' delim strIn = loop strIn where

4949 loop str = case matchOnceText delim str of

5050 Nothing -> [str]

5151 Just (firstline, _, remainder) ->

@@ -54,13 +54,13 @@ splitRegex delim strIn = loop strIn where

5454 else firstline : loop remainder

5555

5656-- | Split a list at a certain element.

57−split :: String -> String -> [String]

58−split pattern = filter (not . null)

59− . splitRegex (makeRegex pattern)

57+splitRegex :: String -> String -> [String]

58+splitRegex pattern = filter (not . null)

59+ . splitRegex' (makeRegex pattern)

6060

6161-- | Substitute a regex. Simplified interface.

62−substitute :: String -- ^ Pattern to replace (regex).

63− -> String -- ^ Replacement string.

64− -> String -- ^ Input string.

65− -> String -- ^ Result.

66−substitute pattern replacement str = subRegex (makeRegex pattern) str replacement

62+substituteRegex :: String -- ^ Pattern to replace (regex).

63+ -> String -- ^ Replacement string.

64+ -> String -- ^ Input string.

65+ -> String -- ^ Result.

66+substituteRegex pattern replacement str = subRegex (makeRegex pattern) str replacement

src/Text/Hakyll/Render.hs+29−15

@@ -10,15 +10,16 @@ module Text.Hakyll.Render

1010 , css

1111 ) where

1212

13−import Text.Template hiding (render)

14−import qualified Data.ByteString.Lazy.Char8 as B

1513import qualified Data.Map as M

14+import Data.List (isPrefixOf)

1615import Control.Monad (unless, liftM, foldM)

16+import Data.Char (isAlpha)

17+import Data.Maybe (fromMaybe)

1718

1819import System.Directory (copyFile)

1920import System.IO

2021

21−import Text.Hakyll.Context (ContextManipulation)

22+import Text.Hakyll.Context (Context, ContextManipulation)

2223import Text.Hakyll.Page

2324import Text.Hakyll.Renderable

2425import Text.Hakyll.File

@@ -33,6 +34,19 @@ depends file dependencies action = do

3334 valid <- isCacheValid (toDestination file) dependencies

3435 unless valid action

3536

37+-- | Substitutes `$identifiers` in the given string by values from the given

38+-- "Context". When a key is not found, it is left as it is.

39+substitute :: String -> Context -> String

40+substitute [] _ = []

41+substitute string context

42+ | "$$" `isPrefixOf` string = "$$" ++ (substitute (tail tail') context)

43+ | "$" `isPrefixOf` string = substitute'

44+ | otherwise = (head string) : (substitute tail' context)

45+ where tail' = tail string

46+ (key, rest) = break (not . isAlpha) tail'

47+ replacement = fromMaybe ('$' : key) $ M.lookup key context

48+ substitute' = replacement ++ substitute rest context

49+

3650-- | Render to a Page.

3751render :: Renderable a

3852 => FilePath -- ^ Template to use for rendering.

@@ -49,18 +63,18 @@ renderWith :: Renderable a

4963 -> IO Page -- ^ The body of the result will contain the render.

5064renderWith manipulation templatePath renderable = do

5165 handle <- openFile templatePath ReadMode

52− templateString <- liftM B.pack $ hGetContents handle

66+ templateString <- hGetContents handle

5367 seq templateString $ hClose handle

5468 context <- liftM manipulation $ toContext renderable

5569 -- Ignore $root when substituting here. We will only replace that in the

5670 -- final render (just before writing).

57− let contextIgnoringRoot = M.insert (B.pack "root") (B.pack "$root") context

71+ let contextIgnoringRoot = M.insert "root" "$root" context

5872 body = substitute templateString contextIgnoringRoot

59− return $ fromContext (M.insert (B.pack "body") body context)

73+ return $ fromContext (M.insert "body" body context)

6074

6175-- | Render each renderable with the given template, then concatenate the

6276-- result.

63−renderAndConcat :: Renderable a => FilePath -> [a] -> IO B.ByteString

77+renderAndConcat :: Renderable a => FilePath -> [a] -> IO String

6478renderAndConcat = renderAndConcatWith id

6579

6680-- | Render each renderable with the given template, then concatenate the

@@ -70,14 +84,14 @@ renderAndConcatWith :: Renderable a

7084 => ContextManipulation

7185 -> FilePath

7286 -> [a]

73− -> IO B.ByteString

87+ -> IO String

7488renderAndConcatWith manipulation templatePath renderables =

75− foldM concatRender' B.empty renderables

76− where concatRender' :: Renderable a => B.ByteString -> a -> IO B.ByteString

89+ foldM concatRender' [] renderables

90+ where concatRender' :: Renderable a => String -> a -> IO String

7791 concatRender' chunk renderable = do

7892 rendered <- renderWith manipulation templatePath renderable

7993 let body = getBody rendered

80− return $ B.append chunk $ body

94+ return $ chunk ++ body

8195

8296-- | Chain a render action for a page with a number of templates. This will

8397-- also write the result to the site destination. This is the preferred way

@@ -100,11 +114,11 @@ writePage :: Page -> IO ()

100114writePage page = do

101115 let destination = toDestination url

102116 makeDirectories destination

103− B.writeFile destination body

117+ writeFile destination body

104118 where url = getURL page

105− -- Substitute $root here, just before writing.

106− body = substitute (getBody page)

107− (M.singleton (B.pack "root") (B.pack $ toRoot url))

119+ -- Substitute $root here, just before writing.

120+ body = substitute (getBody page)

121+ (M.singleton "root" $ toRoot url)

108122

109123-- | Mark a certain file as static, so it will just be copied when the site is

110124-- generated.

src/Text/Hakyll/Renderable.hs+1−1

@@ -3,7 +3,7 @@ module Text.Hakyll.Renderable

33 ) where

44

55import System.FilePath (FilePath)

6−import Text.Template (Context)

6+import Text.Hakyll.Context (Context)

77

88-- | A class for datatypes that can be rendered to pages.

99class Renderable a where

src/Text/Hakyll/Renderables.hs+5−7

@@ -6,7 +6,6 @@ module Text.Hakyll.Renderables

66 ) where

77

88import System.FilePath (FilePath)

9−import qualified Data.ByteString.Lazy.Char8 as B

109import qualified Data.Map as M

1110import Text.Hakyll.Page

1211import Text.Hakyll.Renderable

@@ -16,13 +15,13 @@ import Text.Hakyll.File

1615data CustomPage = CustomPage

1716 { url :: String,

1817 dependencies :: [FilePath],

19− mapping :: [(String, Either String (IO B.ByteString))]

18+ mapping :: [(String, Either String (IO String))]

2019 }

2120

2221-- | Create a custom page.

2322createCustomPage :: String -- ^ Destination of the page, relative to _site.

2423 -> [FilePath] -- ^ Dependencies of the page.

25− -> [(String, Either String (IO B.ByteString))] -- ^ Key - value mapping for rendering.

24+ -> [(String, Either String (IO String))] -- ^ Key - value mapping for rendering.

2625 -> CustomPage

2726createCustomPage = CustomPage

2827

@@ -30,10 +29,9 @@ instance Renderable CustomPage where

3029 getDependencies = dependencies

3130 getURL = url

3231 toContext page = do

33− values <- mapM (either (return . B.pack) (>>= return) . snd) (mapping page)

34− let keys = map (B.pack . fst) (mapping page)

35− return $ M.fromList $ [ (B.pack "url", B.pack $ url page)

36− ] ++ zip keys values

32+ values <- mapM (either (return) (>>= return) . snd) (mapping page)

33+ return $ M.fromList $ [ ("url", url page)

34+ ] ++ zip (map fst $ mapping page) values

3735

3836-- | PagePath is a class that wraps a FilePath. This is used to render Pages

3937-- without reading them first through use of caching.

src/Text/Hakyll/Tags.hs+3−4

@@ -7,7 +7,6 @@ module Text.Hakyll.Tags

77 ) where

88

99import qualified Data.Map as M

10−import qualified Data.ByteString.Lazy.Char8 as B

1110import Data.List (intercalate)

1211import Control.Monad (foldM)

1312

@@ -24,7 +23,7 @@ readTagMap :: [FilePath] -> IO (M.Map String [FilePath])

2423readTagMap paths = foldM addPaths M.empty paths

2524 where addPaths current path = do

2625 page <- readPage path

27− let tags = map trim $ split "," $ B.unpack $ getValue ("tags") page

26+ let tags = map trim $ splitRegex "," $ getValue ("tags") page

2827 return $ foldr (\t -> M.insertWith (++) t [path]) current tags

2928

3029-- | Render a tag cloud.

@@ -57,6 +56,6 @@ renderTagCloud tagMap urlFunction minSize maxSize =

5756renderTagLinks :: (String -> String) -- ^ Function that produces an url for a tag.

5857 -> ContextManipulation

5958renderTagLinks urlFunction = renderValue "tags" "tags" renderTagLinks'

60− where renderTagLinks' = B.pack . intercalate ", "

59+ where renderTagLinks' = intercalate ", "

6160 . map (\t -> link t $ urlFunction t)

62− . map trim . split "," . B.unpack

61+ . map trim . splitRegex ","

tests/Tests.hs+5−5

@@ -26,8 +26,8 @@ tests = [ testGroup "Util group" [ testProperty "trim length" prop_trim_length

2626 , testCase "link 2" test_link2

2727 ]

2828

29− , testGroup "Regex group" [ testCase "split 1" test_split1

30− , testCase "split 2" test_split2

29+ , testGroup "Regex group" [ testCase "splitRegex 1" test_split_regex1

30+ , testCase "splitRegex 2" test_split_regex2

3131 ]

3232

3333 , testGroup "CompressCSS group" [ testProperty "compressCSS length" prop_compress_css_length

@@ -71,9 +71,9 @@ test_strip_html3 = stripHTML "<b>Hakyll</b> is an <i>awesome</i> web framework <

7171test_link1 = link "foo bar" "/foo/bar.html" @?= "<a href=\"/foo/bar.html\">foo bar</a>"

7272test_link2 = link "back home" "/" @?= "<a href=\"/\">back home</a>"

7373

74−-- Split test cases.

75−test_split1 = split "," "1,2,3" @?= ["1", "2", "3"]

76−test_split2 = split "," ",1,2," @?= ["1", "2"]

74+-- Split Regex test cases.

75+test_split_regex1 = split "," "1,2,3" @?= ["1", "2", "3"]

76+test_split_regex2 = split "," ",1,2," @?= ["1", "2"]

7777

7878-- CSS compression should always decrease the text length.

7979prop_compress_css_length str = length str >= length (compressCSS str)