From 0be1f8afbf02ee86b382697a02aa918fa8efa044 Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Sat, 27 Mar 2010 16:40:45 +0100
Subject: 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.
---
 src/Text/Hakyll/HakyllAction.hs | 10 ++++------
 src/Text/Hakyll/Tags.hs         | 17 ++++++++++++-----
 2 files changed, 16 insertions(+), 11 deletions(-)

(limited to 'src')

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.
-- 
cgit v1.2.3