27ff2ee · hakyll · git.iko.soy

src/Hakyll/Core/CompiledItem.hsnew file+39

compare with master

unifiedsplit

@@ -0,0 +1,39 @@

1+-- | A module containing a box datatype representing a compiled item. This

2+-- item can be of any type, given that a few restrictions hold (e.g. we want

3+-- a 'Typeable' instance to perform type-safe casts).

4+--

5+{-# LANGUAGE ExistentialQuantification #-}

6+module Hakyll.Core.CompiledItem

7+ ( CompiledItem

8+ , compiledItem

9+ , unCompiledItem

10+ ) where

11+

12+import Data.Binary (Binary)

13+import Data.Typeable (Typeable, cast)

14+

15+import Hakyll.Core.Writable

16+

17+-- | Box type for a compiled item

18+--

19+data CompiledItem = forall a. (Binary a, Typeable a, Writable a)

20+ => CompiledItem a

21+

22+instance Writable CompiledItem where

23+ write p (CompiledItem x) = write p x

24+

25+-- | Box a value into a 'CompiledItem'

26+--

27+compiledItem :: (Binary a, Typeable a, Writable a)

28+ => a

29+ -> CompiledItem

30+compiledItem = CompiledItem

31+

32+-- | Unbox a value from a 'CompiledItem'

33+--

34+unCompiledItem :: (Binary a, Typeable a, Writable a)

35+ => CompiledItem

36+ -> a

37+unCompiledItem (CompiledItem x) = case cast x of

38+ Just x' -> x'

39+ Nothing -> error "unCompiledItem: Unsupported type"

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

@@ -16,10 +16,14 @@ import Control.Monad.State (State, modify, runState)

16import Control.Monad.Reader (ReaderT, ask, runReaderT)

17import Data.Set (Set)

18import qualified Data.Set as S

19+import Data.Typeable (Typeable)

20+import Data.Binary (Binary)

19

21

20import Hakyll.Core.Identifier

22import Hakyll.Core.Identifier

21import Hakyll.Core.Target

23import Hakyll.Core.Target

22import Hakyll.Core.Target.Internal

24import Hakyll.Core.Target.Internal

25+import Hakyll.Core.CompiledItem

26+import Hakyll.Core.Writable

23

27

24-- | A set of dependencies

28-- | A set of dependencies

25--

29--

@@ -27,7 +31,7 @@ type Dependencies = Set Identifier

27

31

28-- | Add one dependency

32-- | Add one dependency

29--

33--

30−addDependency :: Identifier -> CompilerM a ()

34+addDependency :: Identifier -> CompilerM ()

31addDependency dependency = CompilerM $ modify $ addDependency'

35addDependency dependency = CompilerM $ modify $ addDependency'

32 where

36 where

33 addDependency' x = x

37 addDependency' x = x

@@ -36,8 +40,8 @@ addDependency dependency = CompilerM $ modify $ addDependency'

36

40

37-- | Environment in which a compiler runs

41-- | Environment in which a compiler runs

38--

42--

39−data CompilerEnvironment a = CompilerEnvironment

43+data CompilerEnvironment = CompilerEnvironment

40− { compilerIdentifier :: Identifier -- ^ Target identifier

44+ { compilerIdentifier :: Identifier -- ^ Target identifier

41 }

45 }

42

46

43-- | State carried along by a compiler

47-- | State carried along by a compiler

@@ -48,18 +52,18 @@ data CompilerState = CompilerState

48

52

49-- | The compiler monad

53-- | The compiler monad

50--

54--

51−newtype CompilerM a b = CompilerM

55+newtype CompilerM a = CompilerM

52− { unCompilerM :: ReaderT (CompilerEnvironment a) (State CompilerState) b

56+ { unCompilerM :: ReaderT CompilerEnvironment (State CompilerState) a

53 } deriving (Monad, Functor, Applicative)

57 } deriving (Monad, Functor, Applicative)

54

58

55-- | Simplified type for a compiler generating a target (which covers most

59-- | Simplified type for a compiler generating a target (which covers most

56-- cases)

60-- cases)

57--

61--

58−type Compiler a = CompilerM a (TargetM a a)

62+type Compiler a = CompilerM (TargetM a)

59

63

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

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

61--

65--

62−runCompiler :: Compiler a -> Identifier -> (TargetM a a, Dependencies)

66+runCompiler :: Compiler a -> Identifier -> (TargetM a, Dependencies)

63runCompiler compiler identifier = second compilerDependencies $

67runCompiler compiler identifier = second compilerDependencies $

64 runState (runReaderT (unCompilerM compiler) env) state

68 runState (runReaderT (unCompilerM compiler) env) state

65 where

69 where

@@ -69,15 +73,18 @@ runCompiler compiler identifier = second compilerDependencies $

69-- | Require another target. Using this function ensures automatic handling of

73-- | Require another target. Using this function ensures automatic handling of

70-- dependencies

74-- dependencies

71--

75--

76+require :: (Binary a, Typeable a, Writable a)

72−require :: Identifier

77+ => Identifier

73 -> Compiler a

78 -> Compiler a

74require identifier = do

79require identifier = do

75 addDependency identifier

80 addDependency identifier

81+ return $ TargetM $ do

76− return $ TargetM $ flip targetDependencyLookup identifier <$> ask

82+ lookup' <- targetDependencyLookup <$> ask

83+ return $ unCompiledItem $ lookup' identifier

77

84

78-- | Construct a target from a string, this string being the content of the

85-- | Construct a target from a string, this string being the content of the

79-- resource.

86-- resource.

80--

87--

81−compileFromString :: (String -> TargetM a a) -- ^ Function to create the target

88+compileFromString :: (String -> TargetM a) -- ^ Function to create the target

82− -> Compiler a -- ^ Resulting compiler

89+ -> Compiler a -- ^ Resulting compiler

83compileFromString = return . (getResourceString >>=)

90compileFromString = return . (getResourceString >>=)

src/Hakyll/Core/Rules.hs+26−13

@@ -15,57 +15,69 @@ module Hakyll.Core.Rules

15import Control.Applicative (Applicative, (<$>))

16import Control.Monad.Writer

17import Control.Monad.Reader

18+import Control.Arrow (second)

19+

20+import Data.Typeable (Typeable)

21+import Data.Binary (Binary)

18

22

19import Hakyll.Core.ResourceProvider

23import Hakyll.Core.ResourceProvider

20import Hakyll.Core.Identifier

24import Hakyll.Core.Identifier

21import Hakyll.Core.Identifier.Pattern

25import Hakyll.Core.Identifier.Pattern

22import Hakyll.Core.Compiler

26import Hakyll.Core.Compiler

23import Hakyll.Core.Route

27import Hakyll.Core.Route

28+import Hakyll.Core.CompiledItem

29+import Hakyll.Core.Writable

24

30

25-- | A collection of rules for the compilation process

31-- | A collection of rules for the compilation process

26--

32--

27−data RuleSet a = RuleSet

33+data RuleSet = RuleSet

28 { rulesRoute :: Route

34 { rulesRoute :: Route

29− , rulesCompilers :: [(Identifier, Compiler a)]

35+ , rulesCompilers :: [(Identifier, Compiler CompiledItem)]

30 }

36 }

31

37

32−instance Monoid (RuleSet a) where

38+instance Monoid RuleSet where

33 mempty = RuleSet mempty mempty

39 mempty = RuleSet mempty mempty

34 mappend (RuleSet r1 c1) (RuleSet r2 c2) =

40 mappend (RuleSet r1 c1) (RuleSet r2 c2) =

35 RuleSet (mappend r1 r2) (mappend c1 c2)

41 RuleSet (mappend r1 r2) (mappend c1 c2)

36

42

37-- | The monad used to compose rules

43-- | The monad used to compose rules

38--

44--

39−newtype RulesM a b = RulesM

45+newtype RulesM a = RulesM

40− { unRulesM :: ReaderT ResourceProvider (Writer (RuleSet a)) b

46+ { unRulesM :: ReaderT ResourceProvider (Writer RuleSet) a

41 } deriving (Monad, Functor, Applicative)

47 } deriving (Monad, Functor, Applicative)

42

48

43-- | Simplification of the RulesM type; usually, it will not return any

49-- | Simplification of the RulesM type; usually, it will not return any

44-- result.

50-- result.

45--

51--

46−type Rules a = RulesM a ()

52+type Rules = RulesM ()

47

53

48-- | Run a Rules monad, resulting in a 'RuleSet'

54-- | Run a Rules monad, resulting in a 'RuleSet'

49--

55--

50−runRules :: Rules a -> ResourceProvider -> RuleSet a

56+runRules :: Rules -> ResourceProvider -> RuleSet

51runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider

57runRules rules provider = execWriter $ runReaderT (unRulesM rules) provider

52

58

53-- | Add a route

59-- | Add a route

54--

60--

55−addRoute :: Route -> Rules a

61+addRoute :: Route -> Rules

56addRoute route' = RulesM $ tell $ RuleSet route' mempty

62addRoute route' = RulesM $ tell $ RuleSet route' mempty

57

63

58-- | Add a number of compilers

64-- | Add a number of compilers

59--

65--

66+addCompilers :: (Binary a, Typeable a, Writable a)

60−addCompilers :: [(Identifier, Compiler a)] -> Rules a

67+ => [(Identifier, Compiler a)]

68+ -> Rules

61−addCompilers compilers = RulesM $ tell $ RuleSet mempty compilers

69+addCompilers compilers = RulesM $ tell $ RuleSet mempty $

70+ map (second boxCompiler) compilers

71+ where

72+ boxCompiler = fmap (fmap compiledItem)

62

73

63-- | Add a compilation rule

74-- | Add a compilation rule

64--

75--

65-- This instructs all resources matching the given pattern to be compiled using

76-- This instructs all resources matching the given pattern to be compiled using

66-- the given compiler

77-- the given compiler

67--

78--

79+compile :: (Binary a, Typeable a, Writable a)

68−compile :: Pattern -> Compiler a -> Rules a

80+ => Pattern -> Compiler a -> Rules

69compile pattern compiler = RulesM $ do

81compile pattern compiler = RulesM $ do

70 identifiers <- matches pattern . resourceList <$> ask

82 identifiers <- matches pattern . resourceList <$> ask

71 unRulesM $ addCompilers $ zip identifiers (repeat compiler)

83 unRulesM $ addCompilers $ zip identifiers (repeat compiler)

@@ -74,10 +86,11 @@ compile pattern compiler = RulesM $ do

74--

86--

75-- This sets a compiler for the given identifier

87-- This sets a compiler for the given identifier

76--

88--

89+create :: (Binary a, Typeable a, Writable a)

77−create :: Identifier -> Compiler a -> RulesM a ()

90+ => Identifier -> Compiler a -> Rules

78create identifier compiler = addCompilers [(identifier, compiler)]

91create identifier compiler = addCompilers [(identifier, compiler)]

79

92

80-- | Add a route

93-- | Add a route

81--

94--

82−route :: Pattern -> Route -> RulesM a ()

95+route :: Pattern -> Route -> Rules

83route pattern route' = addRoute $ ifMatch pattern route'

96route pattern route' = addRoute $ ifMatch pattern route'

src/Hakyll/Core/Run.hs+21−13

@@ -5,6 +5,9 @@ module Hakyll.Core.Run where

5import Control.Arrow ((&&&))

6import Control.Monad (foldM, forM_)

7import qualified Data.Map as M

8+import Data.Monoid (mempty)

9+import Data.Typeable (Typeable)

10+import Data.Binary (Binary)

8

11

9import Hakyll.Core.Route

12import Hakyll.Core.Route

10import Hakyll.Core.Compiler

13import Hakyll.Core.Compiler

@@ -16,14 +19,15 @@ import Hakyll.Core.DirectedGraph

16import Hakyll.Core.DirectedGraph.DependencySolver

19import Hakyll.Core.DirectedGraph.DependencySolver

17import Hakyll.Core.Writable

20import Hakyll.Core.Writable

18import Hakyll.Core.Store

21import Hakyll.Core.Store

22+import Hakyll.Core.CompiledItem

19

23

20−hakyll :: Writable a => Rules a -> IO ()

24+hakyll :: Rules -> IO ()

21hakyll rules = do

25hakyll rules = do

22 store <- makeStore "_store"

26 store <- makeStore "_store"

23 provider <- fileResourceProvider

27 provider <- fileResourceProvider

24 hakyllWith rules provider store

28 hakyllWith rules provider store

25

29

26−hakyllWith :: Writable a => Rules a -> ResourceProvider -> Store -> IO ()

30+hakyllWith :: Rules -> ResourceProvider -> Store -> IO ()

27hakyllWith rules provider store = do

31hakyllWith rules provider store = do

28 let -- Get the rule set

32 let -- Get the rule set

29 ruleSet = runRules rules provider

33 ruleSet = runRules rules provider

@@ -48,22 +52,26 @@ hakyllWith rules provider store = do

48 -- Join the order with the targets again

52 -- Join the order with the targets again

49 orderedTargets = map (id &&& (targetMap M.!)) ordered

53 orderedTargets = map (id &&& (targetMap M.!)) ordered

50

54

55+ -- Fetch the routes

56+ route' = rulesRoute ruleSet

57+

51 -- Generate all the targets in order

58 -- Generate all the targets in order

52− map' <- foldM addTarget M.empty orderedTargets

59+ _ <- foldM (addTarget route') M.empty orderedTargets

53

60

54− let -- Fetch the routes

61+ putStrLn "DONE."

55− route' = rulesRoute ruleSet

62+ where

63+ addTarget route' map' (id', targ) = do

64+ compiled <- runTarget targ id' (dependencyLookup map') provider store

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

56

66

57− forM_ (M.toList map') $ \(id', result) ->

58 case runRoute route' id' of

67 case runRoute route' id' of

59 Nothing -> return ()

68 Nothing -> return ()

60 Just r -> do

69 Just r -> do

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

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

62− write r result

71+ write r compiled

63

72

64− putStrLn "DONE."

73+ return $ M.insert id' compiled map'

65− where

74+

66− addTarget map' (id', targ) = do

75+ dependencyLookup map' id' = case M.lookup id' map' of

67− result <- runTarget targ id' (map' M.!) provider store

