{-# LANGUAGE Arrows #-}
{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

-- | Helper functions for Arrow effects

module Control.Kernmantle.Arrow where

import Control.Arrow
import Control.Category
import Data.List (uncons)
import Data.Profunctor
import Data.Profunctor.Cayley
import Data.Profunctor.Trans
import Data.Profunctor.Traversing
import Data.Ratio
import GHC.Generics

import Control.Kernmantle.Error

import Prelude hiding ((.), id)


-- | Map an arrow over a list using (***)
parMapA :: ArrowChoice a => a b c -> a [b] [c]
parMapA :: a b c -> a [b] [c]
parMapA a b c
f = ([b] -> Either () (b, [b])) -> a [b] (Either () (b, [b]))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Either () (b, [b])
-> ((b, [b]) -> Either () (b, [b]))
-> Maybe (b, [b])
-> Either () (b, [b])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () (b, [b])
forall a b. a -> Either a b
Left ()) (b, [b]) -> Either () (b, [b])
forall a b. b -> Either a b
Right (Maybe (b, [b]) -> Either () (b, [b]))
-> ([b] -> Maybe (b, [b])) -> [b] -> Either () (b, [b])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [b] -> Maybe (b, [b])
forall a. [a] -> Maybe (a, [a])
uncons)
      a [b] (Either () (b, [b]))
-> a (Either () (b, [b])) [c] -> a [b] [c]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((() -> [c]) -> a () [c]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([c] -> () -> [c]
forall a b. a -> b -> a
const []) a () [c] -> a (b, [b]) [c] -> a (Either () (b, [b])) [c]
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| ((a b c
f a b c -> a [b] [c] -> a (b, [b]) (c, [c])
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
*** a b c -> a [b] [c]
forall (a :: * -> * -> *) b c. ArrowChoice a => a b c -> a [b] [c]
parMapA a b c
f) a (b, [b]) (c, [c]) -> a (c, [c]) [c] -> a (b, [b]) [c]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((c, [c]) -> [c]) -> a (c, [c]) [c]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c -> [c] -> [c]) -> (c, [c]) -> [c]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:))))

-- | Map an arrow over a list using (>>>) and 'first'
seqMapA :: ArrowChoice a => a b c -> a [b] [c]
seqMapA :: a b c -> a [b] [c]
seqMapA a b c
f = ([b] -> Either () (b, [b])) -> a [b] (Either () (b, [b]))
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr (Either () (b, [b])
-> ((b, [b]) -> Either () (b, [b]))
-> Maybe (b, [b])
-> Either () (b, [b])
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (() -> Either () (b, [b])
forall a b. a -> Either a b
Left ()) (b, [b]) -> Either () (b, [b])
forall a b. b -> Either a b
Right (Maybe (b, [b]) -> Either () (b, [b]))
-> ([b] -> Maybe (b, [b])) -> [b] -> Either () (b, [b])
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [b] -> Maybe (b, [b])
forall a. [a] -> Maybe (a, [a])
uncons)
            a [b] (Either () (b, [b]))
-> a (Either () (b, [b])) [c] -> a [b] [c]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((() -> [c]) -> a () [c]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ([c] -> () -> [c]
forall a b. a -> b -> a
const []) a () [c] -> a (b, [b]) [c] -> a (Either () (b, [b])) [c]
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
||| ((a b c -> a (b, [b]) (c, [b])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first a b c
f a (b, [b]) (c, [b]) -> a (c, [b]) (c, [c]) -> a (b, [b]) (c, [c])
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> a [b] [c] -> a (c, [b]) (c, [c])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a b c -> a [b] [c]
forall (a :: * -> * -> *) b c. ArrowChoice a => a b c -> a [b] [c]
seqMapA a b c
f))
                                     a (b, [b]) (c, [c]) -> a (c, [c]) [c] -> a (b, [b]) [c]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((c, [c]) -> [c]) -> a (c, [c]) [c]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((c -> [c] -> [c]) -> (c, [c]) -> [c]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:))))

-- | Repeats an arrow step in order to fold a list
foldlA :: ArrowChoice a => a (b,acc) acc -> a ([b],acc) acc
foldlA :: a (b, acc) acc -> a ([b], acc) acc
foldlA a (b, acc) acc
f = proc ([b]
input,acc
acc) ->
  case [b]
input of
    [] -> a acc acc
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< acc
acc
    (b
x:[b]
xs) -> do
      !acc
acc' <- a (b, acc) acc
f -< (b
x,acc
acc)
      a (b, acc) acc -> a ([b], acc) acc
