{-# LANGUAGE EmptyCase, StandaloneDeriving, TupleSections #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE UndecidableSuperClasses                      #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Control.Subcategory.Applicative
  ( CApplicative(..), defaultRightApply, defaultLeftApply, CApp(..)
  ) where
import Control.Subcategory.Alternative.Class
import Control.Subcategory.Applicative.Class
import Control.Subcategory.Functor
import Control.Subcategory.Pointed

import qualified Control.Applicative             as App
import qualified Control.Monad.ST.Lazy           as LST
import qualified Control.Monad.ST.Strict         as SST
import           Data.Coerce                     (coerce)
import           Data.Functor.Const              (Const)
import           Data.Functor.Identity           (Identity)
import qualified Data.Functor.Product            as SOP
import           Data.Hashable                   (Hashable)
import qualified Data.HashMap.Strict             as HM
import qualified Data.HashSet                    as HS
import qualified Data.IntMap                     as IM
import           Data.List.NonEmpty              (NonEmpty)
import qualified Data.Map                        as Map
import qualified Data.Primitive.Array            as A
import qualified Data.Primitive.SmallArray       as SA
#if !MIN_VERSION_base(4,16,0)
import qualified Data.Semigroup                  as Sem
#endif
import qualified Data.Sequence                   as Seq
import qualified Data.Set                        as Set
import qualified Data.Tree                       as Tree
import qualified Data.Vector                     as V
import           GHC.Conc                        (STM)
import           Text.ParserCombinators.ReadP    (ReadP)
import           Text.ParserCombinators.ReadPrec (ReadPrec)

defaultLeftApply :: (Dom f (b1, b2), Dom f b1, Dom f b2, CApplicative f)
                 => f b1 -> f b2 -> f b1
defaultLeftApply :: forall (f :: * -> *) b1 b2.
(Dom f (b1, b2), Dom f b1, Dom f b2, CApplicative f) =>
f b1 -> f b2 -> f b1
defaultLeftApply f b1
a f b2
b = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a b. a -> b -> a
const forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
<$:> forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
pair f b1
a f b2
b
defaultRightApply :: (Dom f (b1, b2), Dom f b2, Dom f b1, CApplicative f)
                  => f b1 -> f b2 -> f b2
defaultRightApply :: forall (f :: * -> *) b1 b2.
(Dom f (b1, b2), Dom f b2, Dom f b1, CApplicative f) =>
f b1 -> f b2 -> f b2
defaultRightApply f b1
a f b2
b = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry (forall a b. a -> b -> a
const forall a. a -> a
id) forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
<$:> forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
pair f b1
a f b2
b

instance Semigroup w => CApplicative (Const w) where
  pair :: forall a b.
(Dom (Const w) a, Dom (Const w) b, Dom (Const w) (a, b)) =>
Const w a -> Const w b -> Const w (a, b)
pair = coerce :: forall a b. Coercible a b => a -> b
coerce @(w -> w -> w) forall a. Semigroup a => a -> a -> a
(<>)
  <.> :: forall a b.
(Dom (Const w) a, Dom (Const w) b, Dom (Const w) (a -> b)) =>
Const w (a -> b) -> Const w a -> Const w b
(<.>) = coerce :: forall a b. Coercible a b => a -> b
coerce @(w -> w -> w) forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE (<.>) #-}
  (<. ) = coerce :: forall a b. Coercible a b => a -> b
coerce @(w -> w -> w) forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE (<. ) #-}
  ( .>) = coerce :: forall a b. Coercible a b => a -> b
coerce @(w -> w -> w) forall a. Semigroup a => a -> a -> a
(<>)
  {-# INLINE ( .>) #-}

instance CApplicative []
instance CApplicative IO
instance CApplicative STM
instance CApplicative ReadP
instance CApplicative V.Vector
instance CApplicative SA.SmallArray
instance CApplicative A.Array
instance CApplicative ReadPrec
instance CApplicative (SST.ST s)
instance CApplicative (LST.ST s)
instance CApplicative App.ZipList
instance CApplicative Maybe
instance CApplicative Identity
instance CApplicative Tree.Tree
instance CApplicative Seq.Seq
#if !MIN_VERSION_base(4,16,0)
instance CApplicative Sem.Option
#endif
instance CApplicative NonEmpty
instance CApplicative ((->) a)
instance CApplicative (Either a)
instance (CApplicative f, CApplicative g)
      => CApplicative (SOP.Product f g) where
  pair :: forall a b.
(Dom (Product f g) a, Dom (Product f g) b,
 Dom (Product f g) (a, b)) =>
Product f g a -> Product f g b -> Product f g (a, b)
pair (SOP.Pair f a
a g a
b) (SOP.Pair f b
c g b
d) = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
pair f a
a f b
c) (forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
pair g a
b g b
d)
  SOP.Pair f (a -> b)
f g (a -> b)
g <.> :: forall a b.
(Dom (Product f g) a, Dom (Product f g) b,
 Dom (Product f g) (a -> b)) =>
Product f g (a -> b) -> Product f g a -> Product f g b
<.> SOP.Pair f a
a g a
b = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (f (a -> b)
f forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a -> b)) =>
f (a -> b) -> f a -> f b
<.> f a
a) (g (a -> b)
g forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a -> b)) =>
f (a -> b) -> f a -> f b
<.> g a
b)
  {-# INLINE (<.>) #-}
  SOP.Pair f a
f g a
g <. :: forall a b.
(Dom (Product f g) a, Dom (Product f g) b) =>
Product f g a -> Product f g b -> Product f g a
<. SOP.Pair f b
a g b
b = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (f a
f forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b) =>
f a -> f b -> f a
<. f b
a) (g a
g forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b) =>
f a -> f b -> f a
<. g b
b)
  {-# INLINE (<.) #-}
  SOP.Pair f a
f g a
g .> :: forall a b.
(Dom (Product f g) a, Dom (Product f g) b) =>
Product f g a -> Product f g b -> Product f g b
.> SOP.Pair f b
a g b
b = forall {k} (f :: k -> *) (g :: k -> *) (a :: k).
f a -> g a -> Product f g a
SOP.Pair (f a
f forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b) =>
f a -> f b -> f b
.> f b
a) (g a
g forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b) =>
f a -> f b -> f b
.> g b
b)
  {-# INLINE (.>) #-}

class Dom f (g a -> g b) => DomOver f g a b
instance Dom f (g a -> g b) => DomOver f g a b

instance Applicative f => CApplicative (WrapFunctor f)
instance Semigroup w => CApplicative ((,) w) where
  pair :: forall a b.
(Dom ((,) w) a, Dom ((,) w) b, Dom ((,) w) (a, b)) =>
(w, a) -> (w, b) -> (w, (a, b))
pair (w
w, a
a) (w
u, b
b) = (w
w forall a. Semigroup a => a -> a -> a
<> w
u, (a
a, b
b))
  {-# INLINE pair #-}
  (w
w, a -> b
f) <.> :: forall a b.
(Dom ((,) w) a, Dom ((,) w) b, Dom ((,) w) (a -> b)) =>
(w, a -> b) -> (w, a) -> (w, b)
<.> (w
u, a
a) = (w
w forall a. Semigroup a => a -> a -> a
<> w
u, a -> b
f a
a)
  {-# INLINE (<.>) #-}
  (w
w, a
a) <. :: forall a b.
(Dom ((,) w) a, Dom ((,) w) b) =>
(w, a) -> (w, b) -> (w, a)
<.  (w
u, b
_) = (w
w forall a. Semigroup a => a -> a -> a
<> w
u, a
a)
  {-# INLINE (<.) #-}
  (w
w, a
_)  .> :: forall a b.
(Dom ((,) w) a, Dom ((,) w) b) =>
(w, a) -> (w, b) -> (w, b)
.> (w
u, b
b) = (w
w forall a. Semigroup a => a -> a -> a
<> w
u, b
b)
  {-# INLINE (.>) #-}
instance CApplicative IM.IntMap where
  pair :: forall a b.
(Dom IntMap a, Dom IntMap b, Dom IntMap (a, b)) =>
IntMap a -> IntMap b -> IntMap (a, b)
pair = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith (,)
  {-# INLINE pair #-}
  <.> :: forall a b.
(Dom IntMap a, Dom IntMap b, Dom IntMap (a -> b)) =>
IntMap (a -> b) -> IntMap a -> IntMap b
(<.>) = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith forall a. a -> a
id
  {-# INLINE (<.>) #-}
  <. :: forall a b.
(Dom IntMap a, Dom IntMap b) =>
IntMap a -> IntMap b -> IntMap a
(<.)  = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith forall a b. a -> b -> a
const
  {-# INLINE (<.) #-}
  .> :: forall a b.
(Dom IntMap a, Dom IntMap b) =>
IntMap a -> IntMap b -> IntMap b
(.>)  = forall a b c. (a -> b -> c) -> IntMap a -> IntMap b -> IntMap c
IM.intersectionWith forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id
  {-# INLINE (.>) #-}

instance Ord k => CApplicative (Map.Map k) where
  pair :: forall a b.
(Dom (Map k) a, Dom (Map k) b, Dom (Map k) (a, b)) =>
Map k a -> Map k b -> Map k (a, b)
pair = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,)
  {-# INLINE pair #-}
  <.> :: forall a b.
(Dom (Map k) a, Dom (Map k) b, Dom (Map k) (a -> b)) =>
Map k (a -> b) -> Map k a -> Map k b
(<.>) = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall a. a -> a
id
  {-# INLINE (<.>) #-}
  <. :: forall a b.
(Dom (Map k) a, Dom (Map k) b) =>
Map k a -> Map k b -> Map k a
(<.)  = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall a b. a -> b -> a
const
  {-# INLINE (<.) #-}
  .> :: forall a b.
(Dom (Map k) a, Dom (Map k) b) =>
Map k a -> Map k b -> Map k b
(.>)  = forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id
  {-# INLINE (.>) #-}

instance (Eq k, Hashable k) => CApplicative (HM.HashMap k) where
  pair :: forall a b.
(Dom (HashMap k) a, Dom (HashMap k) b, Dom (HashMap k) (a, b)) =>
HashMap k a -> HashMap k b -> HashMap k (a, b)
pair = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith (,)
  {-# INLINE pair #-}
  <.> :: forall a b.
(Dom (HashMap k) a, Dom (HashMap k) b, Dom (HashMap k) (a -> b)) =>
HashMap k (a -> b) -> HashMap k a -> HashMap k b
(<.>) = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith forall a. a -> a
id
  {-# INLINE (<.>) #-}
  <. :: forall a b.
(Dom (HashMap k) a, Dom (HashMap k) b) =>
HashMap k a -> HashMap k b -> HashMap k a
(<.)  = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith forall a b. a -> b -> a
const
  {-# INLINE (<.) #-}
  .> :: forall a b.
(Dom (HashMap k) a, Dom (HashMap k) b) =>
HashMap k a -> HashMap k b -> HashMap k b
(.>)  = forall k v1 v2 v3.
(Eq k, Hashable k) =>
(v1 -> v2 -> v3) -> HashMap k v1 -> HashMap k v2 -> HashMap k v3
HM.intersectionWith forall a b. (a -> b) -> a -> b
$ forall a b. a -> b -> a
const forall a. a -> a
id
  {-# INLINE (.>) #-}

instance CApplicative Set.Set where
  pair :: forall a b.
(Dom Set a, Dom Set b, Dom Set (a, b)) =>
Set a -> Set b -> Set (a, b)
pair Set a
as Set b
bs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\b
b -> forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map (,b
b) Set a
as) Set b
bs
  {-# INLINE pair #-}
  Set (a -> b)
fs <.> :: forall a b.
(Dom Set a, Dom Set b, Dom Set (a -> b)) =>
Set (a -> b) -> Set a -> Set b
<.> Set a
as = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a -> b
f -> forall b a. Ord b => (a -> b) -> Set a -> Set b
Set.map a -> b
f Set a
as) Set (a -> b)
fs
  {-# INLINE (<.>) #-}
  Set a
a <. :: forall a b. (Dom Set a, Dom Set b) => Set a -> Set b -> Set a
<. Set b
b | forall a. Set a -> Bool
Set.null Set b
b = forall a. Set a
Set.empty
         | Bool
otherwise  = Set a
a
  {-# INLINE (<.) #-}
  Set a
a .> :: forall a b. (Dom Set a, Dom Set b) => Set a -> Set b -> Set b
.> Set b
b | forall a. Set a -> Bool
Set.null Set a
a = forall a. Set a
Set.empty
         | Bool
otherwise  = Set b
b
  {-# INLINE (.>) #-}

instance CApplicative HS.HashSet where
  pair :: forall a b.
(Dom HashSet a, Dom HashSet b, Dom HashSet (a, b)) =>
HashSet a -> HashSet b -> HashSet (a, b)
pair HashSet a
as HashSet b
bs = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\b
b -> forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map (,b
b) HashSet a
as) HashSet b
bs
  {-# INLINE pair #-}
  HashSet (a -> b)
fs <.> :: forall a b.
(Dom HashSet a, Dom HashSet b, Dom HashSet (a -> b)) =>
HashSet (a -> b) -> HashSet a -> HashSet b
<.> HashSet a
as = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (\a -> b
f -> forall b a.
(Hashable b, Eq b) =>
(a -> b) -> HashSet a -> HashSet b
HS.map a -> b
f HashSet a
as) HashSet (a -> b)
fs
  {-# INLINE (<.>) #-}
  HashSet a
a <. :: forall a b.
(Dom HashSet a, Dom HashSet b) =>
HashSet a -> HashSet b -> HashSet a
<. HashSet b
b | forall a. HashSet a -> Bool
HS.null HashSet b
b = forall a. HashSet a
HS.empty
         | Bool
otherwise  = HashSet a
a
  {-# INLINE (<.) #-}
  HashSet a
a .> :: forall a b.
(Dom HashSet a, Dom HashSet b) =>
HashSet a -> HashSet b -> HashSet b
.> HashSet b
b | forall a. HashSet a -> Bool
HS.null HashSet a
a = forall a. HashSet a
HS.empty
         | Bool
otherwise  = HashSet b
b
  {-# INLINE (.>) #-}

instance Constrained f => Constrained (CApp f) where
  type Dom (CApp f) a = Dom f a

newtype CApp f a = CApp { forall {k} (f :: k -> *) (a :: k). CApp f a -> f a
runCApp :: f a }
  deriving (ReadPrec [CApp f a]
ReadPrec (CApp f a)
ReadS [CApp f a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k (f :: k -> *) (a :: k). Read (f a) => ReadPrec [CApp f a]
forall k (f :: k -> *) (a :: k). Read (f a) => ReadPrec (CApp f a)
forall k (f :: k -> *) (a :: k).
Read (f a) =>
Int -> ReadS (CApp f a)
forall k (f :: k -> *) (a :: k). Read (f a) => ReadS [CApp f a]
readListPrec :: ReadPrec [CApp f a]
$creadListPrec :: forall k (f :: k -> *) (a :: k). Read (f a) => ReadPrec [CApp f a]
readPrec :: ReadPrec (CApp f a)
$creadPrec :: forall k (f :: k -> *) (a :: k). Read (f a) => ReadPrec (CApp f a)
readList :: ReadS [CApp f a]
$creadList :: forall k (f :: k -> *) (a :: k). Read (f a) => ReadS [CApp f a]
readsPrec :: Int -> ReadS (CApp f a)
$creadsPrec :: forall k (f :: k -> *) (a :: k).
Read (f a) =>
Int -> ReadS (CApp f a)
Read, Int -> CApp f a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> CApp f a -> ShowS
forall k (f :: k -> *) (a :: k). Show (f a) => [CApp f a] -> ShowS
forall k (f :: k -> *) (a :: k). Show (f a) => CApp f a -> String
showList :: [CApp f a] -> ShowS
$cshowList :: forall k (f :: k -> *) (a :: k). Show (f a) => [CApp f a] -> ShowS
show :: CApp f a -> String
$cshow :: forall k (f :: k -> *) (a :: k). Show (f a) => CApp f a -> String
showsPrec :: Int -> CApp f a -> ShowS
$cshowsPrec :: forall k (f :: k -> *) (a :: k).
Show (f a) =>
Int -> CApp f a -> ShowS
Show, CApp f a -> CApp f a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k (f :: k -> *) (a :: k).
Eq (f a) =>
CApp f a -> CApp f a -> Bool
/= :: CApp f a -> CApp f a -> Bool
$c/= :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
CApp f a -> CApp f a -> Bool
== :: CApp f a -> CApp f a -> Bool
$c== :: forall k (f :: k -> *) (a :: k).
Eq (f a) =>
CApp f a -> CApp f a -> Bool
Eq, CApp f a -> CApp f a -> Bool
CApp f a -> CApp f a -> Ordering
CApp f a -> CApp f a -> CApp f a
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}. Ord (f a) => Eq (CApp f a)
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Bool
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Ordering
forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> CApp f a
min :: CApp f a -> CApp f a -> CApp f a
$cmin :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> CApp f a
max :: CApp f a -> CApp f a -> CApp f a
$cmax :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> CApp f a
>= :: CApp f a -> CApp f a -> Bool
$c>= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Bool
> :: CApp f a -> CApp f a -> Bool
$c> :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Bool
<= :: CApp f a -> CApp f a -> Bool
$c<= :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Bool
< :: CApp f a -> CApp f a -> Bool
$c< :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Bool
compare :: CApp f a -> CApp f a -> Ordering
$ccompare :: forall k (f :: k -> *) (a :: k).
Ord (f a) =>
CApp f a -> CApp f a -> Ordering
Ord)
  deriving newtype (forall a b. a -> CApp f b -> CApp f a
forall a b. (a -> b) -> CApp f a -> CApp f b
forall (f :: * -> *) a b. Functor f => a -> CApp f b -> CApp f a
forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> CApp f a -> CApp f b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> CApp f b -> CApp f a
$c<$ :: forall (f :: * -> *) a b. Functor f => a -> CApp f b -> CApp f a
fmap :: forall a b. (a -> b) -> CApp f a -> CApp f b
$cfmap :: forall (f :: * -> *) a b.
Functor f =>
(a -> b) -> CApp f a -> CApp f b
Functor, forall a. a -> CApp f a
forall a b. CApp f a -> CApp f b -> CApp f a
forall a b. CApp f a -> CApp f b -> CApp f b
forall a b. CApp f (a -> b) -> CApp f a -> CApp f b
forall a b c. (a -> b -> c) -> CApp f a -> CApp f b -> CApp f c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
forall {f :: * -> *}. Applicative f => Functor (CApp f)
forall (f :: * -> *) a. Applicative f => a -> CApp f a
forall (f :: * -> *) a b.
Applicative f =>
CApp f a -> CApp f b -> CApp f a
forall (f :: * -> *) a b.
Applicative f =>
CApp f a -> CApp f b -> CApp f b
forall (f :: * -> *) a b.
Applicative f =>
CApp f (a -> b) -> CApp f a -> CApp f b
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> CApp f a -> CApp f b -> CApp f c
<* :: forall a b. CApp f a -> CApp f b -> CApp f a
$c<* :: forall (f :: * -> *) a b.
Applicative f =>
CApp f a -> CApp f b -> CApp f a
*> :: forall a b. CApp f a -> CApp f b -> CApp f b
$c*> :: forall (f :: * -> *) a b.
Applicative f =>
CApp f a -> CApp f b -> CApp f b
liftA2 :: forall a b c. (a -> b -> c) -> CApp f a -> CApp f b -> CApp f c
$cliftA2 :: forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> CApp f a -> CApp f b -> CApp f c
<*> :: forall a b. CApp f (a -> b) -> CApp f a -> CApp f b
$c<*> :: forall (f :: * -> *) a b.
Applicative f =>
CApp f (a -> b) -> CApp f a -> CApp f b
pure :: forall a. a -> CApp f a
$cpure :: forall (f :: * -> *) a. Applicative f => a -> CApp f a
Applicative, forall a. CApp f a
forall a. CApp f a -> CApp f [a]
forall a. CApp f a -> CApp f a -> CApp f a
forall (f :: * -> *).
Applicative f
-> (forall a. f a)
-> (forall a. f a -> f a -> f a)
-> (forall a. f a -> f [a])
-> (forall a. f a -> f [a])
-> Alternative f
forall {f :: * -> *}. Alternative f => Applicative (CApp f)
forall (f :: * -> *) a. Alternative f => CApp f a
forall (f :: * -> *) a. Alternative f => CApp f a -> CApp f [a]
forall (f :: * -> *) a.
Alternative f =>
CApp f a -> CApp f a -> CApp f a
many :: forall a. CApp f a -> CApp f [a]
$cmany :: forall (f :: * -> *) a. Alternative f => CApp f a -> CApp f [a]
some :: forall a. CApp f a -> CApp f [a]
$csome :: forall (f :: * -> *) a. Alternative f => CApp f a -> CApp f [a]
<|> :: forall a. CApp f a -> CApp f a -> CApp f a
$c<|> :: forall (f :: * -> *) a.
Alternative f =>
CApp f a -> CApp f a -> CApp f a
empty :: forall a. CApp f a
$cempty :: forall (f :: * -> *) a. Alternative f => CApp f a
App.Alternative)

deriving newtype instance (CFunctor f) => CFunctor (CApp f)
deriving newtype instance (CChoice f) => CChoice (CApp f)
deriving newtype instance (CAlternative f) => CAlternative (CApp f)
deriving newtype instance (CApplicative f) => CApplicative (CApp f)
deriving newtype instance (CPointed f) => CPointed (CApp f)

instance (Dom f a, CApplicative f, Semigroup a, Dom f (a, a))
       => Semigroup (CApp f a) where
  CApp f a
a <> :: CApp f a -> CApp f a -> CApp f a
<> CApp f a
b = forall {k} (f :: k -> *) (a :: k). f a -> CApp f a
CApp forall a b. (a -> b) -> a -> b
$ forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Semigroup a => a -> a -> a
(<>) forall (f :: * -> *) a b.
(CFunctor f, Dom f a, Dom f b) =>
(a -> b) -> f a -> f b
<$:> forall (f :: * -> *) a b.
(CApplicative f, Dom f a, Dom f b, Dom f (a, b)) =>
f a -> f b -> f (a, b)
pair f a
a f a
b

instance (Dom f a, CPointed f, CApplicative f, Monoid a, Dom f (a, a))
       => Monoid (CApp f a) where
  mappend :: CApp f a -> CApp f a -> CApp f a
mappend = forall a. Semigroup a => a -> a -> a
(<>)
  mempty :: CApp f a
mempty = forall {k} (f :: k -> *) (a :: k). f a -> CApp f a
CApp forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. (CPointed f, Dom f a) => a -> f a
cpure forall a. Monoid a => a
mempty