on master help sign in
Cleanup arrow code
commit687c17c6bb1bc312a5660492164a9f00d710212a authorJasper Van der Jeugt <jaspervdj@gmail.com> dateThu 30 Dec 2010, 10:11 (16 years ago) parent1c1133d
4 files changed+25−29
src/Hakyll/Core/Compiler.hs+2−2 src/Hakyll/Core/Util/Arrow.hs+17−20 src/Hakyll/Web/FileType.hs+3−3 src/Hakyll/Web/Pandoc.hs+3−4
src/Hakyll/Core/Compiler.hs+2−2
@@ -105,11 +105,11 @@ fromCompilerM :: (a -> CompilerM b)
105105 -> Compiler a b
106106fromCompilerM = Compiler (return S.empty)
107107
108−getIdentifier :: Compiler () Identifier
108+getIdentifier :: Compiler a Identifier
109109getIdentifier = fromCompilerM $ const $ CompilerM $
110110 compilerIdentifier <$> ask
111111
112−getResourceString :: Compiler () String
112+getResourceString :: Compiler a String
113113getResourceString = getIdentifier >>> getResourceString'
114114 where
115115 getResourceString' = fromCompilerM $ \id' -> CompilerM $ do
src/Hakyll/Core/Util/Arrow.hs+17−20
@@ -1,28 +1,25 @@
11-- | Various arrow utility functions
22--
33module Hakyll.Core.Util.Arrow
4− ( sequenceArr
5− , unitArr
6− , withUnitArr
4+ ( constA
5+ , sequenceA
6+ , unitA
77 ) where
88
9−import Prelude hiding (id)
10−import Control.Arrow (Arrow, (&&&), (>>>), arr, (***))
11−import Control.Category (id)
9+import Control.Arrow (Arrow, (&&&), arr, (>>^))
1210
13−sequenceArr :: Arrow a
14− => [a b c]
15− -> a b [c]
16−sequenceArr = foldl reduce $ arr $ const []
17− where
18− reduce la xa = xa &&& la >>> arr (uncurry (:))
11+constA :: Arrow a
12+ => c
13+ -> a b c
14+constA = arr . const
1915
20−unitArr :: Arrow a
21− => a b ()
22−unitArr = arr (const ())
16+sequenceA :: Arrow a
17+ => [a b c]
18+ -> a b [c]
19+sequenceA = foldl reduce $ constA []
20+ where
21+ reduce la xa = xa &&& la >>^ arr (uncurry (:))
2322
24−withUnitArr :: Arrow a
25− => a b c
26− -> a () d
27− -> a b (c, d)
28−withUnitArr a1 a2 = a1 &&& unitArr >>> id *** a2
23+unitA :: Arrow a
24+ => a b ()
25+unitA = constA ()
src/Hakyll/Web/FileType.hs+3−3
@@ -7,7 +7,7 @@ module Hakyll.Web.FileType
77 ) where
88
99import System.FilePath (takeExtension)
10−import Control.Arrow ((>>>), arr)
10+import Control.Arrow ((>>^))
1111
1212import Hakyll.Core.Identifier
1313import Hakyll.Core.Compiler
@@ -51,5 +51,5 @@ fileType = fileType' . takeExtension
5151
5252-- | Get the file type for the current file
5353--
54−getFileType :: Compiler () FileType
55−getFileType = getIdentifier >>> arr (fileType . toFilePath)
54+getFileType :: Compiler a FileType
55+getFileType = getIdentifier >>^ fileType . toFilePath
src/Hakyll/Web/Pandoc.hs+3−4
@@ -20,14 +20,13 @@ module Hakyll.Web.Pandoc
2020
2121import Prelude hiding (id)
2222import Control.Applicative ((<$>))
23−import Control.Arrow ((>>>), arr)
23+import Control.Arrow ((>>^), (&&&))
2424import Control.Category (id)
2525
2626import Text.Pandoc (Pandoc)
2727import qualified Text.Pandoc as P
2828
2929import Hakyll.Core.Compiler
30−import Hakyll.Core.Util.Arrow
3130import Hakyll.Web.FileType
3231import Hakyll.Web.Page
3332
@@ -75,7 +74,7 @@ pageReadPandoc = pageReadPandocWith defaultParserState
7574--
7675pageReadPandocWith :: P.ParserState -> Compiler (Page String) (Page Pandoc)
7776pageReadPandocWith state =
78− withUnitArr id getFileType >>> arr pageReadPandocWith'
77+ id &&& getFileType >>^ pageReadPandocWith'
7978 where
8079 pageReadPandocWith' (p, t) = readPandocWith state t <$> p
8180
@@ -90,7 +89,7 @@ pageRenderPandocWith :: P.ParserState
9089 -> P.WriterOptions
9190 -> Compiler (Page String) (Page String)
9291pageRenderPandocWith state options =
93− pageReadPandocWith state >>> arr (fmap $ writePandocWith options)
92+ pageReadPandocWith state >>^ (fmap $ writePandocWith options)
9493
9594-- | The default reader options for pandoc parsing in hakyll
9695--