summaryrefslogtreecommitdiff
path: root/src
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2010-03-27 16:40:45 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2010-03-27 16:40:45 +0100
commit0be1f8afbf02ee86b382697a02aa918fa8efa044 (patch)
tree9f5dc5b7b14144785bb97366595ab63a4f7c6f1d /src
parent509f9199979a4f745aec3a2063abe306fde93cf5 (diff)
downloadhakyll-0be1f8afbf02ee86b382697a02aa918fa8efa044.tar.gz
Fixed error causing post lists to be reversed.
This error was caused when rendering post lists produced by readTagMap. I also gave some shorter implementations for functions in Text.Hakyll.HakyllAction.
Diffstat (limited to 'src')
-rw-r--r--src/Text/Hakyll/HakyllAction.hs10
-rw-r--r--src/Text/Hakyll/Tags.hs17
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.