0da0dd4 · hakyll · git.iko.soy

git.iko.soy/hakyll

on master help sign in

Experimental changes for a re-write

0da0dd4Jasper Van der Jeugt16 years ago

src/Text/Hakyll/File.hs+1−1

compare with master

unifiedsplit

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

26import Data.Ord (comparing)

27import Control.Monad.Reader (liftIO)

29−import Text.Hakyll.HakyllMonad

29+import Text.Hakyll.Monad

30import Text.Hakyll.Internal.FileType (isRenderableFile)

32-- | Auxiliary function to remove pathSeparators form the start. We don't deal

src/Text/Hakyll/HakyllAction.hsdeleted−98

@@ -1,98 +0,0 @@

1−-- | This is the module which exports @HakyllAction@.

2−module Text.Hakyll.HakyllAction

3− ( HakyllAction (..)

4− , createHakyllAction

5− , createSimpleHakyllAction

6− , createFileHakyllAction

7− , chain

8− , runHakyllAction

9− , runHakyllActionIfNeeded

10− ) where

11−

12−import Control.Arrow

13−import Control.Category

14−import Control.Monad ((<=<), unless)

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

16−

17−import Text.Hakyll.File (toDestination, isFileMoreRecent)

18−import Text.Hakyll.HakyllMonad

19−

20−-- | Type used for rendering computations that carry along dependencies.

21−data HakyllAction a b = HakyllAction

22− { -- | Dependencies of the @HakyllAction@.

23− actionDependencies :: [FilePath]

24− , -- | URL pointing to the result of this @HakyllAction@.

25− actionUrl :: Either (Hakyll FilePath)

26− (Hakyll FilePath -> Hakyll FilePath)

27− , -- | The actual render function.

28− actionFunction :: a -> Hakyll b

29− }

30−

31−-- | Create a @HakyllAction@ from a function.

32−createHakyllAction :: (a -> Hakyll b) -- ^ Function to execute.

33− -> HakyllAction a b

34−createHakyllAction f = id { actionFunction = f }

35−

36−-- | Create a @HakyllAction@ from a simple @Hakyll@ value.

37−createSimpleHakyllAction :: Hakyll b -- ^ Hakyll value to pass on.

38− -> HakyllAction () b

39−createSimpleHakyllAction = createHakyllAction . const

40−

41−-- | Create a @HakyllAction@ that operates on one file.

42−createFileHakyllAction :: FilePath -- ^ File to operate on.

43− -> Hakyll b -- ^ Value to pass on.

44− -> HakyllAction () b -- ^ The resulting action.

45−createFileHakyllAction path action = HakyllAction

46− { actionDependencies = [path]

47− , actionUrl = Left $ return path

48− , actionFunction = const action

49− }

50−

51−-- | Run a @HakyllAction@ now.

52−runHakyllAction :: HakyllAction () a -- ^ Render action to run.

53− -> Hakyll a -- ^ Result of the action.

54−runHakyllAction action = actionFunction action ()

55−

56−-- | Run a @HakyllAction@, but only when it is out-of-date. At this point, the

57−-- @actionUrl@ field must be set.

58−runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run.

59− -> Hakyll () -- ^ Empty result.

60−runHakyllActionIfNeeded action = do

61− url <- case actionUrl action of

62− Left u -> u

63− Right _ -> error "No url when checking dependencies."

64− destination <- toDestination url

65− valid <- isFileMoreRecent destination $ actionDependencies action

66− unless valid $ do logHakyll $ "Rendering " ++ destination

67− runHakyllAction action

68−

69−-- | Chain a number of @HakyllAction@ computations.

70−chain :: [HakyllAction a a] -- ^ Actions to chain.

71− -> HakyllAction a a -- ^ Resulting action.

72−chain [] = id

73−chain list = foldl1 (>>>) list

74−

75−instance Category HakyllAction where

76− id = HakyllAction

77− { actionDependencies = []

78− , actionUrl = Right id

79− , actionFunction = return

80− }

81−

82− x . y = HakyllAction

83− { actionDependencies = actionDependencies x ++ actionDependencies y

84− , actionUrl = case actionUrl x of

85− Left ux -> Left ux

86− Right fx -> case actionUrl y of

87− Left uy -> Left (fx uy)

88− Right fy -> Right (fx . fy)

89− , actionFunction = actionFunction x <=< actionFunction y

90− }

