e49cd3b · hakyll · git.iko.soy

src/Hakyll/Core/Compiler.hs+11−2

compare with master

unifiedsplit

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

4module Hakyll.Core.Compiler

5 ( Compiler

6 , getIdentifier

7+ , getRoute

7 , getResourceString

8 , getResourceString

8 , require

9 , require

9 , requireAll

10 , requireAll

@@ -26,10 +27,18 @@ import Hakyll.Core.Writable

26import Hakyll.Core.ResourceProvider

27import Hakyll.Core.ResourceProvider

27import Hakyll.Core.Compiler.Internal

28import Hakyll.Core.Compiler.Internal

28

29

30+-- | Get the identifier of the item that is currently being compiled

31+--

29getIdentifier :: Compiler a Identifier

32getIdentifier :: Compiler a Identifier

30−getIdentifier = fromJob $ const $ CompilerM $

33+getIdentifier = fromJob $ const $ CompilerM $ compilerIdentifier <$> ask

31− compilerIdentifier <$> ask

34+

35+-- | Get the route we are using for this item

36+--

37+getRoute :: Compiler a (Maybe FilePath)

38+getRoute = fromJob $ const $ CompilerM $ compilerRoute <$> ask

32

39

40+-- | Get the resource we are compiling as a string

41+--

33getResourceString :: Compiler a String

42getResourceString :: Compiler a String

34getResourceString = getIdentifier >>> getResourceString'

43getResourceString = getIdentifier >>> getResourceString'

35 where

44 where

src/Hakyll/Core/Compiler/Internal.hs+8−5

@@ -39,6 +39,7 @@ data CompilerEnvironment = CompilerEnvironment

39 { compilerIdentifier :: Identifier -- ^ Target identifier

40 , compilerResourceProvider :: ResourceProvider -- ^ Resource provider

41 , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup

42+ , compilerRoute :: Maybe FilePath -- ^ Site route

42 }

43 }

43

44

44-- | The compiler monad

45-- | The compiler monad

@@ -67,18 +68,20 @@ instance Arrow Compiler where

67

68

68-- | Run a compiler, yielding the resulting target and it's dependencies

69-- | Run a compiler, yielding the resulting target and it's dependencies

69--

70--

70−runCompilerJob :: Compiler () a

71+runCompilerJob :: Compiler () a -- ^ Compiler to run

71− -> Identifier

72+ -> Identifier -- ^ Target identifier

72− -> ResourceProvider

73+ -> ResourceProvider -- ^ Resource provider

73− -> DependencyLookup

74+ -> DependencyLookup -- ^ Dependency lookup table

75+ -> Maybe FilePath -- ^ Route

74 -> IO a

76 -> IO a

75−runCompilerJob compiler identifier provider lookup' =

77+runCompilerJob compiler identifier provider lookup' route =

76 runReaderT (unCompilerM $ compilerJob compiler ()) env

78 runReaderT (unCompilerM $ compilerJob compiler ()) env

77 where

79 where

78 env = CompilerEnvironment

80 env = CompilerEnvironment

79 { compilerIdentifier = identifier

81 { compilerIdentifier = identifier

80 , compilerResourceProvider = provider

82 , compilerResourceProvider = provider

81 , compilerDependencyLookup = lookup'

83 , compilerDependencyLookup = lookup'

84+ , compilerRoute = route

82 }

85 }

83

86

84runCompilerDependencies :: Compiler () a

87runCompilerDependencies :: Compiler () a

src/Hakyll/Core/Run.hs+3−2

@@ -66,10 +66,11 @@ hakyllWith rules provider store = do

66 putStrLn "DONE."

67 where

68 addTarget route' map' (id', comp) = do

69+ let url = runRoute route' id'

69− compiled <- runCompilerJob comp id' provider (dependencyLookup map')

70+ compiled <- runCompilerJob comp id' provider (dependencyLookup map') url

70 putStrLn $ "Generated target: " ++ show id'

71 putStrLn $ "Generated target: " ++ show id'

71

72

72− case runRoute route' id' of

73+ case url of

73 Nothing -> return ()

74 Nothing -> return ()

74 Just r -> do

75 Just r -> do

75 putStrLn $ "Routing " ++ show id' ++ " to " ++ r

