{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE EmptyDataDecls #-}
{-# LANGUAGE TypeFamilies #-}
#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"
module Data.Bifunctor.Clown
( Clown(..)
) where
#if __GLASGOW_HASKELL__ < 710
import Control.Applicative
#endif
import Data.Biapplicative
import Data.Bifoldable
import Data.Bitraversable
import Data.Functor.Classes
#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
newtype Clown f a b = Clown { Clown f a b -> f a
runClown :: f a }
deriving ( Clown f a b -> Clown f a b -> Bool
(Clown f a b -> Clown f a b -> Bool)
-> (Clown f a b -> Clown f a b -> Bool) -> Eq (Clown f a b)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k) k (b :: k).
Eq (f a) =>
Clown f a b -> Clown f a b -> Bool
/= :: Clown f a b -> Clown f a b -> Bool
$c/= :: forall k (f :: k -> *) (a :: k) k (b :: k).
Eq (f a) =>
Clown f a b -> Clown f a b -> Bool
== :: Clown f a b -> Clown f a b -> Bool
$c== :: forall k (f :: k -> *) (a :: k) k (b :: k).
Eq (f a) =>
Clown f a b -> Clown f a b -> Bool
Eq, Eq (Clown f a b)
Eq (Clown f a b)
-> (Clown f a b -> Clown f a b -> Ordering)
-> (Clown f a b -> Clown f a b -> Bool)
-> (Clown f a b -> Clown f a b -> Bool)
-> (Clown f a b -> Clown f a b -> Bool)
-> (Clown f a b -> Clown f a b -> Bool)
-> (Clown f a b -> Clown f a b -> Clown f a b)
-> (Clown f a b -> Clown f a b -> Clown f a b)
-> Ord (Clown f a b)
Clown f a b -> Clown f a b -> Bool
Clown f a b -> Clown f a b -> Ordering
Clown f a b -> Clown f a b -> Clown f 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 -> *) (a :: k) k (b :: k).
Ord (f a) =>
Eq (Clown f a b)
forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Bool
forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Ordering
forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Clown f a b
min :: Clown f a b -> Clown f a b -> Clown f a b
$cmin :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Clown f a b
max :: Clown f a b -> Clown f a b -> Clown f a b
$cmax :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Clown f a b
>= :: Clown f a b -> Clown f a b -> Bool
$c>= :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Bool
> :: Clown f a b -> Clown f a b -> Bool
$c> :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Bool
<= :: Clown f a b -> Clown f a b -> Bool
$c<= :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Bool
< :: Clown f a b -> Clown f a b -> Bool
$c< :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Bool
compare :: Clown f a b -> Clown f a b -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Clown f a b -> Clown f a b -> Ordering
$cp1Ord :: forall k (f :: k -> *) (a :: k) k (b :: k).
Ord (f a) =>
Eq (Clown f a b)
Ord, Int -> Clown f a b -> ShowS
[Clown f a b] -> ShowS
Clown f a b -> String
(Int -> Clown f a b -> ShowS)
-> (Clown f a b -> String)
-> ([Clown f a b] -> ShowS)
-> Show (Clown f a b)
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (a :: k) k (b :: k).
Show (f a) =>
Int -> Clown f a b -> ShowS
forall k (f :: k -> *) (a :: k) k (b :: k).
Show (f a) =>
[Clown f a b] -> ShowS
forall k (f :: k -> *) (a :: k) k (b :: k).
Show (f a) =>
Clown f a b -> String
showList :: [Clown f a b] -> ShowS
$cshowList :: forall k (f :: k -> *) (a :: k) k (b :: k).
Show (f a) =>
[Clown f a b] -> ShowS
show :: Clown f a b -> String
$cshow :: forall k (f :: k -> *) (a :: k) k (b :: k).
Show (f a) =>
Clown f a b -> String
showsPrec :: Int -> Clown f a b -> ShowS
$cshowsPrec :: forall k (f :: k -> *) (a :: k) k (b :: k).
Show (f a) =>
Int -> Clown f a b -> ShowS
Show, ReadPrec [Clown f a b]
ReadPrec (Clown f a b)
Int -> ReadS (Clown f a b)
ReadS [Clown f a b]
(Int -> ReadS (Clown f a b))
-> ReadS [Clown f a b]
-> ReadPrec (Clown f a b)
-> ReadPrec [Clown f a b]
-> Read (Clown f a b)
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
ReadPrec [Clown f a b]
forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
ReadPrec (Clown f a b)
forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
Int -> ReadS (Clown f a b)
forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
ReadS [Clown f a b]
readListPrec :: ReadPrec [Clown f a b]
$creadListPrec :: forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
ReadPrec [Clown f a b]
readPrec :: ReadPrec (Clown f a b)
$creadPrec :: forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
ReadPrec (Clown f a b)
readList :: ReadS [Clown f a b]
$creadList :: forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
ReadS [Clown f a b]
readsPrec :: Int -> ReadS (Clown f a b)
$creadsPrec :: forall k (f :: k -> *) (a :: k) k (b :: k).
Read (f a) =>
Int -> ReadS (Clown f a b)
Read
#if __GLASGOW_HASKELL__ >= 702
, (forall x. Clown f a b -> Rep (Clown f a b) x)
-> (forall x. Rep (Clown f a b) x -> Clown f a b)
-> Generic (Clown f a b)
forall x. Rep (Clown f a b) x -> Clown f a b
forall x. Clown f a b -> Rep (Clown f a b) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall k (f :: k -> *) (a :: k) k (b :: k) x.
Rep (Clown f a b) x -> Clown f a b
forall k (f :: k -> *) (a :: k) k (b :: k) x.
Clown f a b -> Rep (Clown f a b) x
$cto :: forall k (f :: k -> *) (a :: k) k (b :: k) x.
Rep (Clown f a b) x -> Clown f a b
$cfrom :: forall k (f :: k -> *) (a :: k) k (b :: k) x.
Clown f a b -> Rep (Clown f a b) x
Generic
#endif
#if __GLASGOW_HASKELL__ >= 708
, (forall (a :: k). Clown f a a -> Rep1 (Clown f a) a)
-> (forall (a :: k). Rep1 (Clown f a) a -> Clown f a a)
-> Generic1 (Clown f a)
forall (a :: k). Rep1 (Clown f a) a -> Clown f a a
forall (a :: k). Clown f a a -> Rep1 (Clown f a) a
forall k k (f :: k -> *) (a :: k) (a :: k).
Rep1 (Clown f a) a -> Clown f a a
forall k k (f :: k -> *) (a :: k) (a :: k).
Clown f a a -> Rep1 (Clown f a) a
forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
$cto1 :: forall k k (f :: k -> *) (a :: k) (a :: k).
Rep1 (Clown f a) a -> Clown f a a
$cfrom1 :: forall k k (f :: k -> *) (a :: k) (a :: k).
Clown f a a -> Rep1 (Clown f a) a
Generic1
, Typeable
#endif
)
#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 708
data ClownMetaData
data ClownMetaCons
data ClownMetaSel
instance Datatype ClownMetaData where
datatypeName _ = "Clown"
moduleName _ = "Data.Bifunctor.Clown"
instance Constructor ClownMetaCons where
conName _ = "Clown"
conIsRecord _ = True
instance Selector ClownMetaSel where
selName _ = "runClown"
instance Generic1 (Clown f a) where
type Rep1 (Clown f a) = D1 ClownMetaData (C1 ClownMetaCons
(S1 ClownMetaSel (Rec0 (f a))))
from1 = M1 . M1 . M1 . K1 . runClown
to1 = Clown . unK1 . unM1 . unM1 . unM1
#endif
#if LIFTED_FUNCTOR_CLASSES
instance (Eq1 f, Eq a) => Eq1 (Clown f a) where
liftEq :: (a -> b -> Bool) -> Clown f a a -> Clown f a b -> Bool
liftEq = (a -> a -> Bool)
-> (a -> b -> Bool) -> Clown f a a -> Clown f 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 (Clown f) where
liftEq2 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> Clown f a c -> Clown f b d -> Bool
liftEq2 a -> b -> Bool
f c -> d -> Bool
_ = (f a -> f b -> Bool) -> Clown f a c -> Clown f b d -> Bool
forall k k k (f :: k -> *) (a1 :: k) (a2 :: k) (b1 :: k) (b2 :: k).
(f a1 -> f a2 -> Bool) -> Clown f a1 b1 -> Clown f a2 b2 -> Bool
eqClown ((a -> b -> Bool) -> f a -> f b -> Bool
forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
f)
instance (Ord1 f, Ord a) => Ord1 (Clown f a) where
liftCompare :: (a -> b -> Ordering) -> Clown f a a -> Clown f a b -> Ordering
liftCompare = (a -> a -> Ordering)
-> (a -> b -> Ordering) -> Clown f a a -> Clown f 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 (Clown f) where
liftCompare2 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> Clown f a c -> Clown f b d -> Ordering
liftCompare2 a -> b -> Ordering
f c -> d -> Ordering
_ = (f a -> f b -> Ordering) -> Clown f a c -> Clown f b d -> Ordering
forall k k k (f :: k -> *) (a1 :: k) (a2 :: k) (b1 :: k) (b2 :: k).
(f a1 -> f a2 -> Ordering)
-> Clown f a1 b1 -> Clown f a2 b2 -> Ordering
compareClown ((a -> b -> Ordering) -> f a -> f b -> Ordering
forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
f)
instance (Read1 f, Read a) => Read1 (Clown f a) where
liftReadsPrec :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Clown f a a)
liftReadsPrec = (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS a)
-> ReadS [a]
-> Int
-> ReadS (Clown f 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 (Clown f) where
liftReadsPrec2 :: (Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Clown f a b)
liftReadsPrec2 Int -> ReadS a
rp1 ReadS [a]
rl1 Int -> ReadS b
_ ReadS [b]
_ = (Int -> ReadS (f a)) -> Int -> ReadS (Clown f a b)
forall k k (f :: k -> *) (a :: k) (b :: k).
(Int -> ReadS (f a)) -> Int -> ReadS (Clown f a b)
readsPrecClown ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp1 ReadS [a]
rl1)
instance (Show1 f, Show a) => Show1 (Clown f a) where
liftShowsPrec :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Clown f a a -> ShowS
liftShowsPrec = (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> Int
-> Clown f 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 (Clown f) where
liftShowsPrec2 :: (Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Clown f a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
sp1 [a] -> ShowS
sl1 Int -> b -> ShowS
_ [b] -> ShowS
_ = (Int -> f a -> ShowS) -> Int -> Clown f a b -> ShowS
forall k k (f :: k -> *) (a :: k) (b :: k).
(Int -> f a -> ShowS) -> Int -> Clown f a b -> ShowS
showsPrecClown ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp1 [a] -> ShowS
sl1)
#else
instance (Eq1 f, Eq a) => Eq1 (Clown f a) where
eq1 = eqClown eq1
instance (Ord1 f, Ord a) => Ord1 (Clown f a) where
compare1 = compareClown compare1
instance (Read1 f, Read a) => Read1 (Clown f a) where
readsPrec1 = readsPrecClown readsPrec1
instance (Show1 f, Show a) => Show1 (Clown f a) where
showsPrec1 = showsPrecClown showsPrec1
#endif
eqClown :: (f a1 -> f a2 -> Bool)
-> Clown f a1 b1 -> Clown f a2 b2 -> Bool
eqClown :: (f a1 -> f a2 -> Bool) -> Clown f a1 b1 -> Clown f a2 b2 -> Bool
eqClown f a1 -> f a2 -> Bool
eqA (Clown f a1
x) (Clown f a2
y) = f a1 -> f a2 -> Bool
eqA f a1
x f a2
y
compareClown :: (f a1 -> f a2 -> Ordering)
-> Clown f a1 b1 -> Clown f a2 b2 -> Ordering
compareClown :: (f a1 -> f a2 -> Ordering)
-> Clown f a1 b1 -> Clown f a2 b2 -> Ordering
compareClown f a1 -> f a2 -> Ordering
compareA (Clown f a1
x) (Clown f a2
y) = f a1 -> f a2 -> Ordering
compareA f a1
x f a2
y
readsPrecClown :: (Int -> ReadS (f a))
-> Int -> ReadS (Clown f a b)
readsPrecClown :: (Int -> ReadS (f a)) -> Int -> ReadS (Clown f a b)
readsPrecClown Int -> ReadS (f a)
rpA Int
p =
Bool -> ReadS (Clown f a b) -> ReadS (Clown f 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 (Clown f a b) -> ReadS (Clown f a b))
-> ReadS (Clown f a b) -> ReadS (Clown f a b)
forall a b. (a -> b) -> a -> b
$ \String
s0 -> do
(String
"Clown", String
s1) <- ReadS String
lex String
s0
(String
"{", String
s2) <- ReadS String
lex String
s1
(String
"runClown", String
s3) <- ReadS String
lex String
s2
(f a
x, String
s4) <- Int -> ReadS (f a)
rpA Int
0 String
s3
(String
"}", String
s5) <- ReadS String
lex String
s4
(Clown f a b, String) -> [(Clown f a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (f a -> Clown f a b
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown f a
x, String
s5)
showsPrecClown :: (Int -> f a -> ShowS)
-> Int -> Clown f a b -> ShowS
showsPrecClown :: (Int -> f a -> ShowS) -> Int -> Clown f a b -> ShowS
showsPrecClown Int -> f a -> ShowS
spA Int
p (Clown f a
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
"Clown {runClown = "
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> f a -> ShowS
spA Int
0 f a
x
ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
instance Functor f => Bifunctor (Clown f) where
first :: (a -> b) -> Clown f a c -> Clown f b c
first a -> b
f = f b -> Clown f b c
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f b -> Clown f b c)
-> (Clown f a c -> f b) -> Clown f a c -> Clown f b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (f a -> f b) -> (Clown f a c -> f a) -> Clown f a c -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a c -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE first #-}
second :: (b -> c) -> Clown f a b -> Clown f a c
second b -> c
_ = f a -> Clown f a c
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f a -> Clown f a c)
-> (Clown f a b -> f a) -> Clown f a b -> Clown f a c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a b -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE second #-}
bimap :: (a -> b) -> (c -> d) -> Clown f a c -> Clown f b d
bimap a -> b
f c -> d
_ = f b -> Clown f b d
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f b -> Clown f b d)
-> (Clown f a c -> f b) -> Clown f a c -> Clown f b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
f (f a -> f b) -> (Clown f a c -> f a) -> Clown f a c -> f b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a c -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE bimap #-}
instance Functor (Clown f a) where
fmap :: (a -> b) -> Clown f a a -> Clown f a b
fmap a -> b
_ = f a -> Clown f a b
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f a -> Clown f a b)
-> (Clown f a a -> f a) -> Clown f a a -> Clown f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a a -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE fmap #-}
instance Applicative f => Biapplicative (Clown f) where
bipure :: a -> b -> Clown f a b
bipure a
a b
_ = f a -> Clown f a b
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
a)
{-# INLINE bipure #-}
Clown f (a -> b)
mf <<*>> :: Clown f (a -> b) (c -> d) -> Clown f a c -> Clown f b d
<<*>> Clown f a
mx = f b -> Clown f b d
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f (a -> b)
mf f (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> f a
mx)
{-# INLINE (<<*>>) #-}
instance Foldable f => Bifoldable (Clown f) where
bifoldMap :: (a -> m) -> (b -> m) -> Clown f a b -> m
bifoldMap a -> m
f b -> m
_ = (a -> m) -> f a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
f (f a -> m) -> (Clown f a b -> f a) -> Clown f a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a b -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE bifoldMap #-}
instance Foldable (Clown f a) where
foldMap :: (a -> m) -> Clown f a a -> m
foldMap a -> m
_ = Clown f a a -> m
forall a. Monoid a => a
mempty
{-# INLINE foldMap #-}
instance Traversable f => Bitraversable (Clown f) where
bitraverse :: (a -> f c) -> (b -> f d) -> Clown f a b -> f (Clown f c d)
bitraverse a -> f c
f b -> f d
_ = (f c -> Clown f c d) -> f (f c) -> f (Clown f c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap f c -> Clown f c d
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f (f c) -> f (Clown f c d))
-> (Clown f a b -> f (f c)) -> Clown f a b -> f (Clown f c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f c) -> f a -> f (f c)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f c
f (f a -> f (f c)) -> (Clown f a b -> f a) -> Clown f a b -> f (f c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a b -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE bitraverse #-}
instance Traversable (Clown f a) where
traverse :: (a -> f b) -> Clown f a a -> f (Clown f a b)
traverse a -> f b
_ = Clown f a b -> f (Clown f a b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Clown f a b -> f (Clown f a b))
-> (Clown f a a -> Clown f a b) -> Clown f a a -> f (Clown f a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. f a -> Clown f a b
forall k k (f :: k -> *) (a :: k) (b :: k). f a -> Clown f a b
Clown (f a -> Clown f a b)
-> (Clown f a a -> f a) -> Clown f a a -> Clown f a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Clown f a a -> f a
forall k (f :: k -> *) (a :: k) k (b :: k). Clown f a b -> f a
runClown
{-# INLINE traverse #-}