91−

92−instance Arrow HakyllAction where

93− arr f = id { actionFunction = return . f }

94−

95− first x = x

96− { actionFunction = \(y, z) -> do y' <- actionFunction x y

97− return (y', z)

98− }

src/Text/Hakyll/HakyllMonad.hs → src/Text/Hakyll/Monad.hsrenamed+22−6

@@ -1,5 +1,6 @@

1-- | Module describing the Hakyll monad stack.

2+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

2−module Text.Hakyll.HakyllMonad

3+module Text.Hakyll.Monad

3 ( HakyllConfiguration (..)

4 ( HakyllConfiguration (..)

4 , PreviewMode (..)

5 , PreviewMode (..)

5 , Hakyll

6 , Hakyll

@@ -11,6 +12,7 @@ module Text.Hakyll.HakyllMonad

11 ) where

12 ) where

13import Control.Monad.Trans (liftIO)

14import Control.Monad.Trans (liftIO)

15+import Control.Monad.IO.Class (MonadIO, liftIO)

14import Control.Concurrent.MVar (MVar, putMVar, newEmptyMVar, readMVar)

16import Control.Concurrent.MVar (MVar, putMVar, newEmptyMVar, readMVar)

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

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

16import Control.Monad (liftM, forM, forM_)

18import Control.Monad (liftM, forM, forM_)

@@ -24,7 +26,16 @@ import Text.Hakyll.Context (Context (..))

25-- | Our custom monad stack.

27-- | Our custom monad stack.

26--

28--

27−type Hakyll = ReaderT HakyllConfiguration IO

29+newtype Hakyll a = Hakyll (ReaderT HakyllConfiguration IO a)

30+ deriving (Monad, Functor)

31+

32+instance MonadIO Hakyll where

33+ liftIO = Hakyll . liftIO

34+

35+-- | Run a hakyll stack

36+--

37+runHakyll :: Hakyll a -> HakyllConfiguration -> IO a

38+runHakyll (Hakyll h) = runReaderT h

29-- | Preview mode.

40-- | Preview mode.

30--

41--

@@ -56,6 +67,11 @@ data HakyllConfiguration = HakyllConfiguration

56 hamletSettings :: HamletSettings

67 hamletSettings :: HamletSettings

57 }

68 }

70+-- | Get the hakyll configuration

71+--

72+getHakyllConfiguration :: Hakyll HakyllConfiguration

73+getHakyllConfiguration = Hakyll ask

74+

59-- | Simplified @ask@ function for the Hakyll monad stack.

75-- | Simplified @ask@ function for the Hakyll monad stack.

60--

76--

61-- Usage would typically be something like:

77-- Usage would typically be something like:

@@ -66,7 +82,7 @@ data HakyllConfiguration = HakyllConfiguration

66-- > ...

82-- > ...

67--

83--

68askHakyll :: (HakyllConfiguration -> a) -> Hakyll a

84askHakyll :: (HakyllConfiguration -> a) -> Hakyll a

69−askHakyll = flip liftM ask

85+askHakyll = flip liftM getHakyllConfiguration

71-- | Obtain the globally available, additional context.

87-- | Obtain the globally available, additional context.

72--

88--

@@ -78,16 +94,16 @@ getAdditionalContext configuration =

78-- | Write some log information.

94-- | Write some log information.

79--

95--

80logHakyll :: String -> Hakyll ()

96logHakyll :: String -> Hakyll ()

81−logHakyll = liftIO . hPutStrLn stderr

97+logHakyll = Hakyll . liftIO . hPutStrLn stderr

83-- | Perform a concurrent hakyll action. Returns an MVar you can wait on

99-- | Perform a concurrent hakyll action. Returns an MVar you can wait on

84--

100--

85forkHakyllWait :: Hakyll () -> Hakyll (MVar ())

101forkHakyllWait :: Hakyll () -> Hakyll (MVar ())

86forkHakyllWait action = do

102forkHakyllWait action = do

87 mvar <- liftIO newEmptyMVar

103 mvar <- liftIO newEmptyMVar

88− config <- ask

