da12825 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Compiler → {Compiler, Compiler.Internal}

da12825Jasper Van der Jeugt16 years ago

src/Hakyll/Core/Compiler.hs+10−88

compare with master

unifiedsplit

@@ -2,11 +2,7 @@

2--

3{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4module Hakyll.Core.Compiler

5− ( Dependencies

6− , CompilerM

7− , Compiler (..)

5+ ( Compiler

8− , runCompiler

9− , getDependencies

10 , getIdentifier

6 , getIdentifier

11 , getResourceString

7 , getResourceString

12 , require

8 , require

@@ -14,16 +10,11 @@ module Hakyll.Core.Compiler

14 ) where

10 ) where

16import Prelude hiding ((.), id)

12import Prelude hiding ((.), id)

17−import Control.Arrow (second, (>>>))

13+import Control.Arrow ((>>>))

18−import Control.Applicative (Applicative, (<$>))

14+import Control.Applicative ((<$>))

19−import Control.Monad.State (State, modify, runState)

15+import Control.Monad.Reader (ask)

20−import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)

21import Control.Monad.Trans (liftIO)

16import Control.Monad.Trans (liftIO)

22−import Control.Monad ((<=<), liftM2)

23−import Data.Set (Set)

24−import qualified Data.Set as S

25−import Control.Category (Category, (.), id)

17+import Control.Category (Category, (.))

26−import Control.Arrow (Arrow, arr, first)

28import Data.Binary (Binary)

19import Data.Binary (Binary)

29import Data.Typeable (Typeable)

20import Data.Typeable (Typeable)

@@ -33,85 +24,16 @@ import Hakyll.Core.Identifier.Pattern

33import Hakyll.Core.CompiledItem

24import Hakyll.Core.CompiledItem

34import Hakyll.Core.Writable

25import Hakyll.Core.Writable

35import Hakyll.Core.ResourceProvider

26import Hakyll.Core.ResourceProvider

36−

27+import Hakyll.Core.Compiler.Internal

37−-- | A set of dependencies

38−--

39−type Dependencies = Set Identifier

40−

41−-- | A lookup with which we can get dependencies

42−--

43−type DependencyLookup = Identifier -> CompiledItem

44−

45−-- | Environment in which a compiler runs

46−--

47−data CompilerEnvironment = CompilerEnvironment

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

49− , compilerResourceProvider :: ResourceProvider -- ^ Resource provider

50− , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup

51− }

52−

53−-- | The compiler monad

54−--

55−newtype CompilerM a = CompilerM

56− { unCompilerM :: ReaderT CompilerEnvironment IO a

57− } deriving (Monad, Functor, Applicative)

58−

59−-- | The compiler arrow

60−--

61−data Compiler a b = Compiler

62− { compilerDependencies :: Reader ResourceProvider Dependencies

63− , compilerJob :: a -> CompilerM b

64− }

65−

66−instance Category Compiler where

67− id = Compiler (return S.empty) return

68− (Compiler d1 j1) . (Compiler d2 j2) =

69− Compiler (liftM2 S.union d1 d2) (j1 <=< j2)

70−

71−instance Arrow Compiler where

72− arr f = Compiler (return S.empty) (return . f)

73− first (Compiler d j) = Compiler d $ \(x, y) -> do

74− x' <- j x

75− return (x', y)

76−

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

78−--

79−runCompiler :: Compiler () a

80− -> Identifier

81− -> ResourceProvider

82− -> DependencyLookup

83− -> IO a

84−runCompiler compiler identifier provider lookup' =

85− runReaderT (unCompilerM $ compilerJob compiler ()) env

86− where

87− env = CompilerEnvironment

88− { compilerIdentifier = identifier

89− , compilerResourceProvider = provider

90− , compilerDependencyLookup = lookup'

91− }

92−

93−getDependencies :: Compiler () a

94− -> ResourceProvider

95− -> Dependencies

96−getDependencies compiler provider =

97− runReader (compilerDependencies compiler) provider

98−

99−addDependencies :: (ResourceProvider -> [Identifier])

100− -> Compiler b b

101−addDependencies deps = Compiler (S.fromList . deps <$> ask) return

102−

103−fromCompilerM :: (a -> CompilerM b)

104− -> Compiler a b

105−fromCompilerM = Compiler (return S.empty)

106

107getIdentifier :: Compiler a Identifier

29getIdentifier :: Compiler a Identifier

108−getIdentifier = fromCompilerM $ const $ CompilerM $

30+getIdentifier = fromJob $ const $ CompilerM $

109 compilerIdentifier <$> ask

31 compilerIdentifier <$> ask

110

111getResourceString :: Compiler a String

33getResourceString :: Compiler a String

112getResourceString = getIdentifier >>> getResourceString'

34getResourceString = getIdentifier >>> getResourceString'

113 where

35 where

114− getResourceString' = fromCompilerM $ \id' -> CompilerM $ do

36+ getResourceString' = fromJob $ \id' -> CompilerM $ do

115 provider <- compilerResourceProvider <$> ask

37 provider <- compilerResourceProvider <$> ask

116 liftIO $ resourceString provider id'

38 liftIO $ resourceString provider id'

117

@@ -123,7 +45,7 @@ require :: (Binary a, Typeable a, Writable a)

123 -> (b -> a -> c)

45 -> (b -> a -> c)

124 -> Compiler b c

46 -> Compiler b c

125require identifier f =

47require identifier f =

126− addDependencies (const [identifier]) >>> fromCompilerM require'

48+ fromDependencies (const [identifier]) >>> fromJob require'

127 where

49 where

128 require' x = CompilerM $ do

50 require' x = CompilerM $ do

129 lookup' <- compilerDependencyLookup <$> ask

51 lookup' <- compilerDependencyLookup <$> ask

@@ -137,7 +59,7 @@ requireAll :: (Binary a, Typeable a, Writable a)

137 -> (b -> [a] -> c)

59 -> (b -> [a] -> c)

138 -> Compiler b c

60 -> Compiler b c

139requireAll pattern f =

61requireAll pattern f =

140− addDependencies getDeps >>> fromCompilerM requireAll'

62+ fromDependencies getDeps >>> fromJob requireAll'

141 where

63 where

142 getDeps = matches pattern . resourceList

64 getDeps = matches pattern . resourceList

143 requireAll' x = CompilerM $ do

65 requireAll' x = CompilerM $ do

src/Hakyll/Core/Compiler/Internal.hsnew file+96

@@ -0,0 +1,96 @@

1+-- | Internally used compiler module

2+--

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+module Hakyll.Core.Compiler.Internal

5+ ( Dependencies

6+ , CompilerEnvironment (..)

7+ , CompilerM (..)

8+ , Compiler (..)

9+ , runCompilerJob

10+ , runCompilerDependencies

11+ , fromJob

12+ , fromDependencies

13+ ) where

14+

15+import Prelude hiding ((.), id)

16+import Control.Applicative (Applicative, (<$>))

17+import Control.Monad.Reader (ReaderT, Reader, ask, runReaderT, runReader)

18+import Control.Monad ((<=<), liftM2)

19+import Data.Set (Set)

20+import qualified Data.Set as S

21+import Control.Category (Category, (.), id)

22+import Control.Arrow (Arrow, arr, first)

23+

24+import Hakyll.Core.Identifier

25+import Hakyll.Core.CompiledItem

26+import Hakyll.Core.ResourceProvider

27+

28+-- | A set of dependencies

29+--

30+type Dependencies = Set Identifier

31+

32+-- | A lookup with which we can get dependencies

33+--

34+type DependencyLookup = Identifier -> CompiledItem

35+

36+-- | Environment in which a compiler runs

37+--

38+data CompilerEnvironment = CompilerEnvironment

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

40+ , compilerResourceProvider :: ResourceProvider -- ^ Resource provider

41+ , compilerDependencyLookup :: DependencyLookup -- ^ Dependency lookup

42+ }

