summaryrefslogtreecommitdiff
path: root/src/Hakyll
diff options
context:
space:
mode:
authorJasper Van der Jeugt <jaspervdj@gmail.com>2010-12-30 10:11:37 +0100
committerJasper Van der Jeugt <jaspervdj@gmail.com>2010-12-30 10:11:37 +0100
commit687c17c6bb1bc312a5660492164a9f00d710212a (patch)
tree0cbb1875b110eb5c9c024cd70e1e8ce6beae2a87 /src/Hakyll
parent1c1133dfd6adae7c9c667d47eabaabb89cf8bdf9 (diff)
downloadhakyll-687c17c6bb1bc312a5660492164a9f00d710212a.tar.gz
Cleanup arrow code
Diffstat (limited to 'src/Hakyll')
-rw-r--r--src/Hakyll/Core/Compiler.hs4
-rw-r--r--src/Hakyll/Core/Util/Arrow.hs37
-rw-r--r--src/Hakyll/Web/FileType.hs6
-rw-r--r--src/Hakyll/Web/Pandoc.hs7
4 files changed, 25 insertions, 29 deletions
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
--