104+ config <- getHakyllConfiguration

89 liftIO $ do

105 liftIO $ do

90− runReaderT action config

106+ runHakyll action config

91 putMVar mvar ()

107 putMVar mvar ()

92 return mvar

108 return mvar

109

src/Text/Hakyll/Pandoc.hs+31

@@ -17,6 +17,30 @@ import Text.Hakyll.HakyllMonad

17import Text.Hakyll.HakyllAction

18import Text.Hakyll.Context

20+-- | Reader function for plain text

21+--

22+readText :: ParserState -> String -> Pandoc

23+readText _ = Pandoc (Meta [] [] []) . return . Plain . return . Str

24+

25+-- | Get a read function for a given extension.

26+--

27+readPandoc :: HakyllAction (FileType, String) Pandoc

28+readPandoc = createHakyllAction $ \(fileType, inp) -> do

29+ parserState <- askHakyll pandocParserState

30+ return $ readFunction fileType (readOptions parserState fileType) inp

31+ where

32+ readFunction ReStructuredText = readRST

33+ readFunction LaTeX = readLaTeX

34+ readFunction Markdown = readMarkdown

35+ readFunction LiterateHaskellMarkdown = readMarkdown

36+ readFunction Html = readHtml

37+ readFunction Text = readText

38+ readFunction t = error $ "Cannot render " ++ show t

39+

40+ readOptions options LiterateHaskellMarkdown = options

41+ { stateLiterateHaskell = True }

42+ readOptions options _ = options

43+

20-- | Get a render function for a given extension.

44-- | Get a render function for a given extension.

21--

45--

22getRenderFunction :: HakyllAction FileType (String -> String)

46getRenderFunction :: HakyllAction FileType (String -> String)

@@ -39,6 +63,13 @@ getRenderFunction = createHakyllAction $ \fileType -> case fileType of

39 { stateLiterateHaskell = True }

63 { stateLiterateHaskell = True }

40 readOptions options _ = options

64 readOptions options _ = options

66+-- | Get a render action

67+--

68+renderPandoc :: HakyllAction Pandoc String

69+renderPandoc = createHakyllAction $ \p -> do

70+ writerOptions <- askHakyll pandocWriterOptions

71+ return $ writeHtmlString writerOptions p

72+

42-- | An action that renders the list of page sections to a context using pandoc

73-- | An action that renders the list of page sections to a context using pandoc

43--

74--

44renderAction :: HakyllAction [PageSection] Context

75renderAction :: HakyllAction [PageSection] Context

src/Text/Hakyll/Resource.hsnew file+60

@@ -0,0 +1,60 @@

1+-- | A resource represents data for a website

2+--

3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

4+module Text.Hakyll.Resource

5+ ( Metadata (..)

6+ , Resource (..)

7+ , getData

8+ , getMetadata

9+ , getMetadataList

10+ ) where

11+

12+import Data.Monoid (Monoid, mempty, mappend)

13+import Control.Applicative (Applicative, (<*>), pure)

14+

15+-- | Metadata for a resource

16+--

17+newtype Metadata = Metadata {unMetadata :: [(String, String)]}

18+ deriving (Show, Eq, Ord, Monoid)

19+

20+-- | A resource represents a data source for the website. It contains a value

21+-- and a number of metadata fields

22+--

23+data Resource a = Resource

24+ { resourceMetadata :: Metadata

25+ , resourceData :: a

26+ } deriving (Show, Eq, Ord)

27+

28+instance Functor Resource where

29+ fmap f (Resource m d) = Resource m $ f d

30+

31+instance Applicative Resource where

32+ pure d = Resource mempty d

33+ (Resource m1 f) <*> (Resource m2 d) = Resource (mappend m2 m1) (f d)

34+

35+instance Monad Resource where

36+ return d = Resource mempty d

37+ (Resource m1 d) >>= f = let Resource m2 d' = f d

38+ in Resource (mappend m2 m1) d'

39+

40+instance Monoid a => Monoid (Resource a) where

41+ mempty = Resource mempty mempty

42+ mappend (Resource m1 d1) (Resource m2 d2) =

43+ Resource (mappend m1 m2) (mappend d1 d2)

44+

45+-- | Get the data from a resource

46+--