forall (a :: * -> * -> *) b acc.
ArrowChoice a =>
a (b, acc) acc -> a ([b], acc) acc
foldlA a (b, acc) acc
f -< ([b]
xs,acc
acc')

-- | Filter a list given an arrow filter
filterA :: ArrowChoice a => a b Bool -> a [b] [b]
filterA :: a b Bool -> a [b] [b]
filterA a b Bool
f = proc [b]
xs ->
  case [b]
xs of
    [] -> a [b] [b]
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< []
    (b
y:[b]
ys) -> do
      Bool
b <- a b Bool
f -< b
y
      if Bool
b then
        (a [b] [b] -> a (b, [b]) (b, [b])
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (a b Bool -> a [b] [b]
forall (a :: * -> * -> *) b. ArrowChoice a => a b Bool -> a [b] [b]
filterA a b Bool
f) a (b, [b]) (b, [b]) -> a (b, [b]) [b] -> a (b, [b]) [b]
forall k (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k).
Category cat =>
cat a b -> cat b c -> cat a c
>>> ((b, [b]) -> [b]) -> a (b, [b]) [b]
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr ((b -> [b] -> [b]) -> (b, [b]) -> [b]
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (:))) -< (b
y,[b]
ys)
      else
        a b Bool -> a [b] [b]
forall (a :: * -> * -> *) b. ArrowChoice a => a b Bool -> a [b] [b]
filterA a b Bool
f -< [b]
ys

-- | If a 'TryEffect' is also an 'ArrowChoice', then we can implement catch
catchE :: (TryEffect ex eff, ArrowChoice eff)
       => eff e c  -- ^ The effect to wrap
       -> eff (e, ex) c  -- ^ What to do in case of exception
       -> eff e c
catchE :: eff e c -> eff (e, ex) c -> eff e c
catchE eff e c
a eff (e, ex) c
onExc = proc e
e -> do
  Either ex c
res <- eff e c -> eff e (Either ex c)
forall ex (eff :: * -> * -> *) a b.
TryEffect ex eff =>
eff a b -> eff a (Either ex b)
tryE eff e c
a -< e
e
  case Either ex c
res of
    Left ex
ex ->
      eff (e, ex) c
onExc -< (e
e, ex
ex)
    Right c
r ->
      eff c c
forall (a :: * -> * -> *) b. Arrow a => a b b
returnA -< c
r

-- | A SplitId is a ratio of two positive numbers
newtype SplitId = SplitId (Ratio Word)
  deriving ((forall x. SplitId -> Rep SplitId x)
-> (forall x. Rep SplitId x -> SplitId) -> Generic SplitId
forall x. Rep SplitId x -> SplitId
forall x. SplitId -> Rep SplitId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SplitId x -> SplitId
$cfrom :: forall x. SplitId -> Rep SplitId x
Generic, SplitId -> SplitId -> Bool
(SplitId -> SplitId -> Bool)
-> (SplitId -> SplitId -> Bool) -> Eq SplitId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SplitId -> SplitId -> Bool
$c/= :: SplitId -> SplitId -> Bool
== :: SplitId -> SplitId -> Bool
$c== :: SplitId -> SplitId -> Bool
Eq, Eq SplitId
Eq SplitId
-> (SplitId -> SplitId -> Ordering)
-> (SplitId -> SplitId -> Bool)
-> (SplitId -> SplitId -> Bool)
-> (SplitId -> SplitId -> Bool)
-> (SplitId -> SplitId -> Bool)
-> (SplitId -> SplitId -> SplitId)
-> (SplitId -> SplitId -> SplitId)
-> Ord SplitId
SplitId -> SplitId -> Bool
SplitId -> SplitId -> Ordering
SplitId -> SplitId -> SplitId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SplitId -> SplitId -> SplitId
$cmin :: SplitId -> SplitId -> SplitId
max :: SplitId -> SplitId -> SplitId
$cmax :: SplitId -> SplitId -> SplitId
>= :: SplitId -> SplitId -> Bool
$c>= :: SplitId -> SplitId -> Bool
> :: SplitId -> SplitId -> Bool
$c> :: SplitId -> SplitId -> Bool
<= :: SplitId -> SplitId -> Bool
$c<= :: SplitId -> SplitId -> Bool
< :: SplitId -> SplitId -> Bool
$c< :: SplitId -> SplitId -> Bool
compare :: SplitId -> SplitId -> Ordering
$ccompare :: SplitId -> SplitId -> Ordering
$cp1Ord :: Eq SplitId
Ord, Integer -> SplitId
SplitId -> SplitId
SplitId -> SplitId -> SplitId
(SplitId -> SplitId -> SplitId)
-> (SplitId -> SplitId -> SplitId)
-> (SplitId -> SplitId -> SplitId)
-> (SplitId -> SplitId)
-> (SplitId -> SplitId)
-> (SplitId -> SplitId)
-> (Integer -> SplitId)
-> Num SplitId
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SplitId
$cfromInteger :: Integer -> SplitId
signum :: SplitId -> SplitId
$csignum :: SplitId -> SplitId
abs :: SplitId -> SplitId
$cabs :: SplitId -> SplitId
negate :: SplitId -> SplitId
$cnegate :: SplitId -> SplitId
* :: SplitId -> SplitId -> SplitId
$c* :: SplitId -> SplitId -> SplitId
- :: SplitId -> SplitId -> SplitId
$c- :: SplitId -> SplitId -> SplitId
+ :: SplitId -> SplitId -> SplitId
$c+ :: SplitId -> SplitId -> SplitId
Num)

instance Show SplitId where
  show :: SplitId -> String
show (SplitId Ratio Word
r) | Ratio Word
r Ratio Word -> Ratio Word -> Bool
forall a. Eq a => a -> a -> Bool
== Ratio Word
1 = String
"1"
                   | Bool
otherwise = Word -> String
forall a. Show a => a -> String
show (Ratio Word -> Word
forall a. Ratio a -> a
numerator Ratio Word
r)String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
"/"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>Word -> String
forall a. Show a => a -> String
show (Ratio Word -> Word
forall a. Ratio a -> a
denominator Ratio Word
r)

-- | 'split' defines the Calkin-Wilf tree. Its guaranteed never to produce twice
-- the same result if we split repeatedly starting from 1.
split :: (s -> SplitId) -> (s -> SplitId -> s) -- Morally a lens, but we don't
                                               -- depend on lens
      -> (s -> a) -> (a -> b -> c) -> (s -> b) -> s -> c
split :: (s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split s -> SplitId
get s -> SplitId -> s
set s -> a
f a -> b -> c
c s -> b
g s
s = case s -> SplitId
get s
s of
  SplitId Ratio Word
r -> let a :: Word
a = Ratio Word -> Word
forall a. Ratio a -> a
numerator Ratio Word
r
                   b :: Word
b = Ratio Word -> Word
forall a. Ratio a -> a
denominator Ratio Word
r
               in s -> a
f (s -> SplitId -> s
set s
s (SplitId -> s) -> SplitId -> s
forall a b. (a -> b) -> a -> b
$ Ratio Word -> SplitId
SplitId (Ratio Word -> SplitId) -> Ratio Word -> SplitId
forall a b. (a -> b) -> a -> b
$ Word
a Word -> Word -> Ratio Word
forall a. Integral a => a -> a -> Ratio a
% (Word
aWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
b)) a -> b -> c
`c` s -> b
g (s -> SplitId -> s
set s
s (SplitId -> s) -> SplitId -> s
forall a b. (a -> b) -> a -> b
$ Ratio Word -> SplitId
SplitId (Ratio Word -> SplitId) -> Ratio Word -> SplitId
forall a b. (a -> b) -> a -> b
$ (Word
aWord -> Word -> Word
forall a. Num a => a -> a -> a
+Word
b) Word -> Word -> Ratio Word
forall a. Integral a => a -> a -> Ratio a
% Word
b)
{-# INLINE split #-}

-- | The identifiers reflect the structure of the pipeline that led to some
-- task. They are 'split' at every use of (.), (***), (|||) or (<+>). This makes
-- it so every task in the pipeline has a different identifier.
data ArrowIdent = ArrowIdent
  { ArrowIdent -> SplitId
aidChoice :: {-# UNPACK #-} !SplitId
  , ArrowIdent -> SplitId
aidPlus   :: {-# UNPACK #-} !SplitId
  , ArrowIdent -> SplitId
aidPar    :: {-# UNPACK #-} !SplitId
  , ArrowIdent -> SplitId
aidComp   :: {-# UNPACK #-} !SplitId }
  deriving ((forall x. ArrowIdent -> Rep ArrowIdent x)
-> (forall x. Rep ArrowIdent x -> ArrowIdent) -> Generic ArrowIdent
forall x. Rep ArrowIdent x -> ArrowIdent
forall x. ArrowIdent -> Rep ArrowIdent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArrowIdent x -> ArrowIdent
$cfrom :: forall x. ArrowIdent -> Rep ArrowIdent x
Generic, ArrowIdent -> ArrowIdent -> Bool
(ArrowIdent -> ArrowIdent -> Bool)
-> (ArrowIdent -> ArrowIdent -> Bool) -> Eq ArrowIdent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArrowIdent -> ArrowIdent -> Bool
$c/= :: ArrowIdent -> ArrowIdent -> Bool
== :: ArrowIdent -> ArrowIdent -> Bool
$c== :: ArrowIdent -> ArrowIdent -> Bool
Eq, Eq ArrowIdent
Eq ArrowIdent
-> (ArrowIdent -> ArrowIdent -> Ordering)
-> (ArrowIdent -> ArrowIdent -> Bool)
-> (ArrowIdent -> ArrowIdent -> Bool)
-> (ArrowIdent -> ArrowIdent -> Bool)
-> (ArrowIdent -> ArrowIdent -> Bool)
-> (ArrowIdent -> ArrowIdent -> ArrowIdent)
-> (ArrowIdent -> ArrowIdent -> ArrowIdent)
-> Ord ArrowIdent
ArrowIdent -> ArrowIdent -> Bool
ArrowIdent -> ArrowIdent -> Ordering
ArrowIdent -> ArrowIdent -> ArrowIdent
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ArrowIdent -> ArrowIdent -> ArrowIdent
$cmin :: ArrowIdent -> ArrowIdent -> ArrowIdent
max :: ArrowIdent -> ArrowIdent -> ArrowIdent
$cmax :: ArrowIdent -> ArrowIdent -> ArrowIdent
>= :: ArrowIdent -> ArrowIdent -> Bool
$c>= :: ArrowIdent -> ArrowIdent -> Bool
> :: ArrowIdent -> ArrowIdent -> Bool
$c> :: ArrowIdent -> ArrowIdent -> Bool
<= :: ArrowIdent -> ArrowIdent -> Bool
$c<= :: ArrowIdent -> ArrowIdent -> Bool
< :: ArrowIdent -> ArrowIdent -> Bool
$c< :: ArrowIdent -> ArrowIdent -> Bool
compare :: ArrowIdent -> ArrowIdent -> Ordering
$ccompare :: ArrowIdent -> ArrowIdent -> Ordering
$cp1Ord :: Eq ArrowIdent
Ord)

instance Show ArrowIdent where
  show :: ArrowIdent -> String
show (ArrowIdent SplitId
a SplitId
b SplitId
c SplitId
d) =
    SplitId -> String
forall a. Show a => a -> String
show SplitId
a String -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
":"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>SplitId -> String
forall a. Show a => a -> String
show SplitId
bString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
":"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>SplitId -> String
forall a. Show a => a -> String
show SplitId
cString -> ShowS
forall a. Semigroup a => a -> a -> a
<>String
":"String -> ShowS
forall a. Semigroup a => a -> a -> a
<>SplitId -> String
forall a. Show a => a -> String
show SplitId
d

-- | An arrow transformer that can automatically determine an identifier from
-- its position in a pipeline. It is isomorphic to a @Reader ArrowIdent ~> arr@, but
-- we need a different Arrow instance than what 'Cayley' provides.
newtype AutoIdent arr a b = AutoIdent (ArrowIdent -> arr a b)
  deriving ( q b c -> AutoIdent arr a b -> AutoIdent arr a c
AutoIdent arr b c -> q a b -> AutoIdent arr a c
(a -> b) -> (c -> d) -> AutoIdent arr b c -> AutoIdent arr a d
(a -> b) -> AutoIdent arr b c -> AutoIdent arr a c
(b -> c) -> AutoIdent arr a b -> AutoIdent arr a c
(forall a b c d.
 (a -> b) -> (c -> d) -> AutoIdent arr b c -> AutoIdent arr a d)
-> (forall a b c.
    (a -> b) -> AutoIdent arr b c -> AutoIdent arr a c)
-> (forall b c a.
    (b -> c) -> AutoIdent arr a b -> AutoIdent arr a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> AutoIdent arr a b -> AutoIdent arr a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    AutoIdent arr b c -> q a b -> AutoIdent arr a c)
-> Profunctor (AutoIdent arr)
forall a b c. (a -> b) -> AutoIdent arr b c -> AutoIdent arr a c
forall b c a. (b -> c) -> AutoIdent arr a b -> AutoIdent arr a c
forall a b c d.
(a -> b) -> (c -> d) -> AutoIdent arr b c -> AutoIdent arr a d
forall a b c (q :: * -> * -> *).
Coercible b a =>
AutoIdent arr b c -> q a b -> AutoIdent arr a c
forall a b c (q :: * -> * -> *).
Coercible c b =>
q b c -> AutoIdent arr a b -> AutoIdent arr a c
forall (arr :: * -> * -> *) a b c.
Profunctor arr =>
(a -> b) -> AutoIdent arr b c -> AutoIdent arr a c
forall (arr :: * -> * -> *) b c a.
Profunctor arr =>
(b -> c) -> AutoIdent arr a b -> AutoIdent arr a c
forall (arr :: * -> * -> *) a b c d.
Profunctor arr =>
(a -> b) -> (c -> d) -> AutoIdent arr b c -> AutoIdent arr a d
forall (arr :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor arr, Coercible b a) =>
AutoIdent arr b c -> q a b -> AutoIdent arr a c
forall (arr :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor arr, Coercible c b) =>
q b c -> AutoIdent arr a b -> AutoIdent arr a c
forall (p :: * -> * -> *).
(forall a b c d. (a -> b) -> (c -> d) -> p b c -> p a d)
-> (forall a b c. (a -> b) -> p b c -> p a c)
-> (forall b c a. (b -> c) -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible c b =>
    q b c -> p a b -> p a c)
-> (forall a b c (q :: * -> * -> *).
    Coercible b a =>
    p b c -> q a b -> p a c)
-> Profunctor p
.# :: AutoIdent arr b c -> q a b -> AutoIdent arr a c
$c.# :: forall (arr :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor arr, Coercible b a) =>
AutoIdent arr b c -> q a b -> AutoIdent arr a c
#. :: q b c -> AutoIdent arr a b -> AutoIdent arr a c
$c#. :: forall (arr :: * -> * -> *) a b c (q :: * -> * -> *).
(Profunctor arr, Coercible c b) =>
q b c -> AutoIdent arr a b -> AutoIdent arr a c
rmap :: (b -> c) -> AutoIdent arr a b -> AutoIdent arr a c
$crmap :: forall (arr :: * -> * -> *) b c a.
Profunctor arr =>
(b -> c) -> AutoIdent arr a b -> AutoIdent arr a c
lmap :: (a -> b) -> AutoIdent arr b c -> AutoIdent arr a c
$clmap :: forall (arr :: * -> * -> *) a b c.
Profunctor arr =>
(a -> b) -> AutoIdent arr b c -> AutoIdent arr a c
dimap :: (a -> b) -> (c -> d) -> AutoIdent arr b c -> AutoIdent arr a d
$cdimap :: forall (arr :: * -> * -> *) a b c d.
Profunctor arr =>
(a -> b) -> (c -> d) -> AutoIdent arr b c -> AutoIdent arr a d
Profunctor, Profunctor (AutoIdent arr)
Profunctor (AutoIdent arr)
-> (forall a b c. AutoIdent arr a b -> AutoIdent arr (a, c) (b, c))
-> (forall a b c. AutoIdent arr a b -> AutoIdent arr (c, a) (c, b))
-> Strong (AutoIdent arr)
AutoIdent arr a b -> AutoIdent arr (a, c) (b, c)
AutoIdent arr a b -> AutoIdent arr (c, a) (c, b)
forall a b c. AutoIdent arr a b -> AutoIdent arr (a, c) (b, c)
forall a b c. AutoIdent arr a b -> AutoIdent arr (c, a) (c, b)
forall (arr :: * -> * -> *).
Strong arr =>
Profunctor (AutoIdent arr)
forall (arr :: * -> * -> *) a b c.
Strong arr =>
AutoIdent arr a b -> AutoIdent arr (a, c) (b, c)
forall (arr :: * -> * -> *) a b c.
Strong arr =>
AutoIdent arr a b -> AutoIdent arr (c, a) (c, b)
forall (p :: * -> * -> *).
Profunctor p
-> (forall a b c. p a b -> p (a, c) (b, c))
-> (forall a b c. p a b -> p (c, a) (c, b))
-> Strong p
second' :: AutoIdent arr a b -> AutoIdent arr (c, a) (c, b)
$csecond' :: forall (arr :: * -> * -> *) a b c.
Strong arr =>
AutoIdent arr a b -> AutoIdent arr (c, a) (c, b)
first' :: AutoIdent arr a b -> AutoIdent arr (a, c) (b, c)
$cfirst' :: forall (arr :: * -> * -> *) a b c.
Strong arr =>
AutoIdent arr a b -> AutoIdent arr (a, c) (b, c)
$cp1Strong :: forall (arr :: * -> * -> *).
Strong arr =>
Profunctor (AutoIdent arr)
Strong, Profunctor (AutoIdent arr)
Profunctor (AutoIdent arr)
-> (forall a d b. AutoIdent arr (a, d) (b, d) -> AutoIdent arr a b)
-> (forall d a b. AutoIdent arr (d, a) (d, b) -> AutoIdent arr a b)
-> Costrong (AutoIdent arr)
AutoIdent arr (a, d) (b, d) -> AutoIdent arr a b
AutoIdent arr (d, a) (d, b) -> AutoIdent arr a b
forall d a b. AutoIdent arr (d, a) (d, b) -> AutoIdent arr a b
forall a d b. AutoIdent arr (a, d) (b, d) -> AutoIdent arr a b
forall (arr :: * -> * -> *).
Costrong arr =>
Profunctor (AutoIdent arr)
forall (arr :: * -> * -> *) d a b.
Costrong arr =>
AutoIdent arr (d, a) (d, b) -> AutoIdent arr a b
forall (arr :: * -> * -> *) a d b.
Costrong arr =>
AutoIdent arr (a, d) (b, d) -> AutoIdent arr a b
forall (p :: * -> * -> *).
Profunctor p
-> (forall a d b. p (a, d) (b, d) -> p a b)
-> (forall d a b. p (d, a) (d, b) -> p a b)
-> Costrong p
unsecond :: AutoIdent arr (d, a) (d, b) -> AutoIdent arr a b
$cunsecond :: forall (arr :: * -> * -> *) d a b.
Costrong arr =>
AutoIdent arr (d, a) (d, b) -> AutoIdent arr a b
unfirst :: AutoIdent arr (a, d) (b, d) -> AutoIdent arr a b
$cunfirst :: forall (arr :: * -> * -> *) a d b.
Costrong arr =>
AutoIdent arr (a, d) (b, d) -> AutoIdent arr a b
$cp1Costrong :: forall (arr :: * -> * -> *).
Costrong arr =>
Profunctor (AutoIdent arr)
Costrong, Profunctor (AutoIdent arr)
Profunctor (AutoIdent arr)
-> (forall a b c.
    AutoIdent arr a b -> AutoIdent arr (Either a c) (Either b c))
-> (forall a b c.
    AutoIdent arr a b -> AutoIdent arr (Either c a) (Either c b))
-> Choice (AutoIdent arr)
AutoIdent arr a b -> AutoIdent arr (Either a c) (Either b c)
AutoIdent arr a b -> AutoIdent arr (Either c a) (Either c b)
forall a b c.
AutoIdent arr a b -> AutoIdent arr (Either a c) (Either b c)
forall a b c.
AutoIdent arr a b -> AutoIdent arr (Either c a) (Either c b)
forall (arr :: * -> * -> *).
Choice arr =>
Profunctor (AutoIdent arr)
forall (arr :: * -> * -> *) a b c.
Choice arr =>
AutoIdent arr a b -> AutoIdent arr (Either a c) (Either b c)
forall (arr :: * -> * -> *) a b c.
Choice arr =>
AutoIdent arr a b -> AutoIdent arr (Either c a) (Either c b)
forall (p :: * -> * -> *).
Profunctor p
-> (forall a b c. p a b -> p (Either a c) (Either b c))
-> (forall a b c. p a b -> p (Either c a) (Either c b))
-> Choice p
right' :: AutoIdent arr a b -> AutoIdent arr (Either c a) (Either c b)
$cright' :: forall (arr :: * -> * -> *) a b c.
Choice arr =>
AutoIdent arr a b -> AutoIdent arr (Either c a) (Either c b)
left' :: AutoIdent arr a b -> AutoIdent arr (Either a c) (Either b c)
$cleft' :: forall (arr :: * -> * -> *) a b c.
Choice arr =>
AutoIdent arr a b -> AutoIdent arr (Either a c) (Either b c)
$cp1Choice :: forall (arr :: * -> * -> *).
Choice arr =>
Profunctor (AutoIdent arr)
Choice, Profunctor (AutoIdent arr)
Profunctor (AutoIdent arr)
-> (forall a d b.
    AutoIdent arr (Either a d) (Either b d) -> AutoIdent arr a b)
-> (forall d a b.
    AutoIdent arr (Either d a) (Either d b) -> AutoIdent arr a b)
-> Cochoice (AutoIdent arr)
AutoIdent arr (Either a d) (Either b d) -> AutoIdent arr a b
AutoIdent arr (Either d a) (Either d b) -> AutoIdent arr a b
forall d a b.
AutoIdent arr (Either d a) (Either d b) -> AutoIdent arr a b
forall a d b.
AutoIdent arr (Either a d) (Either b d) -> AutoIdent arr a b
forall (arr :: * -> * -> *).
Cochoice arr =>
Profunctor (AutoIdent arr)
forall (arr :: * -> * -> *) d a b.
Cochoice arr =>
AutoIdent arr (Either d a) (Either d b) -> AutoIdent arr a b
forall (arr :: * -> * -> *) a d b.
Cochoice arr =>
AutoIdent arr (Either a d) (Either b d) -> AutoIdent arr a b
forall (p :: * -> * -> *).
Profunctor p
-> (forall a d b. p (Either a d) (Either b d) -> p a b)
-> (forall d a b. p (Either d a) (Either d b) -> p a b)
-> Cochoice p
unright :: AutoIdent arr (Either d a) (Either d b) -> AutoIdent arr a b
$cunright :: forall (arr :: * -> * -> *) d a b.
Cochoice arr =>
AutoIdent arr (Either d a) (Either d b) -> AutoIdent arr a b
unleft :: AutoIdent arr (Either a d) (Either b d) -> AutoIdent arr a b
$cunleft :: forall (arr :: * -> * -> *) a d b.
Cochoice arr =>
AutoIdent arr (Either a d) (Either b d) -> AutoIdent arr a b
$cp1Cochoice :: forall (arr :: * -> * -> *).
Cochoice arr =>
Profunctor (AutoIdent arr)
Cochoice, Profunctor (AutoIdent arr)
Profunctor (AutoIdent arr)
-> (forall a b x.
    AutoIdent arr a b -> AutoIdent arr (x -> a) (x -> b))
-> Closed (AutoIdent arr)
AutoIdent arr a b -> AutoIdent arr (x -> a) (x -> b)
forall a b x. AutoIdent arr a b -> AutoIdent arr (x -> a) (x -> b)
forall (arr :: * -> * -> *).
Closed arr =>
Profunctor (AutoIdent arr)
forall (arr :: * -> * -> *) a b x.
Closed arr =>
AutoIdent arr a b -> AutoIdent arr (x -> a) (x -> b)
forall (p :: * -> * -> *).
Profunctor p
-> (forall a b x. p a b -> p (x -> a) (x -> b)) -> Closed p
closed :: AutoIdent arr a b -> AutoIdent arr (x -> a) (x -> b)
$cclosed :: forall (arr :: * -> * -> *) a b x.
Closed arr =>
AutoIdent arr a b -> AutoIdent arr (x -> a) (x -> b)
$cp1Closed :: forall (arr :: * -> * -> *).
Closed arr =>
Profunctor (AutoIdent arr)
Closed
           , Choice (AutoIdent arr)
Strong (AutoIdent arr)
Choice (AutoIdent arr)
-> Strong (AutoIdent arr)
-> (forall (f :: * -> *) a b.
    Traversable f =>
    AutoIdent arr a b -> AutoIdent arr (f a) (f b))
-> (forall a b s t.
    (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
    -> AutoIdent arr a b -> AutoIdent arr s t)
-> Traversing (AutoIdent arr)
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> AutoIdent arr a b -> AutoIdent arr s t
forall a b s t.
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> AutoIdent arr a b -> AutoIdent arr s t
forall (f :: * -> *) a b.
Traversable f =>
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
forall (arr :: * -> * -> *).
Traversing arr =>
Choice (AutoIdent arr)
forall (arr :: * -> * -> *).
Traversing arr =>
Strong (AutoIdent arr)
forall (arr :: * -> * -> *) a b s t.
Traversing arr =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> AutoIdent arr a b -> AutoIdent arr s t
forall (arr :: * -> * -> *) (f :: * -> *) a b.
(Traversing arr, Traversable f) =>
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
forall (p :: * -> * -> *).
Choice p
-> Strong p
-> (forall (f :: * -> *) a b.
    Traversable f =>
    p a b -> p (f a) (f b))
-> (forall a b s t.
    (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
    -> p a b -> p s t)
-> Traversing p
wander :: (forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> AutoIdent arr a b -> AutoIdent arr s t
$cwander :: forall (arr :: * -> * -> *) a b s t.
Traversing arr =>
(forall (f :: * -> *). Applicative f => (a -> f b) -> s -> f t)
-> AutoIdent arr a b -> AutoIdent arr s t
traverse' :: AutoIdent arr a b -> AutoIdent arr (f a) (f b)
$ctraverse' :: forall (arr :: * -> * -> *) (f :: * -> *) a b.
(Traversing arr, Traversable f) =>
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
$cp2Traversing :: forall (arr :: * -> * -> *).
Traversing arr =>
Strong (AutoIdent arr)
$cp1Traversing :: forall (arr :: * -> * -> *).
Traversing arr =>
Choice (AutoIdent arr)
Traversing, Traversing (AutoIdent arr)
Closed (AutoIdent arr)
Traversing (AutoIdent arr)
-> Closed (AutoIdent arr)
-> (forall (f :: * -> *) a b.
    Functor f =>
    AutoIdent arr a b -> AutoIdent arr (f a) (f b))
-> (forall a b s t.
    ((a -> b) -> s -> t) -> AutoIdent arr a b -> AutoIdent arr s t)
-> Mapping (AutoIdent arr)
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
((a -> b) -> s -> t) -> AutoIdent arr a b -> AutoIdent arr s t
forall a b s t.
((a -> b) -> s -> t) -> AutoIdent arr a b -> AutoIdent arr s t
forall (f :: * -> *) a b.
Functor f =>
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
forall (arr :: * -> * -> *).
Mapping arr =>
Traversing (AutoIdent arr)
forall (arr :: * -> * -> *). Mapping arr => Closed (AutoIdent arr)
forall (arr :: * -> * -> *) a b s t.
Mapping arr =>
((a -> b) -> s -> t) -> AutoIdent arr a b -> AutoIdent arr s t
forall (arr :: * -> * -> *) (f :: * -> *) a b.
(Mapping arr, Functor f) =>
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
forall (p :: * -> * -> *).
Traversing p
-> Closed p
-> (forall (f :: * -> *) a b. Functor f => p a b -> p (f a) (f b))
-> (forall a b s t. ((a -> b) -> s -> t) -> p a b -> p s t)
-> Mapping p
roam :: ((a -> b) -> s -> t) -> AutoIdent arr a b -> AutoIdent arr s t
$croam :: forall (arr :: * -> * -> *) a b s t.
Mapping arr =>
((a -> b) -> s -> t) -> AutoIdent arr a b -> AutoIdent arr s t
map' :: AutoIdent arr a b -> AutoIdent arr (f a) (f b)
$cmap' :: forall (arr :: * -> * -> *) (f :: * -> *) a b.
(Mapping arr, Functor f) =>
AutoIdent arr a b -> AutoIdent arr (f a) (f b)
$cp2Mapping :: forall (arr :: * -> * -> *). Mapping arr => Closed (AutoIdent arr)
$cp1Mapping :: forall (arr :: * -> * -> *).
Mapping arr =>
Traversing (AutoIdent arr)
Mapping
           , Arrow (AutoIdent arr)
AutoIdent arr b c
Arrow (AutoIdent arr)
-> (forall b c. AutoIdent arr b c) -> ArrowZero (AutoIdent arr)
forall b c. AutoIdent arr b c
forall (a :: * -> * -> *).
Arrow a -> (forall b c. a b c) -> ArrowZero a
forall (arr :: * -> * -> *). ArrowZero arr => Arrow (AutoIdent arr)
forall (arr :: * -> * -> *) b c. ArrowZero arr => AutoIdent arr b c
zeroArrow :: AutoIdent arr b c
$czeroArrow :: forall (arr :: * -> * -> *) b c. ArrowZero arr => AutoIdent arr b c
$cp1ArrowZero :: forall (arr :: * -> * -> *). ArrowZero arr => Arrow (AutoIdent arr)
ArrowZero, Arrow (AutoIdent arr)
Arrow (AutoIdent arr)
-> (forall b d c. AutoIdent arr (b, d) (c, d) -> AutoIdent arr b c)
-> ArrowLoop (AutoIdent arr)
AutoIdent arr (b, d) (c, d) -> AutoIdent arr b c
forall b d c. AutoIdent arr (b, d) (c, d) -> AutoIdent arr b c
forall (a :: * -> * -> *).
Arrow a -> (forall b d c. a (b, d) (c, d) -> a b c) -> ArrowLoop a
forall (arr :: * -> * -> *). ArrowLoop arr => Arrow (AutoIdent arr)
forall (arr :: * -> * -> *) b d c.
ArrowLoop arr =>
AutoIdent arr (b, d) (c, d) -> AutoIdent arr b c
loop :: AutoIdent arr (b, d) (c, d) -> AutoIdent arr b c
$cloop :: forall (arr :: * -> * -> *) b d c.
ArrowLoop arr =>
AutoIdent arr (b, d) (c, d) -> AutoIdent arr b c
$cp1ArrowLoop :: forall (arr :: * -> * -> *). ArrowLoop arr => Arrow (AutoIdent arr)
ArrowLoop )
    via Cayley ((->) ArrowIdent) arr

runAutoIdent' :: SplitId -> AutoIdent arr a b -> arr a b
runAutoIdent' :: SplitId -> AutoIdent arr a b -> arr a b
runAutoIdent' SplitId
i (AutoIdent ArrowIdent -> arr a b
f) = ArrowIdent -> arr a b
f (ArrowIdent -> arr a b) -> ArrowIdent -> arr a b
forall a b. (a -> b) -> a -> b
$ SplitId -> SplitId -> SplitId -> SplitId -> ArrowIdent
ArrowIdent SplitId
i SplitId
i SplitId
i SplitId
i

runAutoIdent :: AutoIdent arr a b -> arr a b
runAutoIdent :: AutoIdent arr a b -> arr a b
runAutoIdent = SplitId -> AutoIdent arr a b -> arr a b
forall (arr :: * -> * -> *) a b.
SplitId -> AutoIdent arr a b -> arr a b
runAutoIdent' SplitId
1

instance (Category eff) => Category (AutoIdent eff) where
  id :: AutoIdent eff a a
id = (ArrowIdent -> eff a a) -> AutoIdent eff a a
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff a a) -> AutoIdent eff a a)
-> (ArrowIdent -> eff a a) -> AutoIdent eff a a
forall a b. (a -> b) -> a -> b
$ eff a a -> ArrowIdent -> eff a a
forall a b. a -> b -> a
const eff a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  AutoIdent ArrowIdent -> eff b c
b . :: AutoIdent eff b c -> AutoIdent eff a b -> AutoIdent eff a c
. AutoIdent ArrowIdent -> eff a b
a = (ArrowIdent -> eff a c) -> AutoIdent eff a c
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff a c) -> AutoIdent eff a c)
-> (ArrowIdent -> eff a c) -> AutoIdent eff a c
forall a b. (a -> b) -> a -> b
$ (ArrowIdent -> SplitId)
-> (ArrowIdent -> SplitId -> ArrowIdent)
-> (ArrowIdent -> eff b c)
-> (eff b c -> eff a b -> eff a c)
-> (ArrowIdent -> eff a b)
-> ArrowIdent
-> eff a c
forall s a b c.
(s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split ArrowIdent -> SplitId
aidComp (\ArrowIdent
ai SplitId
i -> ArrowIdent
ai{aidComp :: SplitId
aidComp=SplitId
i})
    ArrowIdent -> eff b c
b eff b c -> eff a b -> eff a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) ArrowIdent -> eff a b
a
instance (Arrow eff) => Arrow (AutoIdent eff) where
  arr :: (b -> c) -> AutoIdent eff b c
arr = (ArrowIdent -> eff b c) -> AutoIdent eff b c
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff b c) -> AutoIdent eff b c)
-> ((b -> c) -> ArrowIdent -> eff b c)
-> (b -> c)
-> AutoIdent eff b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. eff b c -> ArrowIdent -> eff b c
forall a b. a -> b -> a
const (eff b c -> ArrowIdent -> eff b c)
-> ((b -> c) -> eff b c) -> (b -> c) -> ArrowIdent -> eff b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (b -> c) -> eff b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr
  first :: AutoIdent eff b c -> AutoIdent eff (b, d) (c, d)
first (AutoIdent ArrowIdent -> eff b c
f) = (ArrowIdent -> eff (b, d) (c, d)) -> AutoIdent eff (b, d) (c, d)
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (b, d) (c, d)) -> AutoIdent eff (b, d) (c, d))
-> (ArrowIdent -> eff (b, d) (c, d)) -> AutoIdent eff (b, d) (c, d)
forall a b. (a -> b) -> a -> b
$ eff b c -> eff (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first (eff b c -> eff (b, d) (c, d))
-> (ArrowIdent -> eff b c) -> ArrowIdent -> eff (b, d) (c, d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrowIdent -> eff b c
f
  second :: AutoIdent eff b c -> AutoIdent eff (d, b) (d, c)
second (AutoIdent ArrowIdent -> eff b c
f) = (ArrowIdent -> eff (d, b) (d, c)) -> AutoIdent eff (d, b) (d, c)
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (d, b) (d, c)) -> AutoIdent eff (d, b) (d, c))
-> (ArrowIdent -> eff (d, b) (d, c)) -> AutoIdent eff (d, b) (d, c)
forall a b. (a -> b) -> a -> b
$ eff b c -> eff (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
second (eff b c -> eff (d, b) (d, c))
-> (ArrowIdent -> eff b c) -> ArrowIdent -> eff (d, b) (d, c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrowIdent -> eff b c
f
  AutoIdent ArrowIdent -> eff b c
a *** :: AutoIdent eff b c
-> AutoIdent eff b' c' -> AutoIdent eff (b, b') (c, c')
*** AutoIdent ArrowIdent -> eff b' c'
b = (ArrowIdent -> eff (b, b') (c, c'))
-> AutoIdent eff (b, b') (c, c')
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (b, b') (c, c'))
 -> AutoIdent eff (b, b') (c, c'))
-> (ArrowIdent -> eff (b, b') (c, c'))
-> AutoIdent eff (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ (ArrowIdent -> SplitId)
-> (ArrowIdent -> SplitId -> ArrowIdent)
-> (ArrowIdent -> eff b c)
-> (eff b c -> eff b' c' -> eff (b, b') (c, c'))
-> (ArrowIdent -> eff b' c')
-> ArrowIdent
-> eff (b, b') (c, c')
forall s a b c.
(s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split ArrowIdent -> SplitId
aidPar (\ArrowIdent
ai SplitId
i -> ArrowIdent
ai{aidPar :: SplitId
aidPar=SplitId
i})
    ArrowIdent -> eff b c
a eff b c -> eff b' c' -> eff (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) ArrowIdent -> eff b' c'
b
  AutoIdent ArrowIdent -> eff b c
a &&& :: AutoIdent eff b c -> AutoIdent eff b c' -> AutoIdent eff b (c, c')
&&& AutoIdent ArrowIdent -> eff b c'
b = (ArrowIdent -> eff b (c, c')) -> AutoIdent eff b (c, c')
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff b (c, c')) -> AutoIdent eff b (c, c'))
-> (ArrowIdent -> eff b (c, c')) -> AutoIdent eff b (c, c')
forall a b. (a -> b) -> a -> b
$ (ArrowIdent -> SplitId)
-> (ArrowIdent -> SplitId -> ArrowIdent)
-> (ArrowIdent -> eff b c)
-> (eff b c -> eff b c' -> eff b (c, c'))
-> (ArrowIdent -> eff b c')
-> ArrowIdent
-> eff b (c, c')
forall s a b c.
(s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split ArrowIdent -> SplitId
aidPar (\ArrowIdent
ai SplitId
i -> ArrowIdent
ai{aidPar :: SplitId
aidPar=SplitId
i})
    ArrowIdent -> eff b c
a eff b c -> eff b c' -> eff b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) ArrowIdent -> eff b c'
b
instance (ArrowPlus eff) => ArrowPlus (AutoIdent eff) where
  AutoIdent ArrowIdent -> eff b c
a <+> :: AutoIdent eff b c -> AutoIdent eff b c -> AutoIdent eff b c
<+> AutoIdent ArrowIdent -> eff b c
b = (ArrowIdent -> eff b c) -> AutoIdent eff b c
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff b c) -> AutoIdent eff b c)
-> (ArrowIdent -> eff b c) -> AutoIdent eff b c
forall a b. (a -> b) -> a -> b
$ (ArrowIdent -> SplitId)
-> (ArrowIdent -> SplitId -> ArrowIdent)
-> (ArrowIdent -> eff b c)
-> (eff b c -> eff b c -> eff b c)
-> (ArrowIdent -> eff b c)
-> ArrowIdent
-> eff b c
forall s a b c.
(s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split ArrowIdent -> SplitId
aidPlus (\ArrowIdent
ai SplitId
i -> ArrowIdent
ai{aidPlus :: SplitId
aidPlus=SplitId
i})
    ArrowIdent -> eff b c
a eff b c -> eff b c -> eff b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>) ArrowIdent -> eff b c
b
instance (ArrowChoice eff) => ArrowChoice (AutoIdent eff) where
  left :: AutoIdent eff b c -> AutoIdent eff (Either b d) (Either c d)
left (AutoIdent ArrowIdent -> eff b c
f) = (ArrowIdent -> eff (Either b d) (Either c d))
-> AutoIdent eff (Either b d) (Either c d)
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (Either b d) (Either c d))
 -> AutoIdent eff (Either b d) (Either c d))
-> (ArrowIdent -> eff (Either b d) (Either c d))
-> AutoIdent eff (Either b d) (Either c d)
forall a b. (a -> b) -> a -> b
$ eff b c -> eff (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (eff b c -> eff (Either b d) (Either c d))
-> (ArrowIdent -> eff b c)
-> ArrowIdent
-> eff (Either b d) (Either c d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrowIdent -> eff b c
f
  right :: AutoIdent eff b c -> AutoIdent eff (Either d b) (Either d c)
right (AutoIdent ArrowIdent -> eff b c
f) = (ArrowIdent -> eff (Either d b) (Either d c))
-> AutoIdent eff (Either d b) (Either d c)
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (Either d b) (Either d c))
 -> AutoIdent eff (Either d b) (Either d c))
-> (ArrowIdent -> eff (Either d b) (Either d c))
-> AutoIdent eff (Either d b) (Either d c)
forall a b. (a -> b) -> a -> b
$ eff b c -> eff (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right (eff b c -> eff (Either d b) (Either d c))
-> (ArrowIdent -> eff b c)
-> ArrowIdent
-> eff (Either d b) (Either d c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrowIdent -> eff b c
f
  AutoIdent ArrowIdent -> eff b d
a ||| :: AutoIdent eff b d
-> AutoIdent eff c d -> AutoIdent eff (Either b c) d
||| AutoIdent ArrowIdent -> eff c d
b = (ArrowIdent -> eff (Either b c) d) -> AutoIdent eff (Either b c) d
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (Either b c) d)
 -> AutoIdent eff (Either b c) d)
-> (ArrowIdent -> eff (Either b c) d)
-> AutoIdent eff (Either b c) d
forall a b. (a -> b) -> a -> b
$ (ArrowIdent -> SplitId)
-> (ArrowIdent -> SplitId -> ArrowIdent)
-> (ArrowIdent -> eff b d)
-> (eff b d -> eff c d -> eff (Either b c) d)
-> (ArrowIdent -> eff c d)
-> ArrowIdent
-> eff (Either b c) d
forall s a b c.
(s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split ArrowIdent -> SplitId
aidChoice (\ArrowIdent
ai SplitId
i -> ArrowIdent
ai{aidChoice :: SplitId
aidChoice=SplitId
i})
    ArrowIdent -> eff b d
a eff b d -> eff c d -> eff (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
(|||) ArrowIdent -> eff c d
b
  AutoIdent ArrowIdent -> eff b c
a +++ :: AutoIdent eff b c
-> AutoIdent eff b' c' -> AutoIdent eff (Either b b') (Either c c')
+++ AutoIdent ArrowIdent -> eff b' c'
b = (ArrowIdent -> eff (Either b b') (Either c c'))
-> AutoIdent eff (Either b b') (Either c c')
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff (Either b b') (Either c c'))
 -> AutoIdent eff (Either b b') (Either c c'))
-> (ArrowIdent -> eff (Either b b') (Either c c'))
-> AutoIdent eff (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$ (ArrowIdent -> SplitId)
-> (ArrowIdent -> SplitId -> ArrowIdent)
-> (ArrowIdent -> eff b c)
-> (eff b c -> eff b' c' -> eff (Either b b') (Either c c'))
-> (ArrowIdent -> eff b' c')
-> ArrowIdent
-> eff (Either b b') (Either c c')
forall s a b c.
(s -> SplitId)
-> (s -> SplitId -> s)
-> (s -> a)
-> (a -> b -> c)
-> (s -> b)
-> s
-> c
split ArrowIdent -> SplitId
aidChoice (\ArrowIdent
ai SplitId
i -> ArrowIdent
ai{aidChoice :: SplitId
aidChoice=SplitId
i})
    ArrowIdent -> eff b c
a eff b c -> eff b' c' -> eff (Either b b') (Either c c')
forall (a :: * -> * -> *) b c b' c'.
ArrowChoice a =>
a b c -> a b' c' -> a (Either b b') (Either c c')
(+++) ArrowIdent -> eff b' c'
b

instance (SieveTrans f eff) => SieveTrans f (AutoIdent eff) where
  liftSieve :: (a -> f b) -> AutoIdent eff a b
liftSieve = (ArrowIdent -> eff a b) -> AutoIdent eff a b
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff a b) -> AutoIdent eff a b)
-> ((a -> f b) -> ArrowIdent -> eff a b)
-> (a -> f b)
-> AutoIdent eff a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. eff a b -> ArrowIdent -> eff a b
forall a b. a -> b -> a
const (eff a b -> ArrowIdent -> eff a b)
-> ((a -> f b) -> eff a b) -> (a -> f b) -> ArrowIdent -> eff a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> f b) -> eff a b
forall (f :: * -> *) (cat :: * -> * -> *) a b.
SieveTrans f cat =>
(a -> f b) -> cat a b
liftSieve
  mapSieve :: ((a -> f b) -> a' -> f b')
-> AutoIdent eff a b -> AutoIdent eff a' b'
mapSieve (a -> f b) -> a' -> f b'
f (AutoIdent ArrowIdent -> eff a b
af) = (ArrowIdent -> eff a' b') -> AutoIdent eff a' b'
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ((ArrowIdent -> eff a' b') -> AutoIdent eff a' b')
-> (ArrowIdent -> eff a' b') -> AutoIdent eff a' b'
forall a b. (a -> b) -> a -> b
$ ((a -> f b) -> a' -> f b') -> eff a b -> eff a' b'
forall (f :: * -> *) (cat :: * -> * -> *) a b a' b'.
SieveTrans f cat =>
((a -> f b) -> a' -> f b') -> cat a b -> cat a' b'
mapSieve (a -> f b) -> a' -> f b'
f (eff a b -> eff a' b')
-> (ArrowIdent -> eff a b) -> ArrowIdent -> eff a' b'
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ArrowIdent -> eff a b
af

-- | All effects that internally feature some AutoIdent
class HasAutoIdent wrappedEff eff | eff -> wrappedEff where
  liftAutoIdent :: (ArrowIdent -> wrappedEff a b) -> eff a b

instance HasAutoIdent eff (AutoIdent eff) where
  liftAutoIdent :: (ArrowIdent -> eff a b) -> AutoIdent eff a b
liftAutoIdent ArrowIdent -> eff a b
f = (ArrowIdent -> eff a b) -> AutoIdent eff a b
forall (arr :: * -> * -> *) a b.
(ArrowIdent -> arr a b) -> AutoIdent arr a b
AutoIdent ArrowIdent -> eff a b
f

instance (HasAutoIdent ai eff, Applicative f)
  => HasAutoIdent ai (Cayley f eff) where
  liftAutoIdent :: (ArrowIdent -> ai a b) -> Cayley f eff a b
liftAutoIdent ArrowIdent -> ai a b
f = f (eff a b) -> Cayley f eff a b
forall k k1 k2 (f :: k -> *) (p :: k1 -> k2 -> k) (a :: k1)
       (b :: k2).
f (p a b) -> Cayley f p a b
Cayley (f (eff a b) -> Cayley f eff a b)
-> f (eff a b) -> Cayley f eff a b
forall a b. (a -> b) -> a -> b
$ eff a b -> f (eff a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((ArrowIdent -> ai a b) -> eff a b
forall (wrappedEff :: * -> * -> *) (eff :: * -> * -> *) a b.
HasAutoIdent wrappedEff eff =>
(ArrowIdent -> wrappedEff a b) -> eff a b
liftAutoIdent ArrowIdent -> ai a b
f)

--  -- | Permits an arrow to recursively call itself without changing its identifier
-- fixIdent :: (HasAutoIdent ai eff)
--          => (eff a b -> eff a b) -> eff a b
-- fixIdent f = liftAutoIdent $ \aid ->
--   let run = case f (AutoIdent $ \_ -> run) of AutoIdent f' -> f' aid
--   in run