{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}

#if __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE DeriveGeneric #-}
#endif

#if __GLASGOW_HASKELL__ >= 706
{-# LANGUAGE PolyKinds #-}
#endif

#if __GLASGOW_HASKELL__ >= 708
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
{-# LANGUAGE Trustworthy #-}
#endif
#include "bifunctors-common.h"

-----------------------------------------------------------------------------

-- |

-- Copyright   :  (C) 2008-2016 Edward Kmett

-- License     :  BSD-style (see the file LICENSE)

--

-- Maintainer  :  Edward Kmett <ekmett@gmail.com>

-- Stability   :  provisional

-- Portability :  portable

--

----------------------------------------------------------------------------

module Data.Bifunctor.Tannen
  ( Tannen(..)
  ) where

import Control.Applicative

import Control.Arrow as A
import Control.Category
import Control.Comonad

import Data.Bifunctor as B
import Data.Bifunctor.Functor
import Data.Biapplicative
import Data.Bifoldable
import Data.Bitraversable

#if __GLASGOW_HASKELL__ < 710
import Data.Foldable
import Data.Monoid
import Data.Traversable
#endif

#if __GLASGOW_HASKELL__ >= 708
import Data.Typeable
#endif

#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics
#endif

#if LIFTED_FUNCTOR_CLASSES
import Data.Functor.Classes
#endif

import Prelude hiding ((.),id)

-- | Compose a 'Functor' on the outside of a 'Bifunctor'.

newtype Tannen f p a b = Tannen { Tannen f p a b -> f (p a b)
runTannen :: f (p a b) }
  deriving ( Tannen f p a b -> Tannen f p a b -> Bool
(Tannen f p a b -> Tannen f p a b -> Bool)
-> (Tannen f p a b -> Tannen f p a b -> Bool)
-> Eq (Tannen f p a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Eq (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
/= :: Tannen f p a b -> Tannen f p a b -> Bool
$c/= :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Eq (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
== :: Tannen f p a b -> Tannen f p a b -> Bool
$c== :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Eq (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
Eq, Eq (Tannen f p a b)
Eq (Tannen f p a b)
-> (Tannen f p a b -> Tannen f p a b -> Ordering)
-> (Tannen f p a b -> Tannen f p a b -> Bool)
-> (Tannen f p a b -> Tannen f p a b -> Bool)
-> (Tannen f p a b -> Tannen f p a b -> Bool)
-> (Tannen f p a b -> Tannen f p a b -> Bool)
-> (Tannen f p a b -> Tannen f p a b -> Tannen f p a b)
-> (Tannen f p a b -> Tannen f p a b -> Tannen f p a b)
-> Ord (Tannen f p a b)
Tannen f p a b -> Tannen f p a b -> Bool
Tannen f p a b -> Tannen f p a b -> Ordering
Tannen f p a b -> Tannen f p a b -> Tannen f p a b
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
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Eq (Tannen f p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Ordering
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Tannen f p a b
min :: Tannen f p a b -> Tannen f p a b -> Tannen f p a b
$cmin :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Tannen f p a b
max :: Tannen f p a b -> Tannen f p a b -> Tannen f p a b
$cmax :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Tannen f p a b
>= :: Tannen f p a b -> Tannen f p a b -> Bool
$c>= :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
> :: Tannen f p a b -> Tannen f p a b -> Bool
$c> :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
<= :: Tannen f p a b -> Tannen f p a b -> Bool
$c<= :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
< :: Tannen f p a b -> Tannen f p a b -> Bool
$c< :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Bool
compare :: Tannen f p a b -> Tannen f p a b -> Ordering
$ccompare :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Tannen f p a b -> Tannen f p a b -> Ordering
$cp1Ord :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Ord (f (p a b)) =>
Eq (Tannen f p a b)
Ord, Int -> Tannen f p a b -> ShowS
[Tannen f p a b] -> ShowS
Tannen f p a b -> String
(Int -> Tannen f p a b -> ShowS)
-> (Tannen f p a b -> String)
-> ([Tannen f p a b] -> ShowS)
-> Show (Tannen f p a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Show (f (p a b)) =>
Int -> Tannen f p a b -> ShowS
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Show (f (p a b)) =>
[Tannen f p a b] -> ShowS
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Show (f (p a b)) =>
Tannen f p a b -> String
showList :: [Tannen f p a b] -> ShowS
$cshowList :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Show (f (p a b)) =>
[Tannen f p a b] -> ShowS
show :: Tannen f p a b -> String
$cshow :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Show (f (p a b)) =>
Tannen f p a b -> String
showsPrec :: Int -> Tannen f p a b -> ShowS
$cshowsPrec :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Show (f (p a b)) =>
Int -> Tannen f p a b -> ShowS
Show, ReadPrec [Tannen f p a b]
ReadPrec (Tannen f p a b)
Int -> ReadS (Tannen f p a b)
ReadS [Tannen f p a b]
(Int -> ReadS (Tannen f p a b))
-> ReadS [Tannen f p a b]
-> ReadPrec (Tannen f p a b)
-> ReadPrec [Tannen f p a b]
-> Read (Tannen f p a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
ReadPrec [Tannen f p a b]
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
ReadPrec (Tannen f p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
Int -> ReadS (Tannen f p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
ReadS [Tannen f p a b]
readListPrec :: ReadPrec [Tannen f p a b]
$creadListPrec :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
ReadPrec [Tannen f p a b]
readPrec :: ReadPrec (Tannen f p a b)
$creadPrec :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
ReadPrec (Tannen f p a b)
readList :: ReadS [Tannen f p a b]
$creadList :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
ReadS [Tannen f p a b]
readsPrec :: Int -> ReadS (Tannen f p a b)
$creadsPrec :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Read (f (p a b)) =>
Int -> ReadS (Tannen f p a b)
Read
#if __GLASGOW_HASKELL__ >= 702
           , (forall x. Tannen f p a b -> Rep (Tannen f p a b) x)
-> (forall x. Rep (Tannen f p a b) x -> Tannen f p a b)
-> Generic (Tannen f p a b)
forall x. Rep (Tannen f p a b) x -> Tannen f p a b
forall x. Tannen f p a b -> Rep (Tannen f p a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k) x.
Rep (Tannen f p a b) x -> Tannen f p a b
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k) x.
Tannen f p a b -> Rep (Tannen f p a b) x
$cto :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k) x.
Rep (Tannen f p a b) x -> Tannen f p a b
$cfrom :: forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k) x.
Tannen f p a b -> Rep (Tannen f p a b) x
Generic
#endif
#if __GLASGOW_HASKELL__ >= 708
           , Typeable
#endif
           )
#if __GLASGOW_HASKELL__ >= 702
# if __GLASGOW_HASKELL__ >= 708
deriving instance Functor f => Generic1 (Tannen f p a)
# else
data TannenMetaData
data TannenMetaCons
data TannenMetaSel

instance Datatype TannenMetaData where
    datatypeName _ = "Tannen"
    moduleName _ = "Data.Bifunctor.Tannen"

instance Constructor TannenMetaCons where
    conName _ = "Tannen"
    conIsRecord _ = True

instance Selector TannenMetaSel where
    selName _ = "runTannen"

instance Functor f => Generic1 (Tannen f p a) where
    type Rep1 (Tannen f p a) = D1 TannenMetaData (C1 TannenMetaCons
        (S1 TannenMetaSel (f :.: Rec1 (p a))))
    from1 = M1 . M1 . M1 . Comp1 . fmap Rec1 . runTannen
    to1 = Tannen . fmap unRec1 . unComp1 . unM1 . unM1 . unM1
# endif
#endif

#if LIFTED_FUNCTOR_CLASSES
instance (Eq1 f, Eq2 p, Eq a) => Eq1 (Tannen f p a) where
  liftEq :: (a -> b -> Bool) -> Tannen f p a a -> Tannen f p a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> Tannen f p a a -> Tannen f p a b -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> a -> Bool
forall a. Eq a => a -> a -> Bool
(==)
instance (Eq1 f, Eq2 p) => Eq2 (Tannen f p) where
  liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> Tannen f p a c -> Tannen f p b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g (Tannen f (p a c)
x) (Tannen f (p b d)
y) = (p a c -> p b d -> Bool) -> f (p a c) -> f (p b d) -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq ((a -> b -> Bool) -> (c -> d -> Bool) -> p a c -> p b d -> Bool
forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
g) f (p a c)
x f (p b d)
y

instance (Ord1 f, Ord2 p, Ord a) => Ord1 (Tannen f p a) where
  liftCompare :: (a -> b -> Ordering)
-> Tannen f p a a -> Tannen f p a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering)
-> Tannen f p a a
-> Tannen f p a b
-> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> a -> Ordering
forall a. Ord a => a -> a -> Ordering
compare
instance (Ord1 f, Ord2 p) => Ord2 (Tannen f p) where
  liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering)
-> Tannen f p a c
-> Tannen f p b d
-> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g (Tannen f (p a c)
x) (Tannen f (p b d)
y) = (p a c -> p b d -> Ordering) -> f (p a c) -> f (p b d) -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare ((a -> b -> Ordering)
-> (c -> d -> Ordering) -> p a c -> p b d -> Ordering
forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
g) f (p a c)
x f (p b d)
y

instance (Read1 f, Read2 p, Read a) => Read1 (Tannen f p a) where
  liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Tannen f p a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (Tannen f p a a)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
forall a. Read a => Int -> ReadS a
readsPrec ReadS [a]
forall a. Read a => ReadS [a]
readList
instance (Read1 f, Read2 p) => Read2 (Tannen f p) where
  liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Tannen f p a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2 Int
p = Bool -> ReadS (Tannen f p a b) -> ReadS (Tannen f p a b)
forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ReadS (Tannen f p a b) -> ReadS (Tannen f p a b))
-> ReadS (Tannen f p a b) -> ReadS (Tannen f p a b)
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
    (String
"Tannen",    String
s1) <- ReadS String
lex String
s0
    (String
"{",         String
s2) <- ReadS String
lex String
s1
    (String
"runTannen", String
s3) <- ReadS String
lex String
s2
    (f (p a b)
x,           String
s4) <- (Int -> ReadS (p a b)) -> ReadS [p a b] -> Int -> ReadS (f (p a b))
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec ((Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (p a b)
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2)
                                       ((Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [p a b]
forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a] -> (Int -> ReadS b) -> ReadS [b] -> ReadS [f a b]
liftReadList2  Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
rp2 ReadS [b]
rl2) Int
0 String
s3
    (String
"}",         String
s5) <- ReadS String
lex String
s4
    (Tannen f p a b, String) -> [(Tannen f p a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (f (p a b) -> Tannen f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen f (p a b)
x, String
s5)

instance (Show1 f, Show2 p, Show a) => Show1 (Tannen f p a) where
  liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Tannen f p a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Tannen f p a a
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
forall a. Show a => Int -> a -> ShowS
showsPrec [a] -> ShowS
forall a. Show a => [a] -> ShowS
showList
instance (Show1 f, Show2 p) => Show2 (Tannen f p) where
  liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Tannen f p a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 Int
p (Tannen f (p a b)
x) = Bool -> ShowS -> ShowS
showParen (Int
p Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10) (ShowS -> ShowS) -> ShowS -> ShowS
forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"Tannen {runTannen = "
    ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Int -> p a b -> ShowS)
-> ([p a b] -> ShowS) -> Int -> f (p a b) -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> p a b
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2)
                    ((Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [p a b]
-> ShowS
forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> [f a b]
-> ShowS
liftShowList2  Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
sp2 [b] -> ShowS
sl2) Int
0 f (p a b)
x
    ShowS -> ShowS -> ShowS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Char -> ShowS
showChar Char
'}'
#endif

instance Functor f => BifunctorFunctor (Tannen f) where
  bifmap :: (p :-> q) -> Tannen f p :-> Tannen f q
bifmap p :-> q
f (Tannen f (p a b)
fp) = f (q a b) -> Tannen f q a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen ((p a b -> q a b) -> f (p a b) -> f (q a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p a b -> q a b
p :-> q
f f (p a b)
fp)

instance (Functor f, Monad f) => BifunctorMonad (Tannen f) where
  bireturn :: p a b -> Tannen f p a b
bireturn = f (p a b) -> Tannen f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p a b) -> Tannen f p a b)
-> (p a b -> f (p a b)) -> p a b -> Tannen f p a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p a b -> f (p a b)
forall (m :: * -> *) a. Monad m => a -> m a
return
  bibind :: (p :-> Tannen f q) -> Tannen f p :-> Tannen f q
bibind p :-> Tannen f q
f (Tannen f (p a b)
fp) = f (q a b) -> Tannen f q a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (q a b) -> Tannen f q a b) -> f (q a b) -> Tannen f q a b
forall a b. (a -> b) -> a -> b
$ f (p a b)
fp f (p a b) -> (p a b -> f (q a b)) -> f (q a b)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Tannen f q a b -> f (q a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen (Tannen f q a b -> f (q a b))
-> (p a b -> Tannen f q a b) -> p a b -> f (q a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. p a b -> Tannen f q a b
p :-> Tannen f q
f

instance Comonad f => BifunctorComonad (Tannen f) where
  biextract :: Tannen f p a b -> p a b
biextract = f (p a b) -> p a b
forall (w :: * -> *) a. Comonad w => w a -> a
extract (f (p a b) -> p a b)
-> (Tannen f p a b -> f (p a b)) -> Tannen f p a b -> p a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  biextend :: (Tannen f p :-> q) -> Tannen f p :-> Tannen f q
biextend Tannen f p :-> q
f (Tannen f (p a b)
fp) = f (q a b) -> Tannen f q a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen ((f (p a b) -> q a b) -> f (p a b) -> f (q a b)
forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Tannen f p a b -> q a b
Tannen f p :-> q
f (Tannen f p a b -> q a b)
-> (f (p a b) -> Tannen f p a b) -> f (p a b) -> q a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. f (p a b) -> Tannen f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen) f (p a b)
fp)

instance (Functor f, Bifunctor p) => Bifunctor (Tannen f p) where
  first :: (a -> b) -> Tannen f p a c -> Tannen f p b c
first a -> b
f = f (p b c) -> Tannen f p b c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p b c) -> Tannen f p b c)
-> (Tannen f p a c -> f (p b c))
-> Tannen f p a c
-> Tannen f p b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a c -> p b c) -> f (p a c) -> f (p b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> p a c -> p b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
B.first a -> b
f) (f (p a c) -> f (p b c))
-> (Tannen f p a c -> f (p a c)) -> Tannen f p a c -> f (p b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a c -> f (p a c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE first #-}
  second :: (b -> c) -> Tannen f p a b -> Tannen f p a c
second b -> c
f = f (p a c) -> Tannen f p a c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p a c) -> Tannen f p a c)
-> (Tannen f p a b -> f (p a c))
-> Tannen f p a b
-> Tannen f p a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> p a c) -> f (p a b) -> f (p a c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((b -> c) -> p a b -> p a c
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
B.second b -> c
f) (f (p a b) -> f (p a c))
-> (Tannen f p a b -> f (p a b)) -> Tannen f p a b -> f (p a c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE second #-}
  bimap :: (a -> b) -> (c -> d) -> Tannen f p a c -> Tannen f p b d
bimap a -> b
f c -> d
g = f (p b d) -> Tannen f p b d
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p b d) -> Tannen f p b d)
-> (Tannen f p a c -> f (p b d))
-> Tannen f p a c
-> Tannen f p b d
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a c -> p b d) -> f (p a c) -> f (p b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Bifunctor p =>
(a -> b) -> (c -> d) -> p a c -> p b d
bimap a -> b
f c -> d
g) (f (p a c) -> f (p b d))
-> (Tannen f p a c -> f (p a c)) -> Tannen f p a c -> f (p b d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a c -> f (p a c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE bimap #-}

instance (Functor f, Bifunctor p) => Functor (Tannen f p a) where
  fmap :: (a -> b) -> Tannen f p a a -> Tannen f p a b
fmap a -> b
f = f (p a b) -> Tannen f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p a b) -> Tannen f p a b)
-> (Tannen f p a a -> f (p a b))
-> Tannen f p a a
-> Tannen f p a b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a a -> p a b) -> f (p a a) -> f (p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((a -> b) -> p a a -> p a b
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
B.second a -> b
f) (f (p a a) -> f (p a b))
-> (Tannen f p a a -> f (p a a)) -> Tannen f p a a -> f (p a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a a -> f (p a a)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE fmap #-}

instance (Applicative f, Biapplicative p) => Biapplicative (Tannen f p) where
  bipure :: a -> b -> Tannen f p a b
bipure a
a b
b = f (p a b) -> Tannen f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (p a b -> f (p a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (a -> b -> p a b
forall (p :: * -> * -> *) a b. Biapplicative p => a -> b -> p a b
bipure a
a b
b))
  {-# INLINE bipure #-}

  Tannen f (p (a -> b) (c -> d))
fg <<*>> :: Tannen f p (a -> b) (c -> d) -> Tannen f p a c -> Tannen f p b d
<<*>> Tannen f (p a c)
xy = f (p b d) -> Tannen f p b d
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (p (a -> b) (c -> d) -> p a c -> p b d
forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> p a c -> p b d
(<<*>>) (p (a -> b) (c -> d) -> p a c -> p b d)
-> f (p (a -> b) (c -> d)) -> f (p a c -> p b d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f (p (a -> b) (c -> d))
fg f (p a c -> p b d) -> f (p a c) -> f (p b d)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f (p a c)
xy)
  {-# INLINE (<<*>>) #-}

instance (Foldable f, Bifoldable p) => Foldable (Tannen f p a) where
  foldMap :: (a -> m) -> Tannen f p a a -> m
foldMap a -> m
f = (p a a -> m) -> f (p a a) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (a -> m) -> p a a -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (m -> a -> m
forall a b. a -> b -> a
const m
forall a. Monoid a => a
mempty) a -> m
f) (f (p a a) -> m)
-> (Tannen f p a a -> f (p a a)) -> Tannen f p a a -> m
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a a -> f (p a a)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE foldMap #-}

instance (Foldable f, Bifoldable p) => Bifoldable (Tannen f p) where
  bifoldMap :: (a -> m) -> (b -> m) -> Tannen f p a b -> m
bifoldMap a -> m
f b -> m
g = (p a b -> m) -> f (p a b) -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap ((a -> m) -> (b -> m) -> p a b -> m
forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) (f (p a b) -> m)
-> (Tannen f p a b -> f (p a b)) -> Tannen f p a b -> m
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE bifoldMap #-}

instance (Traversable f, Bitraversable p) => Traversable (Tannen f p a) where
  traverse :: (a -> f b) -> Tannen f p a a -> f (Tannen f p a b)
traverse a -> f b
f = (f (p a b) -> Tannen f p a b)
-> f (f (p a b)) -> f (Tannen f p a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (p a b) -> Tannen f p a b
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (f (p a b)) -> f (Tannen f p a b))
-> (Tannen f p a a -> f (f (p a b)))
-> Tannen f p a a
-> f (Tannen f p a b)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a a -> f (p a b)) -> f (p a a) -> f (f (p a b))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f a) -> (a -> f b) -> p a a -> f (p a b)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> f b
f) (f (p a a) -> f (f (p a b)))
-> (Tannen f p a a -> f (p a a)) -> Tannen f p a a -> f (f (p a b))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a a -> f (p a a)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE traverse #-}

instance (Traversable f, Bitraversable p) => Bitraversable (Tannen f p) where
  bitraverse :: (a -> f c) -> (b -> f d) -> Tannen f p a b -> f (Tannen f p c d)
bitraverse a -> f c
f b -> f d
g = (f (p c d) -> Tannen f p c d)
-> f (f (p c d)) -> f (Tannen f p c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f (p c d) -> Tannen f p c d
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (f (p c d)) -> f (Tannen f p c d))
-> (Tannen f p a b -> f (f (p c d)))
-> Tannen f p a b
-> f (Tannen f p c d)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p a b -> f (p c d)) -> f (p a b) -> f (f (p c d))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((a -> f c) -> (b -> f d) -> p a b -> f (p c d)
forall (t :: * -> * -> *) (f :: * -> *) a c b d.
(Bitraversable t, Applicative f) =>
(a -> f c) -> (b -> f d) -> t a b -> f (t c d)
bitraverse a -> f c
f b -> f d
g) (f (p a b) -> f (f (p c d)))
-> (Tannen f p a b -> f (p a b)) -> Tannen f p a b -> f (f (p c d))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p a b -> f (p a b)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE bitraverse #-}

instance (Applicative f, Category p) => Category (Tannen f p) where
  id :: Tannen f p a a
id = f (p a a) -> Tannen f p a a
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p a a) -> Tannen f p a a) -> f (p a a) -> Tannen f p a a
forall a b. (a -> b) -> a -> b
$ p a a -> f (p a a)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p a a
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Tannen f (p b c)
fpbc . :: Tannen f p b c -> Tannen f p a b -> Tannen f p a c
. Tannen f (p a b)
fpab = f (p a c) -> Tannen f p a c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p a c) -> Tannen f p a c) -> f (p a c) -> Tannen f p a c
forall a b. (a -> b) -> a -> b
$ (p b c -> p a b -> p a c) -> f (p b c) -> f (p a b) -> f (p a c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p a b -> p a c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
(.) f (p b c)
fpbc f (p a b)
fpab

instance (Applicative f, Arrow p) => Arrow (Tannen f p) where
  arr :: (b -> c) -> Tannen f p b c
arr b -> c
f = f (p b c) -> Tannen f p b c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p b c) -> Tannen f p b c) -> f (p b c) -> Tannen f p b c
forall a b. (a -> b) -> a -> b
$ p b c -> f (p b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (p b c -> f (p b c)) -> p b c -> f (p b c)
forall a b. (a -> b) -> a -> b
$ (b -> c) -> p b c
forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f
  first :: Tannen f p b c -> Tannen f p (b, d) (c, d)
first = f (p (b, d) (c, d)) -> Tannen f p (b, d) (c, d)
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (b, d) (c, d)) -> Tannen f p (b, d) (c, d))
-> (Tannen f p b c -> f (p (b, d) (c, d)))
-> Tannen f p b c
-> Tannen f p (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
. (p b c -> p (b, d) (c, d)) -> f (p b c) -> f (p (b, d) (c, d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (b, d) (c, d)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first (f (p b c) -> f (p (b, d) (c, d)))
-> (Tannen f p b c -> f (p b c))
-> Tannen f p b c
-> f (p (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
. Tannen f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  second :: Tannen f p b c -> Tannen f p (d, b) (d, c)
second = f (p (d, b) (d, c)) -> Tannen f p (d, b) (d, c)
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (d, b) (d, c)) -> Tannen f p (d, b) (d, c))
-> (Tannen f p b c -> f (p (d, b) (d, c)))
-> Tannen f p b c
-> Tannen f p (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
. (p b c -> p (d, b) (d, c)) -> f (p b c) -> f (p (d, b) (d, c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (d, b) (d, c)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second (f (p b c) -> f (p (d, b) (d, c)))
-> (Tannen f p b c -> f (p b c))
-> Tannen f p b c
-> f (p (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
. Tannen f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  Tannen f (p b c)
ab *** :: Tannen f p b c -> Tannen f p b' c' -> Tannen f p (b, b') (c, c')
*** Tannen f (p b' c')
cd = f (p (b, b') (c, c')) -> Tannen f p (b, b') (c, c')
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (b, b') (c, c')) -> Tannen f p (b, b') (c, c'))
-> f (p (b, b') (c, c')) -> Tannen f p (b, b') (c, c')
forall a b. (a -> b) -> a -> b
$ (p b c -> p b' c' -> p (b, b') (c, c'))
-> f (p b c) -> f (p b' c') -> f (p (b, b') (c, c'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b' c' -> p (b, b') (c, c')
forall (a :: * -> * -> *) b c b' c'.
Arrow a =>
a b c -> a b' c' -> a (b, b') (c, c')
(***) f (p b c)
ab f (p b' c')
cd
  Tannen f (p b c)
ab &&& :: Tannen f p b c -> Tannen f p b c' -> Tannen f p b (c, c')
&&& Tannen f (p b c')
ac = f (p b (c, c')) -> Tannen f p b (c, c')
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p b (c, c')) -> Tannen f p b (c, c'))
-> f (p b (c, c')) -> Tannen f p b (c, c')
forall a b. (a -> b) -> a -> b
$ (p b c -> p b c' -> p b (c, c'))
-> f (p b c) -> f (p b c') -> f (p b (c, c'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b c' -> p b (c, c')
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
(&&&) f (p b c)
ab f (p b c')
ac

instance (Applicative f, ArrowChoice p) => ArrowChoice (Tannen f p) where
  left :: Tannen f p b c -> Tannen f p (Either b d) (Either c d)
left  = f (p (Either b d) (Either c d))
-> Tannen f p (Either b d) (Either c d)
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (Either b d) (Either c d))
 -> Tannen f p (Either b d) (Either c d))
-> (Tannen f p b c -> f (p (Either b d) (Either c d)))
-> Tannen f p b c
-> Tannen f p (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
. (p b c -> p (Either b d) (Either c d))
-> f (p b c) -> f (p (Either b d) (Either c d))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (Either b d) (Either c d)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left (f (p b c) -> f (p (Either b d) (Either c d)))
-> (Tannen f p b c -> f (p b c))
-> Tannen f p b c
-> f (p (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
. Tannen f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  right :: Tannen f p b c -> Tannen f p (Either d b) (Either d c)
right = f (p (Either d b) (Either d c))
-> Tannen f p (Either d b) (Either d c)
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (Either d b) (Either d c))
 -> Tannen f p (Either d b) (Either d c))
-> (Tannen f p b c -> f (p (Either d b) (Either d c)))
-> Tannen f p b c
-> Tannen f p (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
. (p b c -> p (Either d b) (Either d c))
-> f (p b c) -> f (p (Either d b) (Either d c))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p b c -> p (Either d b) (Either d c)
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right (f (p b c) -> f (p (Either d b) (Either d c)))
-> (Tannen f p b c -> f (p b c))
-> Tannen f p b c
-> f (p (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
. Tannen f p b c -> f (p b c)
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  Tannen f (p b c)
ab +++ :: Tannen f p b c
-> Tannen f p b' c' -> Tannen f p (Either b b') (Either c c')
+++ Tannen f (p b' c')
cd = f (p (Either b b') (Either c c'))
-> Tannen f p (Either b b') (Either c c')
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (Either b b') (Either c c'))
 -> Tannen f p (Either b b') (Either c c'))
-> f (p (Either b b') (Either c c'))
-> Tannen f p (Either b b') (Either c c')
forall a b. (a -> b) -> a -> b
$ (p b c -> p b' c' -> p (Either b b') (Either c c'))
-> f (p b c) -> f (p b' c') -> f (p (Either b b') (Either c c'))
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b' c' -> p (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')
(+++) f (p b c)
ab f (p b' c')
cd
  Tannen f (p b d)
ac ||| :: Tannen f p b d -> Tannen f p c d -> Tannen f p (Either b c) d
||| Tannen f (p c d)
bc = f (p (Either b c) d) -> Tannen f p (Either b c) d
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p (Either b c) d) -> Tannen f p (Either b c) d)
-> f (p (Either b c) d) -> Tannen f p (Either b c) d
forall a b. (a -> b) -> a -> b
$ (p b d -> p c d -> p (Either b c) d)
-> f (p b d) -> f (p c d) -> f (p (Either b c) d)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b d -> p c d -> p (Either b c) d
forall (a :: * -> * -> *) b d c.
ArrowChoice a =>
a b d -> a c d -> a (Either b c) d
(|||) f (p b d)
ac f (p c d)
bc

instance (Applicative f, ArrowLoop p) => ArrowLoop (Tannen f p) where
  loop :: Tannen f p (b, d) (c, d) -> Tannen f p b c
loop = f (p b c) -> Tannen f p b c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p b c) -> Tannen f p b c)
-> (Tannen f p (b, d) (c, d) -> f (p b c))
-> Tannen f p (b, d) (c, d)
-> Tannen f p b c
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (p (b, d) (c, d) -> p b c) -> f (p (b, d) (c, d)) -> f (p b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p (b, d) (c, d) -> p b c
forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop (f (p (b, d) (c, d)) -> f (p b c))
-> (Tannen f p (b, d) (c, d) -> f (p (b, d) (c, d)))
-> Tannen f p (b, d) (c, d)
-> f (p b c)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Tannen f p (b, d) (c, d) -> f (p (b, d) (c, d))
forall k (f :: k -> *) k k (p :: k -> k -> k) (a :: k) (b :: k).
Tannen f p a b -> f (p a b)
runTannen

instance (Applicative f, ArrowZero p) => ArrowZero (Tannen f p) where
  zeroArrow :: Tannen f p b c
zeroArrow = f (p b c) -> Tannen f p b c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen (f (p b c) -> Tannen f p b c) -> f (p b c) -> Tannen f p b c
forall a b. (a -> b) -> a -> b
$ p b c -> f (p b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure p b c
forall (a :: * -> * -> *) b c. ArrowZero a => a b c
zeroArrow

instance (Applicative f, ArrowPlus p) => ArrowPlus (Tannen f p) where
  Tannen f (p b c)
f <+> :: Tannen f p b c -> Tannen f p b c -> Tannen f p b c
<+> Tannen f (p b c)
g = f (p b c) -> Tannen f p b c
forall k k k (f :: k -> *) (p :: k -> k -> k) (a :: k) (b :: k).
f (p a b) -> Tannen f p a b
Tannen ((p b c -> p b c -> p b c) -> f (p b c) -> f (p b c) -> f (p b c)
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 p b c -> p b c -> p b c
forall (a :: * -> * -> *) b c.
ArrowPlus a =>
a b c -> a b c -> a b c
(<+>) f (p b c)
f f (p b c)
g)