76 putStrLn $ "Routing " ++ show id' ++ " to " ++ r

src/Hakyll/Web/Page.hs+10−21

@@ -6,35 +6,24 @@

6module Hakyll.Web.Page

7 ( Page (..)

8 , toMap

9+ , pageRead

9 ) where

10 ) where

10

11

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

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

12

13

13import Data.Map (Map)

14import Data.Map (Map)

14import qualified Data.Map as M

15import qualified Data.Map as M

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

16−import Data.Typeable (Typeable)

17

16

18−import Hakyll.Core.Writable

17+import Hakyll.Core.Compiler

19−

18+import Hakyll.Web.Page.Internal

20−-- | Type used to represent pages

19+import Hakyll.Web.Page.Read

21−--

22−data Page a = Page

23− { pageMetadata :: Map String String

24− , pageBody :: a

25− } deriving (Show, Typeable)

26−

27−instance Functor Page where

28− fmap f (Page m b) = Page m (f b)

29−

30−instance Binary a => Binary (Page a) where

31− put (Page m b) = put m >> put b

32− get = Page <$> get <*> get

33−

34−instance Writable a => Writable (Page a) where

35− write p (Page _ b) = write p b

36

20

37-- | Convert a page to a map. The body will be placed in the @body@ key.

21-- | Convert a page to a map. The body will be placed in the @body@ key.

38--

22--

39toMap :: Page String -> Map String String

23toMap :: Page String -> Map String String

40toMap (Page m b) = M.insert "body" b m

24toMap (Page m b) = M.insert "body" b m

25+

26+-- | Read a page (do not render it)

27+--

28+pageRead :: Compiler a (Page String)

29+pageRead = getResourceString >>^ readPage

src/Hakyll/Web/Page/Internal.hsnew file+31

@@ -0,0 +1,31 @@

1+-- | Internal representation of the page datatype

2+--

3+{-# LANGUAGE DeriveDataTypeable #-}

4+module Hakyll.Web.Page.Internal

5+ ( Page (..)

6+ ) where

7+

8+import Control.Applicative ((<$>), (<*>))

9+

10+import Data.Map (Map)

11+import Data.Binary (Binary, get, put)

12+import Data.Typeable (Typeable)

13+

14+import Hakyll.Core.Writable

15+

16+-- | Type used to represent pages

17+--

18+data Page a = Page

19+ { pageMetadata :: Map String String

20+ , pageBody :: a

21+ } deriving (Show, Typeable)

22+

23+instance Functor Page where

24+ fmap f (Page m b) = Page m (f b)

25+

26+instance Binary a => Binary (Page a) where

27+ put (Page m b) = put m >> put b

28+ get = Page <$> get <*> get

29+

30+instance Writable a => Writable (Page a) where

31+ write p (Page _ b) = write p b

src/Hakyll/Web/Page/Read.hs+1−1

@@ -11,7 +11,7 @@ import Data.List (isPrefixOf)

11import Data.Map (Map)

12import qualified Data.Map as M

13

14−import Hakyll.Web.Page

14+import Hakyll.Web.Page.Internal

15import Hakyll.Web.Util.String

16

17-- | We're using a simple state monad as parser

src/Hakyll/Web/Util/String.hs+12

@@ -2,13 +2,25 @@

2--

3module Hakyll.Web.Util.String

4 ( trim

5+ , toSiteRoot

5 ) where

6 ) where

6

7

7import Data.Char (isSpace)

8import Data.Char (isSpace)

8

9

10+import System.FilePath (splitPath, takeDirectory, joinPath)

11+

9-- | Trim a string (drop spaces, tabs and newlines at both sides).

12-- | Trim a string (drop spaces, tabs and newlines at both sides).

10--

13--

11trim :: String -> String

14trim :: String -> String

12trim = reverse . trim' . reverse . trim'

15trim = reverse . trim' . reverse . trim'

13 where

16 where

14 trim' = dropWhile isSpace

17 trim' = dropWhile isSpace

18+

19+-- | Get the relative url to the site root, for a given (absolute) url

20+--

21+toSiteRoot :: FilePath -> FilePath

22+toSiteRoot = emptyException . joinPath . map parent . splitPath . takeDirectory

23+ where

24+ parent = const ".."

25+ emptyException [] = "."

26+ emptyException x = x