76+ Nothing -> error $ "dependencyLookup: " ++ show id' ++ " not found"

68− putStrLn $ "Generated target: " ++ show id'

77+ Just d -> d

69− return $ M.insert id' result map'

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

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

4module Hakyll.Core.Target

5 ( DependencyLookup

6 , TargetM

7− , Target

8 , runTarget

7 , runTarget

9 , getIdentifier

8 , getIdentifier

10 , getResourceString

9 , getResourceString

@@ -20,12 +19,12 @@ import Hakyll.Core.ResourceProvider

20

19

21-- | Get the current identifier

20-- | Get the current identifier

22--

21--

23−getIdentifier :: TargetM a Identifier

22+getIdentifier :: TargetM Identifier

24getIdentifier = TargetM $ targetIdentifier <$> ask

23getIdentifier = TargetM $ targetIdentifier <$> ask

25

24

26-- | Get the resource content as a string

25-- | Get the resource content as a string

27--

26--

28−getResourceString :: TargetM a String

27+getResourceString :: TargetM String

29getResourceString = TargetM $ do

28getResourceString = TargetM $ do

30 provider <- targetResourceProvider <$> ask

29 provider <- targetResourceProvider <$> ask

31 identifier <- unTargetM getIdentifier

30 identifier <- unTargetM getIdentifier

src/Hakyll/Core/Target/Internal.hs+12−17

@@ -1,11 +1,10 @@

1-- | Internal structure of a Target, not exported outside of the library

2--

3−{-# LANGUAGE GeneralizedNewtypeDeriving #-}

3+{-# LANGUAGE GeneralizedNewtypeDeriving, Rank2Types #-}

4module Hakyll.Core.Target.Internal

5 ( DependencyLookup

6 , TargetEnvironment (..)

7 , TargetM (..)

8− , Target

9 , runTarget

8 , runTarget

10 ) where

9 ) where

11

10

@@ -17,18 +16,19 @@ import Control.Monad.State (StateT, evalStateT)

17import Hakyll.Core.Identifier

16import Hakyll.Core.Identifier

18import Hakyll.Core.ResourceProvider

17import Hakyll.Core.ResourceProvider

19import Hakyll.Core.Store

18import Hakyll.Core.Store

19+import Hakyll.Core.CompiledItem

20

21-- | A lookup with which we can get dependencies

22--

23−type DependencyLookup a = Identifier -> a

23+type DependencyLookup = Identifier -> CompiledItem

24

25-- | Environment for the target monad

26--

27−data TargetEnvironment a = TargetEnvironment

27+data TargetEnvironment = TargetEnvironment

28− { targetIdentifier :: Identifier -- ^ Identifier

28+ { targetIdentifier :: Identifier -- ^ Identifier

29− , targetDependencyLookup :: DependencyLookup a -- ^ Dependency lookup

29+ , targetDependencyLookup :: DependencyLookup -- ^ Dependency lookup

30− , targetResourceProvider :: ResourceProvider -- ^ To get resources

30+ , targetResourceProvider :: ResourceProvider -- ^ To get resources

31− , targetStore :: Store -- ^ Store for caching

31+ , targetStore :: Store -- ^ Store for caching

32 }

33

34-- | State for the target monad

@@ -40,20 +40,15 @@ data TargetState = TargetState

40-- | Monad for targets. In this monad, the user can compose targets and describe

41-- how they should be created.

42--

43−newtype TargetM a b = TargetM

43+newtype TargetM a = TargetM

44− { unTargetM :: ReaderT (TargetEnvironment a) (StateT TargetState IO) b

44+ { unTargetM :: ReaderT TargetEnvironment (StateT TargetState IO) a

45 } deriving (Monad, Functor, Applicative, MonadIO)

46

47−-- | Simplification of the 'TargetM' type for concrete cases: the type of the

48−-- returned item should equal the type of the dependencies.

49−--

50−type Target a = TargetM a a

51−

52-- | Run a target, yielding an actual result.

47-- | Run a target, yielding an actual result.

53--

48--

54−runTarget :: Target a

49+runTarget :: TargetM a

55 -> Identifier

50 -> Identifier

56− -> DependencyLookup a

51+ -> DependencyLookup

57 -> ResourceProvider

52 -> ResourceProvider

58 -> Store

53 -> Store

59 -> IO a

54 -> IO a

src/Hakyll/Web/FileType.hs+1−1

@@ -51,5 +51,5 @@ fileType = fileType' . takeExtension

51

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

53--

54−getFileType :: TargetM a FileType

54+getFileType :: TargetM FileType

55getFileType = fileType . toFilePath <$> getIdentifier

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

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

2-- type 'String') and number of metadata fields. This type is used to represent

3-- pages on your website.

4--

5+{-# LANGUAGE DeriveDataTypeable #-}

5module Hakyll.Web.Page

6module Hakyll.Web.Page

6 ( Page (..)

7 ( Page (..)

7 , toMap

8 , toMap

@@ -12,6 +13,7 @@ import Control.Applicative ((<$>), (<*>))

12import Data.Map (Map)

13import Data.Map (Map)

13import qualified Data.Map as M

14import qualified Data.Map as M

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

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

16+import Data.Typeable (Typeable)

15

17

16import Hakyll.Core.Writable

18import Hakyll.Core.Writable

17

19

@@ -20,7 +22,7 @@ import Hakyll.Core.Writable

20data Page a = Page

22data Page a = Page

21 { pageMetadata :: Map String String

23 { pageMetadata :: Map String String

22 , pageBody :: a

24 , pageBody :: a

23− }

25+ } deriving (Show, Typeable)

24

26

25instance Functor Page where

27instance Functor Page where

26 fmap f (Page m b) = Page m (f b)

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

src/Hakyll/Web/Pandoc.hs+9−9

@@ -29,9 +29,9 @@ import Hakyll.Web.Page

29

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

31--

32−readPandoc :: FileType -- ^ File type, determines how parsing happens

32+readPandoc :: FileType -- ^ File type, determines how parsing happens

33− -> String -- ^ String to read

33+ -> String -- ^ String to read

34− -> Pandoc -- ^ Resulting document

34+ -> Pandoc -- ^ Resulting document

35readPandoc = readPandocWith defaultParserState

36

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

@@ -51,8 +51,8 @@ readPandocWith state fileType' = case fileType' of

51

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

53--

54−writePandoc :: Pandoc -- ^ Document to write

54+writePandoc :: Pandoc -- ^ Document to write

55− -> String -- ^ Resulting HTML

55+ -> String -- ^ Resulting HTML

56writePandoc = writePandocWith defaultWriterOptions

57

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

@@ -64,19 +64,19 @@ writePandocWith = P.writeHtmlString

64

65-- | Read the resource using pandoc

66--

67−pageReadPandoc :: Page String -> TargetM a (Page Pandoc)

67+pageReadPandoc :: Page String -> TargetM (Page Pandoc)

68pageReadPandoc = pageReadPandocWith defaultParserState

69

70-- | Read the resource using pandoc

71--

72−pageReadPandocWith :: P.ParserState -> Page String -> TargetM a (Page Pandoc)

72+pageReadPandocWith :: P.ParserState -> Page String -> TargetM (Page Pandoc)

73pageReadPandocWith state page = do

74 fileType' <- getFileType

75 return $ readPandocWith state fileType' <$> page

76

77-- | Render the resource using pandoc

78--

79−pageRenderPandoc :: Page String -> TargetM a (Page String)

79+pageRenderPandoc :: Page String -> TargetM (Page String)

80pageRenderPandoc = pageRenderPandocWith defaultParserState defaultWriterOptions

81

82-- | Render the resource using pandoc

@@ -84,7 +84,7 @@ pageRenderPandoc = pageRenderPandocWith defaultParserState defaultWriterOptions

84pageRenderPandocWith :: P.ParserState

85 -> P.WriterOptions

86 -> Page String

87− -> TargetM a (Page String)

87+ -> TargetM (Page String)

88pageRenderPandocWith state options page = do

89 pandoc <- pageReadPandocWith state page

90 return $ writePandocWith options <$> pandoc