60cda32 · hakyll · git.iko.soy

src/Hakyll/Web.hs+6−13

compare with master

unifiedsplit

@@ -3,8 +3,7 @@

3module Hakyll.Web

4 ( defaultPageRead

5 , defaultTemplateRead

6− , defaultHamletTemplateRead

6+ , defaultTemplateReadWith

7− , defaultHamletTemplateReadWith

8 , defaultRelativizeUrls

7 , defaultRelativizeUrls

9 , defaultCopyFile

8 , defaultCopyFile

10 , defaultCompressCss

9 , defaultCompressCss

@@ -15,7 +14,7 @@ import Prelude hiding (id)

15import Control.Category (id)

14import Control.Category (id)

16import Control.Arrow (arr, (>>>), (>>^), (&&&))

15import Control.Arrow (arr, (>>>), (>>^), (&&&))

17

16

18−import Text.Hamlet (HamletSettings, defaultHamletSettings)

17+import Text.Hamlet (HamletSettings)

19

18

20import Hakyll.Core.Compiler

19import Hakyll.Core.Compiler

21import Hakyll.Core.Writable

20import Hakyll.Core.Writable

@@ -23,7 +22,6 @@ import Hakyll.Core.Identifier

23import Hakyll.Web.Page

22import Hakyll.Web.Page

24import Hakyll.Web.Pandoc

23import Hakyll.Web.Pandoc

25import Hakyll.Web.Template

24import Hakyll.Web.Template

26−import Hakyll.Web.Template.Read

27import Hakyll.Web.RelativizeUrls

25import Hakyll.Web.RelativizeUrls

28import Hakyll.Web.Util.String

26import Hakyll.Web.Util.String

29import Hakyll.Web.CompressCss

27import Hakyll.Web.CompressCss

@@ -39,16 +37,11 @@ defaultRelativizeUrls = getRoute &&& id >>^ uncurry relativize

39 relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)

37 relativize (Just r) = fmap (relativizeUrls $ toSiteRoot r)

40

38

41defaultTemplateRead :: Compiler () Template

39defaultTemplateRead :: Compiler () Template

42−defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $

40+defaultTemplateRead = cached "Hakyll.Web.defaultTemplateRead" $ templateRead

43− getResourceString >>^ readTemplate

44

41

45−defaultHamletTemplateRead :: Compiler () Template

46−defaultHamletTemplateRead = defaultHamletTemplateReadWith defaultHamletSettings

47−

48−defaultHamletTemplateReadWith :: HamletSettings -> Compiler () Template

42+defaultTemplateReadWith :: HamletSettings -> Compiler () Template

49−defaultHamletTemplateReadWith settings =

43+defaultTemplateReadWith settings = cached "Hakyll.Web.defaultTemplateReadWith" $

50− cached "Hakyll.Web.defaultHamletTemplateReadWith" $

44+ templateReadWith settings

51− getResourceString >>^ readHamletTemplateWith settings

52

45

53defaultCopyFile :: Compiler () CopyFile

46defaultCopyFile :: Compiler () CopyFile

54defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath

47defaultCopyFile = getIdentifier >>^ CopyFile . toFilePath

src/Hakyll/Web/Template.hs+29−1

@@ -2,11 +2,19 @@ module Hakyll.Web.Template

2 ( Template

3 , applyTemplate

4 , applySelf

5+ , templateRead

6+ , templateReadWith

5 ) where

7 ) where

6

8

9+import Control.Arrow

7import Data.Maybe (fromMaybe)

10import Data.Maybe (fromMaybe)

8import qualified Data.Map as M

11import qualified Data.Map as M

12+import System.FilePath (takeExtension)

9

13

14+import Text.Hamlet (HamletSettings, defaultHamletSettings)

15+

16+import Hakyll.Core.Compiler

17+import Hakyll.Core.Identifier

10import Hakyll.Web.Template.Internal

18import Hakyll.Web.Template.Internal

11import Hakyll.Web.Template.Read

19import Hakyll.Web.Template.Read

12import Hakyll.Web.Page

20import Hakyll.Web.Page

@@ -20,7 +28,7 @@ applyTemplate template page =

20 fmap (const $ substitute =<< unTemplate template) page

28 fmap (const $ substitute =<< unTemplate template) page

21 where

