diff options
| -rw-r--r-- | src/Text/Hakyll/HakyllAction.hs | 10 | ||||
| -rw-r--r-- | src/Text/Hakyll/Tags.hs | 17 |
2 files changed, 16 insertions, 11 deletions
diff --git a/src/Text/Hakyll/HakyllAction.hs b/src/Text/Hakyll/HakyllAction.hs index c1600a9..e12b50b 100644 --- a/src/Text/Hakyll/HakyllAction.hs +++ b/src/Text/Hakyll/HakyllAction.hs @@ -82,16 +82,14 @@ instance Category HakyllAction where x . y = HakyllAction { actionDependencies = actionDependencies x ++ actionDependencies y - , actionUrl = actionUrl y `mplus` actionUrl x + , actionUrl = actionUrl x `mplus` actionUrl y , 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) + first x = x + { actionFunction = \(y, z) -> do y' <- actionFunction x y + return (y', z) } diff --git a/src/Text/Hakyll/Tags.hs b/src/Text/Hakyll/Tags.hs index 4efc02c..382c49c 100644 --- a/src/Text/Hakyll/Tags.hs +++ b/src/Text/Hakyll/Tags.hs @@ -39,7 +39,6 @@ module Text.Hakyll.Tags import qualified Data.Map as M import Data.List (intercalate) import Data.Maybe (fromMaybe, maybeToList) -import Control.Monad (foldM) import Control.Arrow (second, (>>>)) import Control.Applicative ((<$>)) import System.FilePath @@ -84,12 +83,20 @@ readMap getTagsFunction identifier paths = HakyllAction return assocMap' return $ M.map (map createPage) assocMap - readTagMap' = foldM addPaths M.empty paths - addPaths current path = do + -- TODO: preserve order + readTagMap' :: Hakyll (M.Map String [FilePath]) + readTagMap' = do + pairs' <- concat <$> mapM pairs paths + return $ M.fromListWith (flip (++)) pairs' + + -- | Read a page, and return an association list where every tag is + -- associated with some paths. Of course, this will always be just one + -- @FilePath@ here. + pairs :: FilePath -> Hakyll [(String, [FilePath])] + pairs path = do context <- runHakyllAction $ createPage path let tags = getTagsFunction context - addPaths' = flip (M.insertWith (++)) [path] - return $ foldr addPaths' current tags + return $ map (\tag -> (tag, [path])) tags -- | Read a @TagMap@, using the @tags@ metadata field. readTagMap :: String -- ^ Unique identifier for the map. |