src/Hakyll/Core/Util/Arrow.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36

-- | Various arrow utility functions
--
module Hakyll.Core.Util.Arrow
    ( constA
    , sequenceA
    , unitA
    , mapA
    ) where

import Control.Arrow ( Arrow, ArrowChoice, (&&&), arr, (>>^), (|||)
                     , (>>>), (***)
                     )

constA :: Arrow a
       => c
       -> a b c
constA = arr . const

sequenceA :: Arrow a
          => [a b c]
          -> a b [c]
sequenceA = foldl reduce $ constA []
  where
    reduce la xa = xa &&& la >>^ arr (uncurry (:))

unitA :: Arrow a
      => a b ()
unitA = constA ()

mapA :: ArrowChoice a
     => a b c
     -> a [b] [c]
mapA f = arr listEither >>> arr id ||| (f *** mapA f >>> arr (uncurry (:)))
  where
    listEither []       = Left []
    listEither (x : xs) = Right (x, xs)