{-# 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"

-----------------------------------------------------------------------------
-- |
-- Copyright   :  (C) 2008-2016 Edward Kmett
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Edward Kmett <ekmett@gmail.com>
-- Stability   :  provisional
-- Portability :  portable
--
-- From the Functional Pearl \"Clowns to the Left of me, Jokers to the Right: Dissecting Data Structures\"
-- by Conor McBride.
----------------------------------------------------------------------------
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

-- | Make a 'Functor' over the second argument of a 'Bifunctor'.
--
-- Mnemonic: C__l__owns to the __l__eft (parameter of the Bifunctor),
--           joke__r__s to the __r__ight.
newtype Joker g a b = Joker { Joker g a b -> g b
runJoker :: g b }
  deriving ( Joker g a b -> Joker g a b -> Bool
(Joker g a b -> Joker g a b -> Bool)
-> (Joker g a b -> Joker g a b -> Bool) -> Eq (Joker g a b)
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, Eq (Joker g a b)
Eq (Joker g a b)
-> (Joker g a b -> Joker g a b -> Ordering)
-> (Joker g a b -> Joker g a b -> Bool)
-> (Joker g a b -> Joker g a b -> Bool)
-> (Joker g a b -> Joker g a b -> Bool)
-> (Joker g a b -> Joker g a b -> Bool)
-> (Joker g a b -> Joker g a b -> Joker g a b)
-> (Joker g a b -> Joker g a b -> Joker g a b)
-> Ord (Joker g a b)
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
$cp1Ord :: forall k (g :: k -> *) k (a :: k) (b :: k).
Ord (g b) =>
Eq (Joker g a b)
Ord, Int -> Joker g a b -> ShowS
[Joker g a b] -> ShowS
Joker g a b -> String
(Int -> Joker g a b -> ShowS)
-> (Joker g a b -> String)
-> ([Joker g a b] -> ShowS)
-> Show (Joker g a b)
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)
Int -> ReadS (Joker g a b)
ReadS [Joker g a b]
(Int -> ReadS (Joker g a b))
-> ReadS [Joker g a b]
-> ReadPrec (Joker g a b)
-> ReadPrec [Joker g a b]
-> Read (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 x. Joker g a b -> Rep (Joker g a b) x)
-> (forall x. Rep (Joker g a b) x -> Joker g a b)
-> Generic (Joker g a b)
forall x. Rep (Joker g a b) x -> Joker g a b
forall x. Joker g a b -> Rep (Joker g a b) x
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 (a :: k). Joker g a a -> Rep1 (Joker g a) a)
-> (forall (a :: k). Rep1 (Joker g a) a -> Joker g a a)
-> Generic1 (Joker g a)
forall (a :: k). Rep1 (Joker g a) a -> Joker g a a
forall (a :: k). Joker g a a -> Rep1 (Joker g a) a
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 :: (a -> b -> Bool) -> Joker g a a -> Joker g a b -> Bool
liftEq a -> b -> Bool
g = (g a -> g b -> Bool) -> Joker g a a -> Joker g a b -> Bool
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 ((a -> b -> Bool) -> g a -> g b -> Bool
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 :: (a -> b -> Bool)
-> (c -> d -> Bool) -> Joker g a c -> Joker g b d -> Bool
liftEq2 a -> b -> Bool
_ c -> d -> Bool
g = (g c -> g d -> Bool) -> Joker g a c -> Joker g b d -> Bool
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 ((c -> d -> Bool) -> g c -> g d -> Bool
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 :: (a -> b -> Ordering) -> Joker g a a -> Joker g a b -> Ordering
liftCompare a -> b -> Ordering
g = (g a -> g b -> Ordering) -> Joker g a a -> Joker g a b -> Ordering
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 ((a -> b -> Ordering) -> g a -> g b -> Ordering
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 :: (a -> b -> Ordering)
-> (c -> d -> Ordering) -> Joker g a c -> Joker g b d -> Ordering
liftCompare2 a -> b -> Ordering
_ c -> d -> Ordering
g = (g c -> g d -> Ordering) -> Joker g a c -> Joker g b d -> Ordering
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 ((c -> d -> Ordering) -> g c -> g d -> Ordering
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 :: (Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (Joker g a a)
liftReadsPrec Int -> ReadS a
rp ReadS [a]
rl = (Int -> ReadS (g a)) -> Int -> ReadS (Joker g a a)
forall k k (g :: k -> *) (b :: k) (a :: k).
(Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
readsPrecJoker ((Int -> ReadS a) -> ReadS [a] -> Int -> ReadS (g a)
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 :: (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 = (Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
forall k k (g :: k -> *) (b :: k) (a :: k).
(Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
readsPrecJoker ((Int -> ReadS b) -> ReadS [b] -> Int -> ReadS (g b)
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 :: (Int -> a -> ShowS)
-> ([a] -> ShowS) -> Int -> Joker g a a -> ShowS
liftShowsPrec Int -> a -> ShowS
sp [a] -> ShowS
sl = (Int -> g a -> ShowS) -> Int -> Joker g a a -> ShowS
forall k k (g :: k -> *) (b :: k) (a :: k).
(Int -> g b -> ShowS) -> Int -> Joker g a b -> ShowS
showsPrecJoker ((Int -> a -> ShowS) -> ([a] -> ShowS) -> Int -> g a -> ShowS
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 :: (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 = (Int -> g b -> ShowS) -> Int -> Joker g a b -> ShowS
forall k k (g :: k -> *) (b :: k) (a :: k).
(Int -> g b -> ShowS) -> Int -> Joker g a b -> ShowS
showsPrecJoker ((Int -> b -> ShowS) -> ([b] -> ShowS) -> Int -> g b -> ShowS
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 :: (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 :: (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 :: (Int -> ReadS (g b)) -> Int -> ReadS (Joker g a b)
readsPrecJoker Int -> ReadS (g b)
rpB Int
p =
  Bool -> ReadS (Joker g a b) -> ReadS (Joker g 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 (Joker g a b) -> ReadS (Joker g a b))
-> ReadS (Joker g a b) -> ReadS (Joker g a b)
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
    (Joker g a b, String) -> [(Joker g a b, String)]
forall (m :: * -> *) a. Monad m => a -> m a
return (g b -> Joker g a b
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 :: (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 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
"Joker {runJoker = "
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> g b -> ShowS
spB Int
0 g b
x
    ShowS -> ShowS -> ShowS
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ShowS
showChar Char
'}'

instance Functor g => Bifunctor (Joker g) where
  first :: (a -> b) -> Joker g a c -> Joker g b c
first a -> b
_ = g c -> Joker g b c
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (g c -> Joker g b c)
-> (Joker g a c -> g c) -> Joker g a c -> Joker g b c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a c -> g c
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE first #-}
  second :: (b -> c) -> Joker g a b -> Joker g a c
second b -> c
g = g c -> Joker g a c
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (g c -> Joker g a c)
-> (Joker g a b -> g c) -> Joker g a b -> Joker g a c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> c) -> g b -> g c
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> c
g (g b -> g c) -> (Joker g a b -> g b) -> Joker g a b -> g c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a b -> g b
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE second #-}
  bimap :: (a -> b) -> (c -> d) -> Joker g a c -> Joker g b d
bimap a -> b
_ c -> d
g = g d -> Joker g b d
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (g d -> Joker g b d)
-> (Joker g a c -> g d) -> Joker g a c -> Joker g b d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (c -> d) -> g c -> g d
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (g c -> g d) -> (Joker g a c -> g c) -> Joker g a c -> g d
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a c -> g c
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE bimap #-}

instance Functor g => Functor (Joker g a) where
  fmap :: (a -> b) -> Joker g a a -> Joker g a b
fmap a -> b
g = g b -> Joker g a b
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (g b -> Joker g a b)
-> (Joker g a a -> g b) -> Joker g a a -> Joker g a b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b) -> g a -> g b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
g (g a -> g b) -> (Joker g a a -> g a) -> Joker g a a -> g b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a a -> g a
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE fmap #-}

instance Applicative g => Biapplicative (Joker g) where
  bipure :: a -> b -> Joker g a b
bipure a
_ b
b = g b -> Joker g a b
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (b -> g b
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
b)
  {-# INLINE bipure #-}

  Joker g (c -> d)
mf <<*>> :: Joker g (a -> b) (c -> d) -> Joker g a c -> Joker g b d
<<*>> Joker g c
mx = g d -> Joker g b d
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (g (c -> d)
mf g (c -> d) -> g c -> g d
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 :: (a -> m) -> (b -> m) -> Joker g a b -> m
bifoldMap a -> m
_ b -> m
g = (b -> m) -> g b -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap b -> m
g (g b -> m) -> (Joker g a b -> g b) -> Joker g a b -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a b -> g b
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE bifoldMap #-}

instance Foldable g => Foldable (Joker g a) where
  foldMap :: (a -> m) -> Joker g a a -> m
foldMap a -> m
g = (a -> m) -> g a -> m
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap a -> m
g (g a -> m) -> (Joker g a a -> g a) -> Joker g a a -> m
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a a -> g a
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE foldMap #-}

instance Traversable g => Bitraversable (Joker g) where
  bitraverse :: (a -> f c) -> (b -> f d) -> Joker g a b -> f (Joker g c d)
bitraverse a -> f c
_ b -> f d
g = (g d -> Joker g c d) -> f (g d) -> f (Joker g c d)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g d -> Joker g c d
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (f (g d) -> f (Joker g c d))
-> (Joker g a b -> f (g d)) -> Joker g a b -> f (Joker g c d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> f d) -> g b -> f (g d)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse b -> f d
g (g b -> f (g d)) -> (Joker g a b -> g b) -> Joker g a b -> f (g d)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a b -> g b
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE bitraverse #-}

instance Traversable g => Traversable (Joker g a) where
  traverse :: (a -> f b) -> Joker g a a -> f (Joker g a b)
traverse a -> f b
g = (g b -> Joker g a b) -> f (g b) -> f (Joker g a b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g b -> Joker g a b
forall k k (g :: k -> *) (a :: k) (b :: k). g b -> Joker g a b
Joker (f (g b) -> f (Joker g a b))
-> (Joker g a a -> f (g b)) -> Joker g a a -> f (Joker g a b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> f b) -> g a -> f (g b)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse a -> f b
g (g a -> f (g b)) -> (Joker g a a -> g a) -> Joker g a a -> f (g b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Joker g a a -> g a
forall k (g :: k -> *) k (a :: k) (b :: k). Joker g a b -> g b
runJoker
  {-# INLINE traverse #-}