diff options
Diffstat (limited to 'src/Text/Hakyll')
| -rw-r--r-- | src/Text/Hakyll/Paginate.hs | 18 | ||||
| -rw-r--r-- | src/Text/Hakyll/Regex.hs | 2 | ||||
| -rw-r--r-- | src/Text/Hakyll/RenderAction.hs | 40 | ||||
| -rw-r--r-- | src/Text/Hakyll/Renderables.hs | 52 |
4 files changed, 77 insertions, 35 deletions
diff --git a/src/Text/Hakyll/Paginate.hs b/src/Text/Hakyll/Paginate.hs index f8b3373..e228404 100644 --- a/src/Text/Hakyll/Paginate.hs +++ b/src/Text/Hakyll/Paginate.hs @@ -5,8 +5,11 @@ module Text.Hakyll.Paginate , paginate ) where +import Control.Applicative ((<$>)) + +import Text.Hakyll.Context import Text.Hakyll.Renderables -import Text.Hakyll.Renderable (Renderable, getUrl) +import Text.Hakyll.RenderAction import Text.Hakyll.Util (link) -- | A configuration for a pagination. @@ -46,14 +49,15 @@ defaultPaginateConfiguration = PaginateConfiguration -- When @$previous@ or @$next@ are not available, they will be just a label -- without a link. The same goes for when we are on the first or last page for -- @$first@ and @$last@. -paginate :: (Renderable a) - => PaginateConfiguration - -> [a] - -> [CombinedRenderable a CustomPage] +paginate :: PaginateConfiguration + -> [RenderAction () Context] + -> [RenderAction () Context] paginate configuration renderables = paginate' Nothing renderables (1 :: Int) where -- Create a link with a given label, taken from the configuration. - linkWithLabel f r = link (f configuration) `fmap` getUrl r + linkWithLabel f r = case actionDestination r of + Just l -> link (f configuration) <$> l + Nothing -> error "No link found for pagination." -- The main function that creates combined renderables by recursing over -- the list of renderables. @@ -75,6 +79,6 @@ paginate configuration renderables = paginate' Nothing renderables (1 :: Int) , ("first", Right first) , ("last", Right last') , ("index", Left $ show index) - , ("length", Left $ show $ length $ renderables) + , ("length", Left $ show $ length renderables) ] in (x `combine` customPage) : paginate' (Just x) xs (index + 1) diff --git a/src/Text/Hakyll/Regex.hs b/src/Text/Hakyll/Regex.hs index 96db2d2..ba7ee46 100644 --- a/src/Text/Hakyll/Regex.hs +++ b/src/Text/Hakyll/Regex.hs @@ -15,7 +15,7 @@ matchRegexAll :: Regex -> String -> Maybe (String, String, String, [String]) matchRegexAll = matchM -- | Replaces every occurance of the given regexp with the replacement string. -subRegex :: Regex -- ^ Search pattern +subRegex :: Regex -- ^ Search pattern -> String -- ^ Input string -> String -- ^ Replacement text -> String -- ^ Output string diff --git a/src/Text/Hakyll/RenderAction.hs b/src/Text/Hakyll/RenderAction.hs new file mode 100644 index 0000000..a84ce46 --- /dev/null +++ b/src/Text/Hakyll/RenderAction.hs @@ -0,0 +1,40 @@ +module Text.Hakyll.RenderAction + ( RenderAction (..) + , fromRenderable + ) where + +import Prelude hiding ((.), id) +import Control.Category +import Control.Monad ((<=<), mplus) + +import Text.Hakyll.Hakyll +import Text.Hakyll.Context +import Text.Hakyll.Renderable + +data RenderAction a b = RenderAction + { actionDependencies :: [FilePath] + , actionDestination :: Maybe (Hakyll FilePath) + , actionFunction :: a -> Hakyll b + } + +instance Category RenderAction where + id = RenderAction + { actionDependencies = [] + , actionDestination = Nothing + , actionFunction = return + } + + x . y = RenderAction + { actionDependencies = actionDependencies x ++ actionDependencies y + , actionDestination = actionDestination y `mplus` actionDestination x + , actionFunction = actionFunction x <=< actionFunction y + } + +fromRenderable :: (Renderable a) + => a + -> RenderAction () Context +fromRenderable renderable = RenderAction + { actionDependencies = getDependencies renderable + , actionDestination = Just $ getUrl renderable + , actionFunction = const $ toContext renderable + } diff --git a/src/Text/Hakyll/Renderables.hs b/src/Text/Hakyll/Renderables.hs index b16b2bd..136bd85 100644 --- a/src/Text/Hakyll/Renderables.hs +++ b/src/Text/Hakyll/Renderables.hs @@ -1,6 +1,5 @@ module Text.Hakyll.Renderables - ( CustomPage - , createCustomPage + ( createCustomPage , createListing , createListingWith , PagePath @@ -12,7 +11,8 @@ module Text.Hakyll.Renderables import qualified Data.Map as M import Control.Arrow (second) -import Control.Monad (liftM) +import Control.Monad (liftM, liftM2, mplus) +import Control.Applicative ((<$>)) import Data.Binary @@ -22,13 +22,7 @@ import Text.Hakyll.Renderable import Text.Hakyll.File import Text.Hakyll.Context import Text.Hakyll.Render - --- | A custom page. -data CustomPage = CustomPage - { customPageUrl :: String, - customPageDependencies :: [FilePath], - customPageContext :: [(String, Either String (Hakyll String))] - } +import Text.Hakyll.RenderAction -- | Create a custom page. -- @@ -37,11 +31,18 @@ data CustomPage = CustomPage -- A @Hakyll String@ is preferred for more complex data, since it allows -- dependency checking. A @String@ is obviously more simple to use in some -- cases. -createCustomPage :: String -- ^ Destination of the page, relative to _site. - -> [FilePath] -- ^ Dependencies of the page. - -> [(String, Either String (Hakyll String))] -- ^ Mapping. - -> CustomPage -createCustomPage = CustomPage +createCustomPage :: String + -> [FilePath] + -> [(String, Either String (Hakyll String))] + -> RenderAction () Context +createCustomPage url dependencies association = RenderAction + { actionDependencies = dependencies + , actionDestination = Just $ return url + , actionFunction = actionFunction' + } + where + mtuple (a, b) = b >>= \b' -> return (a, b') + actionFunction' () = M.fromList <$> mapM (mtuple . second (either return id)) association -- | A @createCustomPage@ function specialized in creating listings. -- @@ -61,7 +62,7 @@ createListing :: (Renderable a) -> FilePath -- ^ Template to render all items with. -> [a] -- ^ Renderables in the list. -> [(String, String)] -- ^ Additional context. - -> CustomPage + -> RenderAction () Context createListing = createListingWith id -- | A @createCustomPage@ function specialized in creating listings. @@ -74,7 +75,7 @@ createListingWith :: (Renderable a) -> FilePath -- ^ Template to render all items with. -> [a] -- ^ Renderables in the list. -> [(String, String)] -- ^ Additional context. - -> CustomPage + -> RenderAction () Context createListingWith manipulation url template renderables additional = createCustomPage url dependencies context where @@ -83,14 +84,6 @@ createListingWith manipulation url template renderables additional = concatenation = renderAndConcatWith manipulation [template] renderables additional' = map (second Left) additional -instance Renderable CustomPage where - getDependencies = customPageDependencies - getUrl = return . customPageUrl - toContext page = do - values <- mapM (either return id . snd) (customPageContext page) - let pairs = zip (map fst $ customPageContext page) values - return $ M.fromList $ ("url", customPageUrl page) : pairs - -- | PagePath is a class that wraps a FilePath. This is used to render Pages -- without reading them first through use of caching. newtype PagePath = PagePath FilePath @@ -122,8 +115,13 @@ data CombinedRenderable a b = CombinedRenderable a b -- -- Since renderables are always more or less key-value maps, you can see -- this as a @union@ between two maps. -combine :: (Renderable a, Renderable b) => a -> b -> CombinedRenderable a b -combine = CombinedRenderable +combine :: RenderAction () Context -> RenderAction () Context + -> RenderAction () Context +combine x y = RenderAction + { actionDependencies = actionDependencies x ++ actionDependencies y + , actionDestination = actionDestination x `mplus` actionDestination y + , actionFunction = \_ -> liftM2 (M.union) (actionFunction x ()) (actionFunction y ()) + } -- | Combine two renderables and set a custom URL. This behaves like @combine@, -- except that for the @url@ field, the given URL is always chosen. |