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.
This commit is contained in:
Jasper Van der Jeugt 2010-03-27 16:40:45 +01:00
parent 509f919997
commit 0be1f8afbf
2 changed files with 16 additions and 11 deletions

View file

@ -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
first x = x
{ actionFunction = \(y, z) -> do y' <- actionFunction x y
return (y', z)
}

View file

@ -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.