29 where

22 substitute (Chunk chunk) = chunk

30 substitute (Chunk chunk) = chunk

23− substitute (Identifier key) =

31+ substitute (Key key) =

24 fromMaybe ('$' : key) $ M.lookup key $ toMap page

32 fromMaybe ('$' : key) $ M.lookup key $ toMap page

25 substitute (Escaped) = "$"

33 substitute (Escaped) = "$"

26

34

@@ -29,3 +37,23 @@ applyTemplate template page =

29--

37--

30applySelf :: Page String -> Page String

38applySelf :: Page String -> Page String

31applySelf page = applyTemplate (readTemplate $ pageBody page) page

39applySelf page = applyTemplate (readTemplate $ pageBody page) page

40+

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

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

43+-- as such.

44+--

45+templateRead :: Compiler a Template

46+templateRead = templateReadWith defaultHamletSettings

47+

48+-- | Version of 'templateRead' that enables custom settings.

49+--

50+templateReadWith :: HamletSettings -> Compiler a Template

51+templateReadWith settings =

52+ getIdentifier &&& getResourceString >>^ uncurry read'

53+ where

54+ read' identifier string =

55+ if takeExtension (toFilePath identifier) `elem` [".hml", ".hamlet"]

56+ -- Hamlet template

57+ then readHamletTemplateWith settings string

58+ -- Hakyll template

59+ else readTemplate string

src/Hakyll/Web/Template/Internal.hs+4−4

@@ -28,18 +28,18 @@ instance Writable Template where

28--

29data TemplateElement

30 = Chunk String

31− | Identifier String

31+ | Key String

32 | Escaped

33 deriving (Show, Eq, Typeable)

34

35instance Binary TemplateElement where

36 put (Chunk string) = putWord8 0 >> put string

37− put (Identifier key) = putWord8 1 >> put key

37+ put (Key key) = putWord8 1 >> put key

38 put (Escaped) = putWord8 2

39

40 get = getWord8 >>= \tag -> case tag of

41− 0 -> Chunk <$> get

41+ 0 -> Chunk <$> get

42− 1 -> Identifier <$> get

42+ 1 -> Key <$> get

43 2 -> return Escaped

44 _ -> error $ "Hakyll.Web.Template.Internal: "

45 ++ "Error reading cached template"

src/Hakyll/Web/Template/Read/Hakyll.hs+7−7

@@ -19,17 +19,17 @@ readTemplate = Template . readTemplate'

19 | "$$" `isPrefixOf` string =

20 Escaped : readTemplate' (drop 2 string)

21 | "$" `isPrefixOf` string =

22− case readIdentifier (drop 1 string) of

22+ case readKey (drop 1 string) of

23− Just (key, rest) -> Identifier key : readTemplate' rest

23+ Just (key, rest) -> Key key : readTemplate' rest

24 Nothing -> Chunk "$" : readTemplate' (drop 1 string)

25 | otherwise =

26 let (chunk, rest) = break (== '$') string

27 in Chunk chunk : readTemplate' rest

28

29− -- Parse an identifier into (identifier, rest) if it's valid, and return

29+ -- Parse an key into (key, rest) if it's valid, and return

30 -- Nothing otherwise

31− readIdentifier string =

31+ readKey string =

32− let (identifier, rest) = span isAlphaNum string

32+ let (key, rest) = span isAlphaNum string

33− in if not (null identifier) && "$" `isPrefixOf` rest

33+ in if not (null key) && "$" `isPrefixOf` rest

34− then Just (identifier, drop 1 rest)

34+ then Just (key, drop 1 rest)

35 else Nothing

src/Hakyll/Web/Template/Read/Hamlet.hs+1−1

@@ -35,7 +35,7 @@ fromHamletRT (HamletRT sd) = Template $ map fromSimpleDoc sd

35 where

36 fromSimpleDoc :: SimpleDoc -> TemplateElement

37 fromSimpleDoc (SDRaw chunk) = Chunk chunk

38− fromSimpleDoc (SDVar [var]) = Identifier var

38+ fromSimpleDoc (SDVar [var]) = Key var

39 fromSimpleDoc (SDVar _) = error

40 "Hakyll.Web.Template.Read.Hamlet.fromHamletRT: \

41 \Hakyll does not support '.' in identifier names when using \