1c1133d · hakyll · git.iko.soy

git.iko.soy/hakyll

More arrows

commit1c1133dfd6adae7c9c667d47eabaabb89cf8bdf9 authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 30 Dec 2010, 10:02 (16 years ago) parent6268e4a

4 files changed+77−38

compare with master

unifiedsplit

src/Hakyll/Core/Compiler.hs+33−21 src/Hakyll/Core/Run.hs+1−1 src/Hakyll/Core/Util/Arrow.hs+28 src/Hakyll/Web/Pandoc.hs+15−16

src/Hakyll/Core/Compiler.hs+33−21

@@ -6,10 +6,11 @@ module Hakyll.Core.Compiler

66 , CompilerM

77 , Compiler (..)

88 , runCompiler

9+ , getDependencies

910 , getIdentifier

1011 , getResourceString

1112 , require

12− -- , requireAll

13+ , requireAll

1314 -- , compileFromString

1415 ) where

1516

@@ -17,9 +18,9 @@ import Prelude hiding ((.), id)

1718import Control.Arrow (second, (>>>))

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

1920import Control.Monad.State (State, modify, runState)

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

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

2122import Control.Monad.Trans (liftIO)

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

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

2324import Data.Set (Set)

2425import qualified Data.Set as S

2526import Control.Category (Category, (.), id)

@@ -59,18 +60,17 @@ newtype CompilerM a = CompilerM

5960-- | The compiler arrow

6061--

6162data Compiler a b = Compiler

62− { -- TODO: Reader ResourceProvider Dependencies

63− compilerDependencies :: Dependencies

63+ { compilerDependencies :: Reader ResourceProvider Dependencies

6464 , compilerJob :: a -> CompilerM b

6565 }

6666

6767instance Category Compiler where

68− id = Compiler S.empty return

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

6969 (Compiler d1 j1) . (Compiler d2 j2) =

70− Compiler (d1 `S.union` d2) (j1 <=< j2)

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

7171

7272instance Arrow Compiler where

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

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

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

7575 x' <- j x

7676 return (x', y)

@@ -91,13 +91,19 @@ runCompiler compiler identifier provider lookup' =

9191 , compilerDependencyLookup = lookup'

9292 }

9393

94−addDependency :: Identifier

95− -> Compiler b b

96−addDependency id' = Compiler (S.singleton id') return

94+getDependencies :: Compiler () a

95+ -> ResourceProvider

96+ -> Dependencies

97+getDependencies compiler provider =

98+ runReader (compilerDependencies compiler) provider

99+

100+addDependencies :: (ResourceProvider -> [Identifier])

101+ -> Compiler b b

102+addDependencies deps = Compiler (S.fromList . deps <$> ask) return

97103

98104fromCompilerM :: (a -> CompilerM b)

99105 -> Compiler a b

100−fromCompilerM = Compiler S.empty

106+fromCompilerM = Compiler (return S.empty)

101107

102108getIdentifier :: Compiler () Identifier

103109getIdentifier = fromCompilerM $ const $ CompilerM $

@@ -115,26 +121,32 @@ getResourceString = getIdentifier >>> getResourceString'

115121--

116122require :: (Binary a, Typeable a, Writable a)

117123 => Identifier

118− -> (a -> b -> c)

124+ -> (b -> a -> c)

119125 -> Compiler b c

120−require identifier f = addDependency identifier >>> fromCompilerM require'

126+require identifier f =

127+ addDependencies (const [identifier]) >>> fromCompilerM require'

121128 where

122129 require' x = CompilerM $ do

123130 lookup' <- compilerDependencyLookup <$> ask

