{-# 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.Joker
( Joker(..)
) 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.Traversable
#endif
#if __GLASGOW_HASKELL__ >= 708
import Data.Typeable
#endif
#if __GLASGOW_HASKELL__ >= 702
import GHC.Generics
#endif
newtype Joker g a b = Joker { forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker :: g b }
deriving ( Joker g a b -> Joker g a b -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (g :: k -> *) k (a :: k) (b :: k).
Eq (g b) =>
Joker g a b -> Joker g a b -> Bool
/= :: Joker g a b -> Joker g a b -> Bool
$c/= :: forall k (g :: k -> *) k (a :: k) (b :: k).
Eq (g b) =>
Joker g a b -> Joker g a b -> Bool
== :: Joker g a b -> Joker g a b -> Bool
$c== :: forall k (g :: k -> *) k (a :: k) (b :: k).
Eq (g b) =>
Joker g a b -> Joker g a b -> Bool
Eq, Joker g a b -> Joker g a b -> Bool
Joker g a b -> Joker g a b -> Ordering
Joker g a b -> Joker g a b -> Joker g 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} {g :: k -> *} {k} {a :: k} {b :: k}.
Ord (g b) =>
Eq (Joker g a b)
forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Bool
forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Ordering
forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Joker g a b
min :: Joker g a b -> Joker g a b -> Joker g a b
$cmin :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Joker g a b
max :: Joker g a b -> Joker g a b -> Joker g a b
$cmax :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Joker g a b
>= :: Joker g a b -> Joker g a b -> Bool
$c>= :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Bool
> :: Joker g a b -> Joker g a b -> Bool
$c> :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Bool
<= :: Joker g a b -> Joker g a b -> Bool
$c<= :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Bool
< :: Joker g a b -> Joker g a b -> Bool
$c< :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Bool
compare :: Joker g a b -> Joker g a b -> Ordering
$ccompare :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Joker g a b -> Joker g a b -> Ordering
Ord, Int -> Joker g a b -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (g :: k -> *) k (a :: k) (b :: k).
Show (g b) =>
Int -> Joker g a b -> ShowS
forall k (g :: k -> *) k (a :: k) (b :: k).
Show (g b) =>
[Joker g a b] -> ShowS
forall k (g :: k -> *) k (a :: k) (b :: k).
Show (g b) =>
Joker g a b -> String
showList :: [Joker g a b] -> ShowS
$cshowList :: forall k (g :: k -> *) k (a :: k) (b :: k).
Show (g b) =>
[Joker g a b] -> ShowS
show :: Joker g a b -> String
$cshow :: forall k (g :: k -> *) k (a :: k) (b :: k).
Show (g b) =>
Joker g a b -> String
showsPrec :: Int -> Joker g a b -> ShowS
$cshowsPrec :: forall k (g :: k -> *) k (a :: k) (b :: k).
Show (g b) =>
Int -> Joker g a b -> ShowS
Show, ReadPrec [Joker g a b]
ReadPrec (Joker g a b)
ReadS [Joker g a b]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
ReadPrec [Joker g a b]
forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
ReadPrec (Joker g a b)
forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
Int -> ReadS (Joker g a b)
forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
ReadS [Joker g a b]
readListPrec :: ReadPrec [Joker g a b]
$creadListPrec :: forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
ReadPrec [Joker g a b]
readPrec :: ReadPrec (Joker g a b)
$creadPrec :: forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
ReadPrec (Joker g a b)
readList :: ReadS [Joker g a b]
$creadList :: forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
ReadS [Joker g a b]
readsPrec :: Int -> ReadS (Joker g a b)
$creadsPrec :: forall k (g :: k -> *) k (a :: k) (b :: k).
Read (g b) =>
Int -> ReadS (Joker g 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 (g :: k -> *) k (a :: k) (b :: k) x.
Rep (Joker g a b) x -> Joker g a b
forall k (g :: k -> *) k (a :: k) (b :: k) x.
Joker g a b -> Rep (Joker g a b) x
$cto :: forall k (g :: k -> *) k (a :: k) (b :: k) x.
Rep (Joker g a b) x -> Joker g a b
$cfrom :: forall k (g :: k -> *) k (a :: k) (b :: k) x.
Joker g a b -> Rep (Joker g a b) x
Generic
#endif
#if __GLASGOW_HASKELL__ >= 708
, forall k (f :: k -> *).
(forall (a :: k). f a -> Rep1 f a)
-> (forall (a :: k). Rep1 f a -> f a) -> Generic1 f
forall k (g :: k -> *) k (a :: k) (a :: k).
Rep1 (Joker g a) a -> Joker g a a
forall k (g :: k -> *) k (a :: k) (a :: k).
Joker g a a -> Rep1 (Joker g a) a
$cto1 :: forall k (g :: k -> *) k (a :: k) (a :: k).
Rep1 (Joker g a) a -> Joker g a a
$cfrom1 :: forall k (g :: k -> *) k (a :: k) (a :: k).
Joker g a a -> Rep1 (Joker g a) a
Generic1
, Typeable
#endif
)
#if __GLASGOW_HASKELL__ >= 702 && __GLASGOW_HASKELL__ < 708
data JokerMetaData
data JokerMetaCons
data JokerMetaSel
instance Datatype JokerMetaData where
datatypeName _ = "Joker"
moduleName _ = "Data.Bifunctor.Joker"
instance Constructor JokerMetaCons where
conName _ = "Joker"
conIsRecord _ = True
instance Selector JokerMetaSel where
selName _ = "runJoker"
instance Generic1 (Joker g a) where
type Rep1 (Joker g a) = D1 JokerMetaData (C1 JokerMetaCons
(S1 JokerMetaSel (Rec1 g)))
from1 = M1 . M1 . M1 . Rec1 . runJoker
to1 = Joker . unRec1 . unM1 . unM1 . unM1
#endif
#if LIFTED_FUNCTOR_CLASSES
instance Eq1 g => Eq1 (Joker g a) where
liftEq :: forall a b. (a -> b -> Bool) -> Joker g a a -> Joker g a b -> Bool
liftEq a -> b -> Bool
g = forall {k} {k} {k} (g :: k -> *) (b1 :: k) (b2 :: k) (a1 :: k)
(a2 :: k).
(g b1 -> g b2 -> Bool) -> Joker g a1 b1 -> Joker g a2 b2 -> Bool
eqJoker (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq a -> b -> Bool
g)
instance Eq1 g => Eq2 (Joker g) where
liftEq2 :: forall a b c d.
(a -> b -> Bool)
-> (c -> d -> Bool) -> Joker g a c -> Joker g b d -> Bool
liftEq2 a -> b -> Bool
_ c -> d -> Bool
g = forall {k} {k} {k} (g :: k -> *) (b1 :: k) (b2 :: k) (a1 :: k)
(a2 :: k).
(g b1 -> g b2 -> Bool) -> Joker g a1 b1 -> Joker g a2 b2 -> Bool
eqJoker (forall (f :: * -> *) a b.
Eq1 f =>
(a -> b -> Bool) -> f a -> f b -> Bool
liftEq c -> d -> Bool
g)
instance Ord1 g => Ord1 (Joker g a) where
liftCompare :: forall a b.
(a -> b -> Ordering) -> Joker g a a -> Joker g a b -> Ordering
liftCompare a -> b -> Ordering
g = forall {k} {k} {k} (g :: k -> *) (b1 :: k) (b2 :: k) (a1 :: k)
(a2 :: k).
(g b1 -> g b2 -> Ordering)
-> Joker g a1 b1 -> Joker g a2 b2 -> Ordering
compareJoker (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare a -> b -> Ordering
g)
instance Ord1 g => Ord2 (Joker g) where
liftCompare2 :: forall a b c d.
(a -> b -> Ordering)
-> (c -> d -> Ordering) -> Joker g a c -> Joker g b d -> Ordering
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
g = forall {k} {k} {k} (g :: k -> *) (b1 :: k) (b2 :: k) (a1 :: k)
(a2 :: k).
(g b1 -> g b2 -> Ordering)
-> Joker g a1 b1 -> Joker g a2 b2 -> Ordering
compareJoker (forall (f :: * -> *) a b.
Ord1 f =>
(a -> b -> Ordering) -> f a -> f b -> Ordering
liftCompare c -> d -> Ordering
g)
instance Read1 g => Read1 (Joker g a) where
liftReadsPrec :: forall a.
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Joker g a a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = forall {k} {k} (g :: k -> *) (b :: k) (a :: k).
(Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
readsPrecJoker (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl)
instance Read1 g => Read2 (Joker g) where
liftReadsPrec2 :: forall a b.
(Int -> ReadS a)
-> ReadS [a]
-> (Int -> ReadS b)
-> ReadS [b]
-> Int
-> ReadS (Joker g a b)
liftReadsPrec2 Int -> ReadS a
_ ReadS [a]
_ Int -> ReadS b
rp2 ReadS [b]
rl2 = forall {k} {k} (g :: k -> *) (b :: k) (a :: k).
(Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
readsPrecJoker (forall (f :: * -> *) a.
Read1 f =>
(Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (f a)
liftReadsPrec Int -> ReadS b
rp2 ReadS [b]
rl2)
instance Show1 g => Show1 (Joker g a) where
liftShowsPrec :: forall a.
(Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Joker g a a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = forall {k} {k} (g :: k -> *) (b :: k) (a :: k).
(Int -> g b -> ShowS) -> Int -> Joker g a b -> ShowS
showsPrecJoker (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl)
instance Show1 g => Show2 (Joker g) where
liftShowsPrec2 :: forall a b.
(Int -> a -> ShowS)
-> ([a] -> ShowS)
-> (Int -> b -> ShowS)
-> ([b] -> ShowS)
-> Int
-> Joker g a b
-> ShowS
liftShowsPrec2 Int -> a -> ShowS
_ [a] -> ShowS
_ Int -> b -> ShowS
sp2 [b] -> ShowS
sl2 = forall {k} {k} (g :: k -> *) (b :: k) (a :: k).
(Int -> g b -> ShowS) -> Int -> Joker g a b -> ShowS
showsPrecJoker (forall (f :: * -> *) a.
Show1 f =>
(Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> f a -> ShowS
liftShowsPrec Int -> b -> ShowS
sp2 [b] -> ShowS
sl2)
#else
instance Eq1 g => Eq1 (Joker g a) where
eq1 = eqJoker eq1
instance Ord1 g => Ord1 (Joker g a) where
compare1 = compareJoker compare1
instance Read1 g => Read1 (Joker g a) where
readsPrec1 = readsPrecJoker readsPrec1
instance Show1 g => Show1 (Joker g a) where
showsPrec1 = showsPrecJoker showsPrec1
#endif
eqJoker :: (g b1 -> g b2 -> Bool)
-> Joker g a1 b1 -> Joker g a2 b2 -> Bool
eqJoker :: forall {k} {k} {k} (g :: k -> *) (b1 :: k) (b2 :: k) (a1 :: k)
(a2 :: k).
(g b1 -> g b2 -> Bool) -> Joker g a1 b1 -> Joker g a2 b2 -> Bool
eqJoker g b1 -> g b2 -> Bool
eqB (Joker g b1
x) (Joker g b2
y) = g b1 -> g b2 -> Bool
eqB g b1
x g b2
y
compareJoker :: (g b1 -> g b2 -> Ordering)
-> Joker g a1 b1 -> Joker g a2 b2 -> Ordering
compareJoker :: forall {k} {k} {k} (g :: k -> *) (b1 :: k) (b2 :: k) (a1 :: k)
(a2 :: k).
(g b1 -> g b2 -> Ordering)
-> Joker g a1 b1 -> Joker g a2 b2 -> Ordering
compareJoker g b1 -> g b2 -> Ordering
compareB (Joker g b1
x) (Joker g b2
y) = g b1 -> g b2 -> Ordering
compareB g b1
x g b2
y
readsPrecJoker :: (Int -> ReadS (g b))
-> Int -> ReadS (Joker g a b)
readsPrecJoker :: forall {k} {k} (g :: k -> *) (b :: k) (a :: k).
(Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
readsPrecJoker Int -> ReadS (g b)
rpB 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
"Joker", String
s1) <- ReadS String
lex String
s0
(String
"{", String
s2) <- ReadS String
lex String
s1
(String
"runJoker", String
s3) <- ReadS String
lex String
s2
(g b
x, String
s4) <- Int -> ReadS (g b)
rpB Int
0 String
s3
(String
"}", String
s5) <- ReadS String
lex String
s4
forall (m :: * -> *) a. Monad m => a -> m a
return (forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker g b
x, String
s5)
showsPrecJoker :: (Int -> g b -> ShowS)
-> Int -> Joker g a b -> ShowS
showsPrecJoker :: forall {k} {k} (g :: k -> *) (b :: k) (a :: k).
(Int -> g b -> ShowS) -> Int -> Joker g a b -> ShowS
showsPrecJoker Int -> g b -> ShowS
spB Int
p (Joker g 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
"Joker {runJoker = "
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g b -> ShowS
spB Int
0 g b
x
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'
instance Functor g => Bifunctor (Joker g) where
first :: forall a b c. (a -> b) -> Joker g a c -> Joker g b c
first a -> b
_ = forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE first #-}
second :: forall b c a. (b -> c) -> Joker g a b -> Joker g a c
second b -> c
g = forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE second #-}
bimap :: forall a b c d. (a -> b) -> (c -> d) -> Joker g a c -> Joker g b d
bimap a -> b
_ c -> d
g = forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE bimap #-}
instance Functor g => Functor (Joker g a) where
fmap :: forall a b. (a -> b) -> Joker g a a -> Joker g a b
fmap a -> b
g = forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE fmap #-}
instance Applicative g => Biapplicative (Joker g) where
bipure :: forall a b. a -> b -> Joker g a b
bipure a
_ b
b = forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b)
{-# INLINE bipure #-}
Joker g (c -> d)
mf <<*>> :: forall a b c d.
Joker g (a -> b) (c -> d) -> Joker g a c -> Joker g b d
<<*>> Joker g c
mx = forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (g (c -> d)
mf forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> g c
mx)
{-# INLINE (<<*>>) #-}
instance Foldable g => Bifoldable (Joker g) where
bifoldMap :: forall m a b. Monoid m => (a -> m) -> (b -> m) -> Joker g a b -> m
bifoldMap a -> m
_ b -> m
g = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE bifoldMap #-}
instance Foldable g => Foldable (Joker g a) where
foldMap :: forall m a. Monoid m => (a -> m) -> Joker g a a -> m
foldMap a -> m
g = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE foldMap #-}
instance Traversable g => Bitraversable (Joker g) where
bitraverse :: forall (f :: * -> *) a c b d.
Applicative f =>
(a -> f c) -> (b -> f d) -> Joker g a b -> f (Joker g c d)
bitraverse a -> f c
_ b -> f d
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE bitraverse #-}
instance Traversable g => Traversable (Joker g a) where
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Joker g a a -> f (Joker g a b)
traverse a -> f b
g = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall {k} {k} (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall {k} {k} (g :: k -> *) (a :: k) (b :: k). Joker g a b -> g b
runJoker
{-# INLINE traverse #-}