e49cd3b · hakyll · git.iko.soy

git.iko.soy/hakyll

Cleanup, split up page module

commite49cd3b4b071c2e0cb3e553fe8272e7cd2843349 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 30 Dec 2010, 21:18 (16 years ago) parentda12825

7 files changed+76−31

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+11−2 src/Hakyll/Core/Compiler/Internal.hs+8−5 src/Hakyll/Core/Run.hs+3−2 src/Hakyll/Web/Page.hs+10−21 src/Hakyll/Web/Page/Internal.hs+31 src/Hakyll/Web/Page/Read.hs+1−1 src/Hakyll/Web/Util/String.hs+12

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

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

44module Hakyll.Core.Compiler

55 ( Compiler

66 , getIdentifier

7+ , getRoute

78 , getResourceString

89 , require

910 , requireAll

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

2627import Hakyll.Core.ResourceProvider

2728import Hakyll.Core.Compiler.Internal

2829

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

31+--

2932getIdentifier :: Compiler a Identifier

30−getIdentifier = fromJob $ const $ CompilerM $

31− compilerIdentifier <$> ask

33+getIdentifier = fromJob $ const $ CompilerM $ 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

3239

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

41+--

3342getResourceString :: Compiler a String

3443getResourceString = getIdentifier >>> getResourceString'

3544 where

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

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

3939 { compilerIdentifier :: Identifier -- ^ Target identifier

4040 , compilerResourceProvider :: ResourceProvider -- ^ Resource provider

4141 , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup

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

4243 }

4344

4445-- | The compiler monad

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

6768

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

6970--

70−runCompilerJob :: Compiler () a

71− -> Identifier

72− -> ResourceProvider

73− -> DependencyLookup

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

72+ -> Identifier -- ^ Target identifier

73+ -> ResourceProvider -- ^ Resource provider

74+ -> DependencyLookup -- ^ Dependency lookup table

75+ -> Maybe FilePath -- ^ Route

7476 -> IO a

75−runCompilerJob compiler identifier provider lookup' =

77+runCompilerJob compiler identifier provider lookup' route =

7678 runReaderT (unCompilerM $ compilerJob compiler ()) env

7779 where

7880 env = CompilerEnvironment

7981 { compilerIdentifier = identifier

8082 , compilerResourceProvider = provider

8183 , compilerDependencyLookup = lookup'

84+ , compilerRoute = route

8285 }

8386

8487runCompilerDependencies :: Compiler () a

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

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

6666 putStrLn "DONE."

6767 where

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

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

69+ let url = runRoute route' id'

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

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

7172

72− case runRoute route' id' of

73+ case url of

7374 Nothing -> return ()

7475 Just r -> do

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

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

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

66module Hakyll.Web.Page

77 ( Page (..)

88 , toMap

9+ , pageRead

910 ) where

1011

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

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

1213

1314import Data.Map (Map)

1415import qualified Data.Map as M

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

16−import Data.Typeable (Typeable)

1716

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

17+import Hakyll.Core.Compiler

18+import Hakyll.Web.Page.Internal

19+import Hakyll.Web.Page.Read

3620

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

3822--

3923toMap :: Page String -> Map String String

4024toMap (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

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

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)

1111import Data.Map (Map)

1212import qualified Data.Map as M

1313

14−import Hakyll.Web.Page

14+import Hakyll.Web.Page.Internal

1515import Hakyll.Web.Util.String

1616

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

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

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

22--

33module Hakyll.Web.Util.String

44 ( trim

5+ , toSiteRoot

56 ) where

78import Data.Char (isSpace)

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

11+

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

1013--

1114trim :: String -> String

1215trim = reverse . trim' . reverse . trim'

1316 where

1417 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