From fa28eac8a395da7e524dc50d910d10dc1fa76a12 Mon Sep 17 00:00:00 2001 From: Jasper Van der Jeugt Date: Wed, 10 Mar 2010 13:35:53 +0100 Subject: Renamed RenderAction to HakyllAction. --- hakyll.cabal | 2 +- src/Text/Hakyll/Feed.hs | 4 +- src/Text/Hakyll/HakyllAction.hs | 109 +++++++++++++++++++++++++++++++++++++ src/Text/Hakyll/Internal/Render.hs | 6 +- src/Text/Hakyll/Paginate.hs | 4 +- src/Text/Hakyll/Render.hs | 28 +++++----- src/Text/Hakyll/RenderAction.hs | 109 ------------------------------------- src/Text/Hakyll/Renderables.hs | 20 +++---- src/Text/Hakyll/Tags.hs | 22 ++++---- 9 files changed, 152 insertions(+), 152 deletions(-) create mode 100644 src/Text/Hakyll/HakyllAction.hs delete mode 100644 src/Text/Hakyll/RenderAction.hs diff --git a/hakyll.cabal b/hakyll.cabal index 93aa07a..67136f6 100644 --- a/hakyll.cabal +++ b/hakyll.cabal @@ -48,7 +48,7 @@ library Text.Hakyll.Hakyll Text.Hakyll.Regex Text.Hakyll.Render - Text.Hakyll.RenderAction + Text.Hakyll.HakyllAction Text.Hakyll.Renderables Text.Hakyll.Paginate Text.Hakyll.Util diff --git a/src/Text/Hakyll/Feed.hs b/src/Text/Hakyll/Feed.hs index 0d153a3..64443a5 100644 --- a/src/Text/Hakyll/Feed.hs +++ b/src/Text/Hakyll/Feed.hs @@ -34,7 +34,7 @@ import Text.Hakyll.Context (ContextManipulation, renderDate) import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Render (render, renderChain) import Text.Hakyll.Renderables (createListingWith) -import Text.Hakyll.RenderAction +import Text.Hakyll.HakyllAction import Paths_hakyll @@ -71,7 +71,7 @@ createFeedWith manipulation configuration renderables template itemTemplate = ] ++ updated -- Take the first timestamp, which should be the most recent. - updated = let action = createRenderAction $ + updated = let action = createHakyllAction $ return . fromMaybe "foo" . M.lookup "timestamp" manip = createManipulationAction manipulation toTuple r = ("timestamp", Right $ r >>> manip >>> action) diff --git a/src/Text/Hakyll/HakyllAction.hs b/src/Text/Hakyll/HakyllAction.hs new file mode 100644 index 0000000..ef8284d --- /dev/null +++ b/src/Text/Hakyll/HakyllAction.hs @@ -0,0 +1,109 @@ +-- | This is the module which exports @HakyllAction@. +module Text.Hakyll.HakyllAction + ( HakyllAction (..) + , createHakyllAction + , createSimpleHakyllAction + , createFileHakyllAction + , createManipulationAction + , chain + , runHakyllAction + , runHakyllActionIfNeeded + , Renderable + ) where + +import Control.Arrow +import Control.Category +import Control.Monad ((<=<), mplus, unless) +import Control.Monad.Reader (liftIO) +import Prelude hiding ((.), id) +import System.IO (hPutStrLn, stderr) + +import Text.Hakyll.Context +import Text.Hakyll.File (toDestination, isFileMoreRecent) +import Text.Hakyll.Hakyll + +-- | Type used for rendering computations that carry along dependencies. +data HakyllAction a b = HakyllAction + { -- | Dependencies of the @HakyllAction@. + actionDependencies :: [FilePath] + , -- | URL pointing to the result of this @HakyllAction@. + actionUrl :: Maybe (Hakyll FilePath) + , -- | The actual render function. + actionFunction :: a -> Hakyll b + } + +-- | Create a @HakyllAction@ from a function. +createHakyllAction :: (a -> Hakyll b) -- ^ Function to execute. + -> HakyllAction a b +createHakyllAction f = id { actionFunction = f } + +-- | Create a @HakyllAction@ from a simple @Hakyll@ value. +createSimpleHakyllAction :: Hakyll b -- ^ Hakyll value to pass on. + -> HakyllAction () b +createSimpleHakyllAction = createHakyllAction . const + +-- | Create a @HakyllAction@ that operates on one file. +createFileHakyllAction :: FilePath -- ^ File to operate on. + -> Hakyll b -- ^ Value to pass on. + -> HakyllAction () b -- ^ The resulting action. +createFileHakyllAction path action = HakyllAction + { actionDependencies = [path] + , actionUrl = Just $ return path + , actionFunction = const action + } + +-- | Create a @HakyllAction@ from a @ContextManipulation@. +createManipulationAction :: ContextManipulation -- ^ Manipulation to apply. + -> HakyllAction Context Context +createManipulationAction = createHakyllAction . (return .) + +-- | Run a @HakyllAction@ now. +runHakyllAction :: HakyllAction () a -- ^ Render action to run. + -> Hakyll a -- ^ Result of the action. +runHakyllAction action = actionFunction action () + +-- | Run a @HakyllAction@, but only when it is out-of-date. At this point, the +-- @actionUrl@ field must be set. +runHakyllActionIfNeeded :: HakyllAction () () -- ^ Action to run. + -> Hakyll () -- ^ Empty result. +runHakyllActionIfNeeded action = do + url <- case actionUrl action of + (Just u) -> u + Nothing -> error "No url when checking dependencies." + destination <- toDestination url + valid <- isFileMoreRecent destination $ actionDependencies action + unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination + runHakyllAction action + +-- | Chain a number of @HakyllAction@ computations. +chain :: [HakyllAction a a] -- ^ Actions to chain. + -> HakyllAction a a -- ^ Resulting action. +chain [] = id +chain list@(_:_) = foldl1 (>>>) list + +-- | This is a specialized version of @HakyllAction@, a @Context@ that can be +-- rendered. +type Renderable = HakyllAction () Context + +instance Category HakyllAction where + id = HakyllAction + { actionDependencies = [] + , actionUrl = Nothing + , actionFunction = return + } + + x . y = HakyllAction + { actionDependencies = actionDependencies x ++ actionDependencies y + , actionUrl = actionUrl y `mplus` actionUrl x + , actionFunction = actionFunction x <=< actionFunction y + } + +instance Arrow HakyllAction where + arr f = id { actionFunction = return . f } + + first x = HakyllAction + { actionDependencies = actionDependencies x + , actionUrl = actionUrl x + , actionFunction = \(y, z) -> do y' <- actionFunction x y + return (y', z) + } diff --git a/src/Text/Hakyll/Internal/Render.hs b/src/Text/Hakyll/Internal/Render.hs index 28fc31b..178e6ff 100644 --- a/src/Text/Hakyll/Internal/Render.hs +++ b/src/Text/Hakyll/Internal/Render.hs @@ -14,7 +14,7 @@ import Data.Maybe (fromMaybe) import Text.Hakyll.Context (Context, ContextManipulation) import Text.Hakyll.File import Text.Hakyll.Hakyll -import Text.Hakyll.RenderAction +import Text.Hakyll.HakyllAction import Text.Hakyll.Internal.Template -- | A pure render function. @@ -31,8 +31,8 @@ pureRenderWith manipulation template context = -- | Write a page to the site destination. Final action after render -- chains and such. -writePage :: RenderAction Context () -writePage = createRenderAction $ \initialContext -> do +writePage :: HakyllAction Context () +writePage = createHakyllAction $ \initialContext -> do additionalContext' <- askHakyll getAdditionalContext let url = fromMaybe (error "No url defined at write time.") (M.lookup "url" initialContext) diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs index d4b1089..1de62b3 100644 --- a/src/Text/Hakyll/Paginate.hs +++ b/src/Text/Hakyll/Paginate.hs @@ -8,7 +8,7 @@ module Text.Hakyll.Paginate import Control.Applicative ((<$>)) import Text.Hakyll.Renderables -import Text.Hakyll.RenderAction +import Text.Hakyll.HakyllAction import Text.Hakyll.Util (link) -- | A configuration for a pagination. @@ -60,7 +60,7 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int) where -- Create a link with a given label, taken from the configuration. linkWithLabel f r = Right $ case actionUrl r of - Just l -> createSimpleRenderAction $ link (f configuration) <$> l + Just l -> createSimpleHakyllAction $ link (f configuration) <$> l Nothing -> error "No link found for pagination." -- The main function that creates combined renderables by recursing over diff --git a/src/Text/Hakyll/Render.hs b/src/Text/Hakyll/Render.hs index 9a95374..d945f94 100644 --- a/src/Text/Hakyll/Render.hs +++ b/src/Text/Hakyll/Render.hs @@ -20,22 +20,22 @@ import qualified Data.Map as M import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Context (ContextManipulation, Context) import Text.Hakyll.File -import Text.Hakyll.RenderAction +import Text.Hakyll.HakyllAction import Text.Hakyll.Internal.CompressCss import Text.Hakyll.Internal.Render import Text.Hakyll.Internal.Template (readTemplate) -- | Render to a Page. render :: FilePath -- ^ Template to use for rendering. - -> RenderAction Context Context -- ^ The render computation. + -> HakyllAction Context Context -- ^ The render computation. render = renderWith id -- | Render to a Page. This function allows you to manipulate the context -- first. renderWith :: ContextManipulation -- ^ Manipulation to apply first. -> FilePath -- ^ Template to use for rendering. - -> RenderAction Context Context -- ^ The render computation. -renderWith manipulation templatePath = RenderAction + -> HakyllAction Context Context -- ^ The render computation. +renderWith manipulation templatePath = HakyllAction { actionDependencies = [templatePath] , actionUrl = Nothing , actionFunction = actionFunction' @@ -57,7 +57,7 @@ renderWith manipulation templatePath = RenderAction -- renderAndConcat :: [FilePath] -- ^ Templates to apply on every renderable. -> [Renderable] -- ^ Renderables to render. - -> RenderAction () String + -> HakyllAction () String renderAndConcat = renderAndConcatWith id -- | Render each renderable with the given templates, then concatenate the @@ -66,8 +66,8 @@ renderAndConcat = renderAndConcatWith id renderAndConcatWith :: ContextManipulation -> [FilePath] -> [Renderable] - -> RenderAction () String -renderAndConcatWith manipulation templatePaths renderables = RenderAction + -> HakyllAction () String +renderAndConcatWith manipulation templatePaths renderables = HakyllAction { actionDependencies = renders >>= actionDependencies , actionUrl = Nothing , actionFunction = actionFunction' @@ -78,7 +78,7 @@ renderAndConcatWith manipulation templatePaths renderables = RenderAction manipulationAction = createManipulationAction manipulation actionFunction' _ = do - contexts <- mapM runRenderAction renders + contexts <- mapM runHakyllAction renders return $ concatMap (fromMaybe "" . M.lookup "body") contexts -- | Chain a render action for a page with a number of templates. This will @@ -101,9 +101,9 @@ renderChainWith :: ContextManipulation -> Renderable -> Hakyll () renderChainWith manipulation templatePaths initial = - runRenderActionIfNeeded renderChainWith' + runHakyllActionIfNeeded renderChainWith' where - renderChainWith' :: RenderAction () () + renderChainWith' :: HakyllAction () () renderChainWith' = initial >>> manipulationAction >>> chain' >>> writePage chain' = chain (map render templatePaths) @@ -113,18 +113,18 @@ renderChainWith manipulation templatePaths initial = -- | Mark a certain file as static, so it will just be copied when the site is -- generated. static :: FilePath -> Hakyll () -static source = runRenderActionIfNeeded static' +static source = runHakyllActionIfNeeded static' where - static' = createFileRenderAction source $ do + static' = createFileHakyllAction source $ do destination <- toDestination source makeDirectories destination liftIO $ copyFile source destination -- | Render a css file, compressing it. css :: FilePath -> Hakyll () -css source = runRenderActionIfNeeded css' +css source = runHakyllActionIfNeeded css' where - css' = createFileRenderAction source $ do + css' = createFileHakyllAction source $ do contents <- liftIO $ readFile source destination <- toDestination source makeDirectories destination diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs deleted file mode 100644 index 7fa03a5..0000000 --- a/src/Text/Hakyll/RenderAction.hs +++ /dev/null @@ -1,109 +0,0 @@ --- | This is the module which exports @RenderAction@. -module Text.Hakyll.RenderAction - ( RenderAction (..) - , createRenderAction - , createSimpleRenderAction - , createFileRenderAction - , createManipulationAction - , chain - , runRenderAction - , runRenderActionIfNeeded - , Renderable - ) where - -import Control.Arrow -import Control.Category -import Control.Monad ((<=<), mplus, unless) -import Control.Monad.Reader (liftIO) -import Prelude hiding ((.), id) -import System.IO (hPutStrLn, stderr) - -import Text.Hakyll.Context -import Text.Hakyll.File (toDestination, isFileMoreRecent) -import Text.Hakyll.Hakyll - --- | Type used for rendering computations that carry along dependencies. -data RenderAction a b = RenderAction - { -- | Dependencies of the @RenderAction@. - actionDependencies :: [FilePath] - , -- | URL pointing to the result of this @RenderAction@. - actionUrl :: Maybe (Hakyll FilePath) - , -- | The actual render function. - actionFunction :: a -> Hakyll b - } - --- | Create a @RenderAction@ from a function. -createRenderAction :: (a -> Hakyll b) -- ^ Function to execute. - -> RenderAction a b -createRenderAction f = id { actionFunction = f } - --- | Create a @RenderAction@ from a simple @Hakyll@ value. -createSimpleRenderAction :: Hakyll b -- ^ Hakyll value to pass on. - -> RenderAction () b -createSimpleRenderAction = createRenderAction . const - --- | Create a @RenderAction@ that operates on one file. -createFileRenderAction :: FilePath -- ^ File to operate on. - -> Hakyll b -- ^ Value to pass on. - -> RenderAction () b -- ^ The resulting action. -createFileRenderAction path action = RenderAction - { actionDependencies = [path] - , actionUrl = Just $ return path - , actionFunction = const action - } - --- | Create a @RenderAction@ from a @ContextManipulation@. -createManipulationAction :: ContextManipulation -- ^ Manipulation to apply. - -> RenderAction Context Context -createManipulationAction = createRenderAction . (return .) - --- | Run a @RenderAction@ now. -runRenderAction :: RenderAction () a -- ^ Render action to run. - -> Hakyll a -- ^ Result of the action. -runRenderAction action = actionFunction action () - --- | Run a @RenderAction@, but only when it is out-of-date. At this point, the --- @actionUrl@ field must be set. -runRenderActionIfNeeded :: RenderAction () () -- ^ Action to run. - -> Hakyll () -- ^ Empty result. -runRenderActionIfNeeded action = do - url <- case actionUrl action of - (Just u) -> u - Nothing -> error "No url when checking dependencies." - destination <- toDestination url - valid <- isFileMoreRecent destination $ actionDependencies action - unless valid $ do liftIO $ hPutStrLn stderr $ "Rendering " ++ destination - runRenderAction action - --- | Chain a number of @RenderAction@ computations. -chain :: [RenderAction a a] -- ^ Actions to chain. - -> RenderAction a a -- ^ Resulting action. -chain [] = id -chain list@(_:_) = foldl1 (>>>) list - --- | This is a specialized version of @RenderAction@, a @Context@ that can be --- rendered. -type Renderable = RenderAction () Context - -instance Category RenderAction where - id = RenderAction - { actionDependencies = [] - , actionUrl = Nothing - , actionFunction = return - } - - x . y = RenderAction - { actionDependencies = actionDependencies x ++ actionDependencies y - , actionUrl = actionUrl y `mplus` actionUrl x - , actionFunction = actionFunction x <=< actionFunction y - } - -instance Arrow RenderAction where - arr f = id { actionFunction = return . f } - - first x = RenderAction - { actionDependencies = actionDependencies x - , actionUrl = actionUrl x - , actionFunction = \(y, z) -> do y' <- actionFunction x y - return (y', z) - } diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index 4f320c6..7fc658d 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -14,7 +14,7 @@ import Control.Applicative ((<$>)) import Text.Hakyll.File import Text.Hakyll.Context -import Text.Hakyll.RenderAction +import Text.Hakyll.HakyllAction import Text.Hakyll.Render import Text.Hakyll.Internal.Page @@ -26,16 +26,16 @@ import Text.Hakyll.Internal.Page -- dependency checking. A @String@ is obviously more simple to use in some -- cases. createCustomPage :: String - -> [(String, Either String (RenderAction () String))] + -> [(String, Either String (HakyllAction () String))] -> Renderable -createCustomPage url association = RenderAction +createCustomPage url association = HakyllAction { actionDependencies = dataDependencies , actionUrl = Just $ return url , actionFunction = \_ -> M.fromList <$> assoc' } where mtuple (a, b) = b >>= \b' -> return (a, b') - toHakyllString = second (either return runRenderAction) + toHakyllString = second (either return runHakyllAction) assoc' = mapM (mtuple . toHakyllString) $ ("url", Left url) : association dataDependencies = map snd association >>= getDependencies getDependencies (Left _) = [] @@ -57,7 +57,7 @@ createCustomPage url association = RenderAction createListing :: String -- ^ Destination of the page. -> [FilePath] -- ^ Templates to render all items with. -> [Renderable] -- ^ Renderables in the list. - -> [(String, Either String (RenderAction () String))] + -> [(String, Either String (HakyllAction () String))] -> Renderable createListing = createListingWith id @@ -69,7 +69,7 @@ createListingWith :: ContextManipulation -- ^ Manipulation for the renderables. -> String -- ^ Destination of the page. -> [FilePath] -- ^ Templates to render all items with. -> [Renderable] -- ^ Renderables in the list. - -> [(String, Either String (RenderAction () String))] + -> [(String, Either String (HakyllAction () String))] -> Renderable createListingWith manipulation url templates renderables additional = createCustomPage url context @@ -79,7 +79,7 @@ createListingWith manipulation url templates renderables additional = -- | Create a PagePath from a FilePath. createPagePath :: FilePath -> Renderable -createPagePath path = RenderAction +createPagePath path = HakyllAction { actionDependencies = [path] , actionUrl = Just $ toUrl path , actionFunction = const (readPage path) @@ -93,11 +93,11 @@ createPagePath path = RenderAction -- this as a @union@ between two maps. combine :: Renderable -> Renderable -> Renderable -combine x y = RenderAction +combine x y = HakyllAction { actionDependencies = actionDependencies x ++ actionDependencies y , actionUrl = actionUrl x `mplus` actionUrl y , actionFunction = \_ -> - liftM2 M.union (runRenderAction x) (runRenderAction y) + liftM2 M.union (runHakyllAction x) (runHakyllAction y) } -- | Combine two renderables and set a custom URL. This behaves like @combine@, @@ -109,7 +109,7 @@ combineWithUrl :: FilePath combineWithUrl url x y = combine' { actionUrl = Just $ return url , actionFunction = \_ -> - M.insert "url" url <$> runRenderAction combine' + M.insert "url" url <$> runHakyllAction combine' } where combine' = combine x y diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 6a04b04..c469328 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -48,7 +48,7 @@ import Text.Hakyll.Context import Text.Hakyll.Hakyll (Hakyll) import Text.Hakyll.Regex import Text.Hakyll.Renderables -import Text.Hakyll.RenderAction +import Text.Hakyll.HakyllAction import Text.Hakyll.Util import Text.Hakyll.Internal.Cache import Text.Hakyll.Internal.Template @@ -65,8 +65,8 @@ type TagMap = M.Map String [Renderable] readMap :: (Context -> [String]) -- ^ Function to get tags from a context. -> String -- ^ Unique identifier for the tagmap. -> [FilePath] - -> RenderAction () TagMap -readMap getTagsFunction identifier paths = RenderAction + -> HakyllAction () TagMap +readMap getTagsFunction identifier paths = HakyllAction { actionDependencies = paths , actionUrl = Nothing , actionFunction = actionFunction' @@ -85,7 +85,7 @@ readMap getTagsFunction identifier paths = RenderAction readTagMap' = foldM addPaths M.empty paths addPaths current path = do - context <- runRenderAction $ createPagePath path + context <- runHakyllAction $ createPagePath path let tags = getTagsFunction context addPaths' = flip (M.insertWith (++)) [path] return $ foldr addPaths' current tags @@ -93,7 +93,7 @@ readMap getTagsFunction identifier paths = RenderAction -- | Read a @TagMap@, using the @tags@ metadata field. readTagMap :: String -- ^ Unique identifier for the map. -> [FilePath] -- ^ Paths to get tags from. - -> RenderAction () TagMap + -> HakyllAction () TagMap readTagMap = readMap getTagsFunction where getTagsFunction = map trim . splitRegex "," @@ -102,22 +102,22 @@ readTagMap = readMap getTagsFunction -- | Read a @TagMap@, using the subdirectories the pages are placed in. readCategoryMap :: String -- ^ Unique identifier for the map. -> [FilePath] -- ^ Paths to get tags from. - -> RenderAction () TagMap + -> HakyllAction () TagMap readCategoryMap = readMap $ maybeToList . M.lookup "category" -withTagMap :: RenderAction () TagMap +withTagMap :: HakyllAction () TagMap -> (String -> [Renderable] -> Hakyll ()) -> Hakyll () -withTagMap tagMap function = runRenderAction (tagMap >>> action) +withTagMap tagMap function = runHakyllAction (tagMap >>> action) where - action = createRenderAction (mapM_ (uncurry function) . M.toList) + action = createHakyllAction (mapM_ (uncurry function) . M.toList) -- | Render a tag cloud. renderTagCloud :: (String -> String) -- ^ Function to produce an url for a tag. -> Float -- ^ Smallest font size, in percent. -> Float -- ^ Biggest font size, in percent. - -> RenderAction TagMap String -renderTagCloud urlFunction minSize maxSize = createRenderAction renderTagCloud' + -> HakyllAction TagMap String +renderTagCloud urlFunction minSize maxSize = createHakyllAction renderTagCloud' where renderTagCloud' tagMap = return $ intercalate " " $ map (renderTag tagMap) (tagCount tagMap) -- cgit v1.2.3