From 687c17c6bb1bc312a5660492164a9f00d710212a Mon Sep 17 00:00:00 2001
From: Jasper Van der Jeugt <jaspervdj@gmail.com>
Date: Thu, 30 Dec 2010 10:11:37 +0100
Subject: Cleanup arrow code

---
 src/Hakyll/Core/Compiler.hs   |  4 ++--
 src/Hakyll/Core/Util/Arrow.hs | 37 +++++++++++++++++--------------------
 src/Hakyll/Web/FileType.hs    |  6 +++---
 src/Hakyll/Web/Pandoc.hs      |  7 +++----
 4 files changed, 25 insertions(+), 29 deletions(-)

(limited to 'src/Hakyll')

diff --git a/src/Hakyll/Core/Compiler.hs b/src/Hakyll/Core/Compiler.hs
index a2875ba..5a1741c 100644
--- a/src/Hakyll/Core/Compiler.hs
+++ b/src/Hakyll/Core/Compiler.hs
@@ -105,11 +105,11 @@ fromCompilerM :: (a -> CompilerM b)
               -> Compiler a b
 fromCompilerM = Compiler (return S.empty)
 
-getIdentifier :: Compiler () Identifier
+getIdentifier :: Compiler a Identifier
 getIdentifier = fromCompilerM $ const $ CompilerM $
     compilerIdentifier <$> ask
 
-getResourceString :: Compiler () String
+getResourceString :: Compiler a String
 getResourceString = getIdentifier >>> getResourceString'
   where
     getResourceString' = fromCompilerM $ \id' -> CompilerM $ do
diff --git a/src/Hakyll/Core/Util/Arrow.hs b/src/Hakyll/Core/Util/Arrow.hs
index d25bc28..1896e11 100644
--- a/src/Hakyll/Core/Util/Arrow.hs
+++ b/src/Hakyll/Core/Util/Arrow.hs
@@ -1,28 +1,25 @@
 -- | Various arrow utility functions
 --
 module Hakyll.Core.Util.Arrow
-    ( sequenceArr
-    , unitArr
-    , withUnitArr
+    ( constA
+    , sequenceA
+    , unitA
     ) where
 
-import Prelude hiding (id)
-import Control.Arrow (Arrow, (&&&), (>>>), arr, (***))
-import Control.Category (id)
+import Control.Arrow (Arrow, (&&&), arr, (>>^))
 
-sequenceArr :: Arrow a
-            => [a b c]
-            -> a b [c]
-sequenceArr = foldl reduce $ arr $ const []
-  where
-    reduce la xa = xa &&& la >>> arr (uncurry (:))
+constA :: Arrow a
+       => c
+       -> a b c
+constA = arr . const
 
-unitArr :: Arrow a
-        => a b ()
-unitArr = arr (const ())
+sequenceA :: Arrow a
+          => [a b c]
+          -> a b [c]
+sequenceA = foldl reduce $ constA []
+  where
+    reduce la xa = xa &&& la >>^ arr (uncurry (:))
 
-withUnitArr :: Arrow a
-            => a b  c
-            -> a () d
-            -> a b  (c, d)
-withUnitArr a1 a2 = a1 &&& unitArr >>> id *** a2
+unitA :: Arrow a
+      => a b ()
+unitA = constA ()
diff --git a/src/Hakyll/Web/FileType.hs b/src/Hakyll/Web/FileType.hs
index d5a9c56..cd1188a 100644
--- a/src/Hakyll/Web/FileType.hs
+++ b/src/Hakyll/Web/FileType.hs
@@ -7,7 +7,7 @@ module Hakyll.Web.FileType
     ) where
 
 import System.FilePath (takeExtension)
-import Control.Arrow ((>>>), arr)
+import Control.Arrow ((>>^))
 
 import Hakyll.Core.Identifier
 import Hakyll.Core.Compiler
@@ -51,5 +51,5 @@ fileType = fileType' . takeExtension
 
 -- | Get the file type for the current file
 --
-getFileType :: Compiler () FileType
-getFileType = getIdentifier >>> arr (fileType . toFilePath)
+getFileType :: Compiler a FileType
+getFileType = getIdentifier >>^ fileType . toFilePath
diff --git a/src/Hakyll/Web/Pandoc.hs b/src/Hakyll/Web/Pandoc.hs
index c03c6ca..7fecdc4 100644
--- a/src/Hakyll/Web/Pandoc.hs
+++ b/src/Hakyll/Web/Pandoc.hs
@@ -20,14 +20,13 @@ module Hakyll.Web.Pandoc
 
 import Prelude hiding (id)
 import Control.Applicative ((<$>))
-import Control.Arrow ((>>>), arr)
+import Control.Arrow ((>>^), (&&&))
 import Control.Category (id)
 
 import Text.Pandoc (Pandoc)
 import qualified Text.Pandoc as P
 
 import Hakyll.Core.Compiler
-import Hakyll.Core.Util.Arrow
 import Hakyll.Web.FileType
 import Hakyll.Web.Page
 
@@ -75,7 +74,7 @@ pageReadPandoc = pageReadPandocWith defaultParserState
 --
 pageReadPandocWith :: P.ParserState -> Compiler (Page String) (Page Pandoc)
 pageReadPandocWith state =
-    withUnitArr id getFileType >>> arr pageReadPandocWith'
+    id &&& getFileType >>^ pageReadPandocWith'
   where
     pageReadPandocWith' (p, t) = readPandocWith state t <$> p
 
@@ -90,7 +89,7 @@ pageRenderPandocWith :: P.ParserState
                      -> P.WriterOptions
                      -> Compiler (Page String) (Page String)
 pageRenderPandocWith state options =
-    pageReadPandocWith state >>> arr (fmap $ writePandocWith options)
+    pageReadPandocWith state >>^ (fmap $ writePandocWith options)
 
 -- | The default reader options for pandoc parsing in hakyll
 --
-- 
cgit v1.2.3