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 x . y = HakyllAction
{ actionDependencies = actionDependencies x ++ actionDependencies y { actionDependencies = actionDependencies x ++ actionDependencies y
, actionUrl = actionUrl y `mplus` actionUrl x , actionUrl = actionUrl x `mplus` actionUrl y
, actionFunction = actionFunction x <=< actionFunction y , actionFunction = actionFunction x <=< actionFunction y
} }
instance Arrow HakyllAction where instance Arrow HakyllAction where
arr f = id { actionFunction = return . f } arr f = id { actionFunction = return . f }
first x = HakyllAction first x = x
{ actionDependencies = actionDependencies x { actionFunction = \(y, z) -> do y' <- actionFunction x y
, actionUrl = actionUrl x return (y', z)
, 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 qualified Data.Map as M
import Data.List (intercalate) import Data.List (intercalate)
import Data.Maybe (fromMaybe, maybeToList) import Data.Maybe (fromMaybe, maybeToList)
import Control.Monad (foldM)
import Control.Arrow (second, (>>>)) import Control.Arrow (second, (>>>))
import Control.Applicative ((<$>)) import Control.Applicative ((<$>))
import System.FilePath import System.FilePath
@ -84,12 +83,20 @@ readMap getTagsFunction identifier paths = HakyllAction
return assocMap' return assocMap'
return $ M.map (map createPage) assocMap return $ M.map (map createPage) assocMap
readTagMap' = foldM addPaths M.empty paths -- TODO: preserve order
addPaths current path = do 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 context <- runHakyllAction $ createPage path
let tags = getTagsFunction context let tags = getTagsFunction context
addPaths' = flip (M.insertWith (++)) [path] return $ map (\tag -> (tag, [path])) tags
return $ foldr addPaths' current tags
-- | Read a @TagMap@, using the @tags@ metadata field. -- | Read a @TagMap@, using the @tags@ metadata field.
readTagMap :: String -- ^ Unique identifier for the map. readTagMap :: String -- ^ Unique identifier for the map.