{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE GADTs #-}
{-# OPTIONS_GHC -Wall -fno-warn-tabs #-}
module Control.Monad.Freer.Par.Sequence (
Sequence(..), ViewL(..),
(<|), (|>), mapS ) where
import Control.Arrow ((>>>))
infixr 8 ><
class Sequence sq where
empty :: sq cat a a; singleton :: cat a b -> sq cat a b
(><) :: sq cat a b -> sq cat b c -> sq cat a c
viewl :: sq cat a b -> ViewL sq cat a b
data ViewL sq cat a b where
EmptyL :: ViewL sq cat a a
(:<|) :: cat a x -> sq cat x b -> ViewL sq cat a b
infixr 8 <|
(<|) :: Sequence sq => cat a b -> sq cat b c -> sq cat a c
cat a b
c <| :: forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b c.
Sequence sq =>
cat a b -> sq cat b c -> sq cat a c
<| sq cat b c
s = forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b.
Sequence sq =>
cat a b -> sq cat a b
singleton cat a b
c forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b c.
Sequence sq =>
sq cat a b -> sq cat b c -> sq cat a c
>< sq cat b c
s
infixl 8 |>
(|>) :: Sequence sq => sq cat a b -> cat b c -> sq cat a c
sq cat a b
s |> :: forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b c.
Sequence sq =>
sq cat a b -> cat b c -> sq cat a c
|> cat b c
c = sq cat a b
s forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b c.
Sequence sq =>
sq cat a b -> sq cat b c -> sq cat a c
>< forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b.
Sequence sq =>
cat a b -> sq cat a b
singleton cat b c
c
mapS :: (Applicative f, Sequence sq) =>
(forall x y . cat x y -> f (cat x y)) -> sq cat a b -> f (sq cat a b)
mapS :: forall (f :: * -> *) (sq :: (* -> * -> *) -> * -> * -> *)
(cat :: * -> * -> *) a b.
(Applicative f, Sequence sq) =>
(forall x y. cat x y -> f (cat x y))
-> sq cat a b -> f (sq cat a b)
mapS forall x y. cat x y -> f (cat x y)
f = forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b.
Sequence sq =>
sq cat a b -> ViewL sq cat a b
viewl forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> \case
ViewL sq cat a b
EmptyL -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a.
Sequence sq =>
sq cat a a
empty; cat a x
c :<| sq cat x b
s -> forall (sq :: (* -> * -> *) -> * -> * -> *) (cat :: * -> * -> *) a
b c.
Sequence sq =>
cat a b -> sq cat b c -> sq cat a c
(<|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall x y. cat x y -> f (cat x y)
f cat a x
c forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall x y. cat x y -> f (cat x y)
f forall (f :: * -> *) (sq :: (* -> * -> *) -> * -> * -> *)
(cat :: * -> * -> *) a b.
(Applicative f, Sequence sq) =>
(forall x y. cat x y -> f (cat x y))
-> sq cat a b -> f (sq cat a b)
`mapS` sq cat x b
s