47+getData :: Resource a -> a

48+getData = resourceData

49+

50+-- | Get a metadata field from a resource

51+--

52+getMetadata :: String -> Resource a -> Maybe String

53+getMetadata k (Resource m _) = lookup k $ unMetadata m

54+

55+-- | Get a metadata field from a resource. If multiple fields with the same name

56+-- exist, they will all be returned

57+--

58+getMetadataList :: String -> Resource a -> [String]

59+getMetadataList k = map snd . filter ((== k) . fst)

60+ . unMetadata . resourceMetadata

src/Text/Hakyll/Transformer.hsnew file+97

@@ -0,0 +1,97 @@

1+-- | This is the module which exports @Transformer@.

2+module Text.Hakyll.Transformer

3+ ( Transformer (..)

4+ , transformResource

5+ , transformResourceM

6+ , transformData

7+ , transformDataM

8+ , transformMetaData

9+ , transformMetaDataM

10+ , runTransformer

11+ , runTransformerForced

12+ ) where

13+

14+import Data.Monoid (mappend, mempty)

15+import Control.Arrow

16+import Control.Category

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

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

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

20+

21+import Text.Hakyll.Resource

22+import Text.Hakyll.File (toDestination, isFileMoreRecent)

23+import Text.Hakyll.Monad

24+

25+-- | Type used for computations that transform resources, carrying along

26+-- dependencies.

27+--

28+data Transformer a b = Transformer

29+ { -- | Dependencies of the @Transformer@.

30+ transformerDependencies :: [FilePath]

31+ , -- | URL pointing to the result of this @Transformer@.

32+ transformerUrl :: FilePath -> Hakyll FilePath

33+ , -- | The actual transforming function.

34+ transformerFunction :: Resource a -> Hakyll (Resource b)

35+ }

36+

37+instance Category Transformer where

38+ id = Transformer

39+ { transformerDependencies = []

40+ , transformerUrl = return

41+ , transformerFunction = return

42+ }

43+

44+ x . y = Transformer

45+ { transformerDependencies =

46+ transformerDependencies x ++ transformerDependencies y

47+ , transformerUrl = transformerUrl y <=< transformerUrl x

48+ , transformerFunction = transformerFunction x <=< transformerFunction y

49+ }

50+

51+instance Arrow Transformer where

52+ arr = transformData

53+

54+ first t = t

55+ { transformerFunction = \(Resource m (x, y)) -> do

56+ Resource m' x' <- transformerFunction t $ Resource m x

57+ return $ Resource (mappend m' m) (x', y)

58+ }

59+

60+transformResource :: (Resource a -> Resource b) -> Transformer a b

61+transformResource = transformResourceM . (return .)

62+

63+transformResourceM :: (Resource a -> Hakyll (Resource b)) -> Transformer a b

64+transformResourceM f = id {transformerFunction = f}

65+

66+transformData :: (a -> b) -> Transformer a b

67+transformData = transformResource . fmap

68+

69+transformDataM :: (a -> Hakyll b) -> Transformer a b

70+transformDataM f = transformResourceM $ \(Resource m x) ->

71+ f x >>= return . Resource m

72+

73+transformMetaData :: (Metadata -> Metadata) -> Transformer a a

74+transformMetaData = transformMetaDataM . (return .)

75+

76+transformMetaDataM :: (Metadata -> Hakyll Metadata) -> Transformer a a

77+transformMetaDataM f = transformResourceM $ \(Resource m x) -> do

78+ m' <- f m

79+ return $ Resource m' x

80+

81+-- | Run a transformer. This might not run it when the result is up-to-date

82+--

83+runTransformer :: Transformer () ()

84+ -> Hakyll ()

85+runTransformer t = do

86+ url <- transformerUrl t $

87+ error "runTransformer: No url when checking dependencies."

88+ destination <- toDestination url

89+ valid <- isFileMoreRecent destination $ transformerDependencies t

90+ unless valid $ do logHakyll $ "Rendering " ++ destination

91+ runTransformerForced t

92+

93+-- | Always run the transformer, even when the target is up-to-date

94+--

95+runTransformerForced :: Transformer () ()

96+ -> Hakyll ()

97+runTransformerForced t = getData <$> transformerFunction t mempty