43+

44+-- | The compiler monad

45+--

46+newtype CompilerM a = CompilerM

47+ { unCompilerM :: ReaderT CompilerEnvironment IO a

48+ } deriving (Monad, Functor, Applicative)

49+

50+-- | The compiler arrow

51+--

52+data Compiler a b = Compiler

53+ { compilerDependencies :: Reader ResourceProvider Dependencies

54+ , compilerJob :: a -> CompilerM b

55+ }

56+

57+instance Category Compiler where

58+ id = Compiler (return S.empty) return

59+ (Compiler d1 j1) . (Compiler d2 j2) =

60+ Compiler (liftM2 S.union d1 d2) (j1 <=< j2)

61+

62+instance Arrow Compiler where

63+ arr f = Compiler (return S.empty) (return . f)

64+ first (Compiler d j) = Compiler d $ \(x, y) -> do

65+ x' <- j x

66+ return (x', y)

67+

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

69+--

70+runCompilerJob :: Compiler () a

71+ -> Identifier

72+ -> ResourceProvider

73+ -> DependencyLookup

74+ -> IO a

75+runCompilerJob compiler identifier provider lookup' =

76+ runReaderT (unCompilerM $ compilerJob compiler ()) env

77+ where

78+ env = CompilerEnvironment

79+ { compilerIdentifier = identifier

80+ , compilerResourceProvider = provider

81+ , compilerDependencyLookup = lookup'

82+ }

83+

84+runCompilerDependencies :: Compiler () a

85+ -> ResourceProvider

86+ -> Dependencies

87+runCompilerDependencies compiler provider =

88+ runReader (compilerDependencies compiler) provider

89+

90+fromJob :: (a -> CompilerM b)

91+ -> Compiler a b

92+fromJob = Compiler (return S.empty)

93+

94+fromDependencies :: (ResourceProvider -> [Identifier])

95+ -> Compiler b b

96+fromDependencies deps = Compiler (S.fromList . deps <$> ask) return

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

@@ -14,6 +14,7 @@ import Hakyll.Core.Route

14import Hakyll.Core.Identifier

15import Hakyll.Core.Util.File

16import Hakyll.Core.Compiler

17+import Hakyll.Core.Compiler.Internal

17import Hakyll.Core.ResourceProvider

18import Hakyll.Core.ResourceProvider

18import Hakyll.Core.ResourceProvider.FileResourceProvider

19import Hakyll.Core.ResourceProvider.FileResourceProvider

19import Hakyll.Core.Rules

20import Hakyll.Core.Rules

@@ -40,7 +41,7 @@ hakyllWith rules provider store = do

41 -- Get all dependencies

42 -- Get all dependencies

42 dependencies = flip map compilers $ \(id', compiler) ->

43 dependencies = flip map compilers $ \(id', compiler) ->

43− let deps = getDependencies compiler provider

44+ let deps = runCompilerDependencies compiler provider

44 in (id', deps)

45 in (id', deps)

46 -- Create a compiler map

47 -- Create a compiler map

@@ -65,7 +66,7 @@ hakyllWith rules provider store = do

65 putStrLn "DONE."

66 putStrLn "DONE."

66 where

67 where

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

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

68− compiled <- runCompiler comp id' provider (dependencyLookup map')

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

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

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

71 case runRoute route' id' of

72 case runRoute route' id' of