124− return $ f (unCompiledItem $ lookup' identifier) x

131+ return $ f x $ unCompiledItem $ lookup' identifier

125132

126−{-

127133-- | Require a number of targets. Using this function ensures automatic handling

128134-- of dependencies

129135--

130136requireAll :: (Binary a, Typeable a, Writable a)

131137 => Pattern

132− -> Compiler [a]

133−requireAll pattern = CompilerM $ do

134− provider <- compilerResourceProvider <$> ask

135− r <- unCompilerM $ mapM require $ matches pattern $ resourceList provider

136− return $ sequence r

138+ -> (b -> [a] -> c)

139+ -> Compiler b c

140+requireAll pattern f =

141+ addDependencies getDeps >>> fromCompilerM requireAll'

142+ where

143+ getDeps = matches pattern . resourceList

144+ requireAll' x = CompilerM $ do

145+ deps <- getDeps . compilerResourceProvider <$> ask

146+ lookup' <- compilerDependencyLookup <$> ask

147+ return $ f x $ map (unCompiledItem . lookup') deps

137148

149+{-

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

139151-- resource.

140152--

src/Hakyll/Core/Run.hs+1−1

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

4040

4141 -- Get all dependencies

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

43− let deps = compilerDependencies compiler

43+ let deps = getDependencies compiler provider

4444 in (id', deps)

4545

4646 -- Create a compiler map

src/Hakyll/Core/Util/Arrow.hsnew file+28

@@ -0,0 +1,28 @@

1+-- | Various arrow utility functions

2+--

3+module Hakyll.Core.Util.Arrow

4+ ( sequenceArr

5+ , unitArr

6+ , withUnitArr

7+ ) where

9+import Prelude hiding (id)

10+import Control.Arrow (Arrow, (&&&), (>>>), arr, (***))

11+import Control.Category (id)

12+

13+sequenceArr :: Arrow a

14+ => [a b c]

15+ -> a b [c]

16+sequenceArr = foldl reduce $ arr $ const []

17+ where

18+ reduce la xa = xa &&& la >>> arr (uncurry (:))

19+

20+unitArr :: Arrow a

21+ => a b ()

22+unitArr = arr (const ())

23+

24+withUnitArr :: Arrow a

25+ => a b c

26+ -> a () d

27+ -> a b (c, d)

28+withUnitArr a1 a2 = a1 &&& unitArr >>> id *** a2

src/Hakyll/Web/Pandoc.hs+15−16

@@ -7,25 +7,27 @@ module Hakyll.Web.Pandoc

77 , writePandoc

88 , writePandocWith

10− -- * Functions working on pages/targets

11− {-

10+ -- * Functions working on pages/compilers

1211 , pageReadPandoc

1312 , pageReadPandocWith

1413 , pageRenderPandoc

1514 , pageRenderPandocWith

16− -}

1715

1816 -- * Default options

1917 , defaultParserState

2018 , defaultWriterOptions

2119 ) where

2220

21+import Prelude hiding (id)

2322import Control.Applicative ((<$>))

23+import Control.Arrow ((>>>), arr)

24+import Control.Category (id)

2425

2526import Text.Pandoc (Pandoc)

2627import qualified Text.Pandoc as P

2728

2829import Hakyll.Core.Compiler

30+import Hakyll.Core.Util.Arrow

2931import Hakyll.Web.FileType

3032import Hakyll.Web.Page

3133

@@ -64,34 +66,31 @@ writePandocWith :: P.WriterOptions -- ^ Writer options for pandoc

6466 -> String -- ^ Resulting HTML

6567writePandocWith = P.writeHtmlString

6668

67−{-

6869-- | Read the resource using pandoc

6970--

70−pageReadPandoc :: Page String -> TargetM (Page Pandoc)

71+pageReadPandoc :: Compiler (Page String) (Page Pandoc)

7172pageReadPandoc = pageReadPandocWith defaultParserState

7273

7374-- | Read the resource using pandoc

7475--

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

76−pageReadPandocWith state page = do

77− fileType' <- getFileType

78− return $ readPandocWith state fileType' <$> page

76+pageReadPandocWith :: P.ParserState -> Compiler (Page String) (Page Pandoc)

77+pageReadPandocWith state =

78+ withUnitArr id getFileType >>> arr pageReadPandocWith'

79+ where

80+ pageReadPandocWith' (p, t) = readPandocWith state t <$> p

7981

8082-- | Render the resource using pandoc

8183--

82−pageRenderPandoc :: Page String -> TargetM (Page String)

84+pageRenderPandoc :: Compiler (Page String) (Page String)

8385pageRenderPandoc = pageRenderPandocWith defaultParserState defaultWriterOptions

8486

8587-- | Render the resource using pandoc

8688--

8789pageRenderPandocWith :: P.ParserState

8890 -> P.WriterOptions

89− -> Page String

90− -> TargetM (Page String)

91−pageRenderPandocWith state options page = do

92− pandoc <- pageReadPandocWith state page

93− return $ writePandocWith options <$> pandoc

94−-}

91+ -> Compiler (Page String) (Page String)

92+pageRenderPandocWith state options =

93+ pageReadPandocWith state >>> arr (fmap $ writePandocWith options)

9594

9695-- | The default reader options for pandoc parsing in hakyll

9796--