diff options
author | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-30 10:11:37 +0100 |
---|---|---|
committer | Jasper Van der Jeugt <jaspervdj@gmail.com> | 2010-12-30 10:11:37 +0100 |
commit | 687c17c6bb1bc312a5660492164a9f00d710212a (patch) | |
tree | 0cbb1875b110eb5c9c024cd70e1e8ce6beae2a87 /src/Hakyll/Core | |
parent | 1c1133dfd6adae7c9c667d47eabaabb89cf8bdf9 (diff) | |
download | hakyll-687c17c6bb1bc312a5660492164a9f00d710212a.tar.gz |
Cleanup arrow code
Diffstat (limited to 'src/Hakyll/Core')
-rw-r--r-- | src/Hakyll/Core/Compiler.hs | 4 | ||||
-rw-r--r-- | src/Hakyll/Core/Util/Arrow.hs | 37 |
2 files changed, 19 insertions, 22 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 () |