Finish tags module

3 files changed, 12 insertions, 18 deletions

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index 53daa75..5249478 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -17,6 +17,7 @@ module Hakyll.Core.Compiler
     , requireAllA
     , cached
     , unsafeCompiler
+    , mapCompiler
     ) where
 
 import Prelude hiding ((.), id)
@@ -187,3 +188,9 @@ cached name (Compiler d j) = Compiler d $ const $ CompilerM $ do
 unsafeCompiler :: (a -> IO b)   -- ^ Function to lift
                -> Compiler a b  -- ^ Resulting compiler
 unsafeCompiler f = fromJob $ CompilerM . liftIO . f
+
+-- | Map over a compiler
+--
+mapCompiler :: Compiler a b
+            -> Compiler [a] [b]
+mapCompiler (Compiler d j) = Compiler d $ mapM j
diff --git a/src/Hakyll/Core/Compiler/Internal.hs b/src/Hakyll/Core/Compiler/Internal.hs
index be78412..a524a66 100644
--- a/src/Hakyll/Core/Compiler/Internal.hs
+++ b/src/Hakyll/Core/Compiler/Internal.hs
@@ -60,11 +60,11 @@ data Compiler a b = Compiler
     }
 
 instance Functor (Compiler a) where
-    fmap f (Compiler d j) = Compiler d $ fmap f . j
+    fmap f ~(Compiler d j) = Compiler d $ fmap f . j
 
 instance Applicative (Compiler a) where
     pure = Compiler (return S.empty) . const . return
-    (Compiler d1 f) <*> (Compiler d2 j) =
+    ~(Compiler d1 f) <*> ~(Compiler d2 j) =
         Compiler (liftM2 S.union d1 d2) $ \x -> f x <*> j x
 
 instance Category Compiler where
@@ -74,12 +74,12 @@ instance Category Compiler where
 
 instance Arrow Compiler where
     arr f = Compiler (return S.empty) (return . f)
-    first (Compiler d j) = Compiler d $ \(x, y) -> do
+    first ~(Compiler d j) = Compiler d $ \(x, y) -> do
         x' <- j x
         return (x', y)
 
 instance ArrowChoice Compiler where
-    left (Compiler d j) = Compiler d $ \e -> case e of
+    left ~(Compiler d j) = Compiler d $ \e -> case e of
         Left l  -> Left  <$> j l
         Right r -> Right <$> return r
 
diff --git a/src/Hakyll/Core/Util/Arrow.hs b/src/Hakyll/Core/Util/Arrow.hs
index dfcb7da..1896e11 100644
--- a/src/Hakyll/Core/Util/Arrow.hs
+++ b/src/Hakyll/Core/Util/Arrow.hs
@@ -4,14 +4,9 @@ module Hakyll.Core.Util.Arrow
     ( constA
     , sequenceA
     , unitA
-    , mapA
     ) where
 
-import Prelude hiding (id)
-import Control.Category (id)
-import Control.Arrow ( Arrow, ArrowChoice, (&&&), arr, (>>^), (|||)
-                     , (>>>), (***)
-                     )
+import Control.Arrow (Arrow, (&&&), arr, (>>^))
 
 constA :: Arrow a
        => c
@@ -28,11 +23,3 @@ sequenceA = foldl reduce $ constA []
 unitA :: Arrow a
       => a b ()
 unitA = constA ()
-
-mapA :: ArrowChoice a
-     => a b c
-     -> a [b] [c]
-mapA f = arr listEither >>> id ||| (f *** mapA f >>> arr (uncurry (:)))
-  where
-    listEither []       = Left []
-    listEither (x : xs) = Right (x, xs)