{-# 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 { forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
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
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, 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
Ord, Int -> Tannen f p a b -> ShowS
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)
ReadS [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 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 :: forall a b.
(a -> b -> Bool) -> Tannen f p a a -> Tannen f p a b -> Bool
liftEq = forall (f :: * -> * -> *) a b c d.
Eq2 f =>
(a -> b -> Bool) -> (c -> d -> Bool) -> f a c -> f b d -> Bool
liftEq2 forall a. Eq a => a -> a -> Bool
(==)
instance (Eq1 f, Eq2 p) => Eq2 (Tannen f p) where
  liftEq2 :: forall a b c d.
(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) = forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq (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 :: forall a b.
(a -> b -> Ordering)
-> Tannen f p a a -> Tannen f p a b -> Ordering
liftCompare = forall (f :: * -> * -> *) a b c d.
Ord2 f =>
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> f a c -> f b d -> Ordering
liftCompare2 forall a. Ord a => a -> a -> Ordering
compare
instance (Ord1 f, Ord2 p) => Ord2 (Tannen f p) where
  liftCompare2 :: forall a b c d.
(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) = forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare (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 :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Tannen f p a a)
liftReadsPrec = forall (f :: * -> * -> *) a b.
Read2 f =>
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (f a b)
liftReadsPrec2 forall a. Read a => Int -> ReadS a
readsPrec forall a. Read a => ReadS [a]
readList
instance (Read1 f, Read2 p) => Read2 (Tannen f p) where
  liftReadsPrec2 :: forall a b.
(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 = forall a. Bool -> ReadS a -> ReadS a
readParen (Int
p forall a. Ord a => a -> a -> Bool
> Int
10) 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) <- forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec (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)
                                       (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
    forall (m :: * -> *) a. Monad m => a -> m a
return (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 :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Tannen f p a a -> ShowS
liftShowsPrec = forall (f :: * -> * -> *) a b.
Show2 f =>
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> f a b
-> ShowS
liftShowsPrec2 forall a. Show a => Int -> a -> ShowS
showsPrec forall a. Show a => [a] -> ShowS
showList
instance (Show1 f, Show2 p) => Show2 (Tannen f p) where
  liftShowsPrec2 :: forall a b.
(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 forall a. Ord a => a -> a -> Bool
> Int
10) forall a b. (a -> b) -> a -> b
$
      String -> ShowS
showString String
"Tannen {runTannen = "
    forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec (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)
                    (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
    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 :: forall (p :: k -> k -> *) (q :: k -> k -> *).
(p :-> q) -> Tannen f p :-> Tannen f q
bifmap p :-> q
f (Tannen f (p a b)
fp) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap p :-> q
f f (p a b)
fp)

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

instance Comonad f => BifunctorComonad (Tannen f) where
  biextract :: forall (p :: k -> k -> *). Tannen f p :-> p
biextract = forall (w :: * -> *) a. Comonad w => w a -> a
extract forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  biextend :: forall (p :: k -> k -> *) (q :: k -> k -> *).
(Tannen f p :-> q) -> Tannen f p :-> Tannen f q
biextend Tannen f p :-> q
f (Tannen f (p a b)
fp) = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen (forall (w :: * -> *) a b. Comonad w => (w a -> b) -> w a -> w b
extend (Tannen f p :-> q
f forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat 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 b)
fp)

instance (Functor f, Bifunctor p) => Bifunctor (Tannen f p) where
  first :: forall a b c. (a -> b) -> Tannen f p a c -> Tannen f p b c
first a -> b
f = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
B.first a -> b
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE first #-}
  second :: forall b c a. (b -> c) -> Tannen f p a b -> Tannen f p a c
second b -> c
f = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
B.second b -> c
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  {-# INLINE second #-}
  bimap :: forall a b c d.
(a -> b) -> (c -> d) -> Tannen f p a c -> Tannen f p b d
bimap a -> b
f c -> d
g = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (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) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall a b. (a -> b) -> Tannen f p a a -> Tannen f p a b
fmap a -> b
f = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
B.second a -> b
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall a b. a -> b -> Tannen f p a b
bipure a
a b
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 (forall (f :: * -> *) a. Applicative f => a -> f a
pure (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 <<*>> :: forall a b c d.
Tannen f p (a -> b) (c -> d) -> Tannen f p a c -> Tannen f p b d
<<*>> Tannen f (p a c)
xy = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen (forall (p :: * -> * -> *) a b c d.
Biapplicative p =>
p (a -> b) (c -> d) -> 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 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 :: forall m a. Monoid m => (a -> m) -> Tannen f p a a -> m
foldMap a -> m
f = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap (forall a b. a -> b -> a
const forall a. Monoid a => a
mempty) a -> m
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall m a b.
Monoid m =>
(a -> m) -> (b -> m) -> Tannen f p a b -> m
bifoldMap a -> m
f b -> m
g = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall (p :: * -> * -> *) m a b.
(Bifoldable p, Monoid m) =>
(a -> m) -> (b -> m) -> p a b -> m
bifoldMap a -> m
f b -> m
g) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Tannen f p a a -> f (Tannen f p a b)
traverse a -> f b
f = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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 forall (f :: * -> *) a. Applicative f => a -> f a
pure a -> f b
f) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall (f :: * -> *) a c b d.
Applicative f =>
(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 = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse (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) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall (a :: k). Tannen f p a a
id = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall {k} (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id
  Tannen f (p b c)
fpbc . :: forall (b :: k) (c :: k) (a :: k).
Tannen f p b c -> Tannen f p a b -> Tannen f p a c
. Tannen f (p a b)
fpab = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 :: forall b c. (b -> c) -> Tannen f p b c
arr b -> c
f = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall (a :: * -> * -> *) b c. Arrow a => (b -> c) -> a b c
arr b -> c
f
  first :: forall b c d. Tannen f p b c -> Tannen f p (b, d) (c, d)
first = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
A.first forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  second :: forall b c d. Tannen f p b c -> Tannen f p (d, b) (d, c)
second = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (d, b) (d, c)
A.second forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 *** :: forall b c b' c'.
Tannen f p b c -> Tannen f p b' c' -> Tannen f p (b, b') (c, c')
*** Tannen f (p b' c')
cd = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 &&& :: forall b c c'.
Tannen f p b c -> Tannen f p b c' -> Tannen f p b (c, c')
&&& Tannen f (p b c')
ac = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 :: forall b c d.
Tannen f p b c -> Tannen f p (Either b d) (Either c d)
left  = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
Tannen f p a b -> f (p a b)
runTannen
  right :: forall b c d.
Tannen f p b c -> Tannen f p (Either d b) (Either d c)
right = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either d b) (Either d c)
right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 +++ :: forall b c b' c'.
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 = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 ||| :: forall b d c.
Tannen f p b d -> Tannen f p c d -> Tannen f p (Either b c) d
||| Tannen f (p c d)
bc = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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 :: forall b d c. Tannen f p (b, d) (c, d) -> Tannen f p b c
loop = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall (a :: * -> * -> *) b d c.
ArrowLoop a =>
a (b, d) (c, d) -> a b c
loop forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall {k} {k} {k} (f :: 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 :: forall b c. Tannen f p b c
zeroArrow = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Applicative f => a -> f a
pure 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 <+> :: forall b c. Tannen f p b c -> Tannen f p b c -> Tannen f p b c
<+> Tannen f (p b c)
g = forall {k} {k} {k} (f :: k -> *) (p :: k -> k -> k) (a :: k)
       (b :: k).
f (p a b) -> Tannen f p a b
Tannen (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 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)