#if MIN_VERSION_GLASGOW_HASKELL(8,0,1,0)
#endif
module Control.Applicative.Graph where
import Control.Graphted.Class
import Data.Functor.Graph
import Data.Pointed.Graph
#if !MIN_VERSION_GLASGOW_HASKELL(8,0,1,0)
import Data.Proxy
#endif
type family DefaultThen (useReplace :: Bool) (f :: p -> * -> *) (i :: p) (j :: p) where
DefaultThen 'True f i j = Apply f (Replace f i) j
DefaultThen 'False f i j = LiftA2 f i j
type family DefaultThenCxt (useReplace :: Bool) (f :: p -> * -> *) (i :: p) (j :: p) where
DefaultThenCxt 'True f i j = (Apply f (Replace f i) j ~ Then f i j, ApplyInv f (Replace f i) j)
DefaultThenCxt 'False f i j = (LiftA2 f i j ~ Then f i j, LiftA2Inv f i j)
class GApplicativeThen useReplace (f :: p -> * -> *) where
gdefaultThenProxy :: DefaultThenCxt useReplace f i j => proxy useReplace -> f i a -> f j b -> f (Then f i j) b
gdefaultThen :: DefaultThenCxt useReplace f i j => f i a -> f j b -> f (Then f i j) b
instance GApplicative f => GApplicativeThen 'True f where
gdefaultThenProxy _ a b = (id `greplace` a) `gap` b
gdefaultThen a b = (id `greplace` a) `gap` b
instance GApplicative f => GApplicativeThen 'False f where
gdefaultThenProxy _ a b = gliftA2 (flip const) a b
gdefaultThen a b = gliftA2 (flip const) a b
class (GFunctor f, GPointed f) => GApplicative (f :: p -> * -> *) where
type family Apply f (i :: p) (j :: p) :: p
type instance Apply f i j = Combine f i j
type family ApplyInv f (i :: p) (j :: p) :: Constraint
type instance ApplyInv f i j = Inv f i j
type family LiftA2 f (i :: p) (j :: p) :: p
type instance LiftA2 f i j = Apply f (Fmap f i) j
type family LiftA2Inv f (i :: p) (j :: p) :: Constraint
type instance LiftA2Inv f i j = ApplyInv f i j
type family ThenUseReplace f :: Bool
type instance ThenUseReplace f = EfficientReplace f
type family Then f (i :: p) (j :: p) :: p
type instance Then f i j = DefaultThen (ThenUseReplace f) f i j
type family ThenInv f (i :: p) (j :: p) :: Constraint
type instance ThenInv f i j = ApplyInv f i j
type family But f (i :: p) (j :: p) :: p
type instance But f i j = LiftA2 f i j
type family ButInv f (i :: p) (j :: p) :: Constraint
type instance ButInv f i j = ApplyInv f i j
gap :: ApplyInv f i j => f i (a -> b) -> f j a -> f (Apply f i j) b
gliftA2 :: LiftA2Inv f i j => (a -> b -> c) -> f i a -> f j b -> f (LiftA2 f i j) c
default gliftA2 :: (Apply f (Fmap f i) j ~ LiftA2 f i j, ApplyInv f (Fmap f i) j)
=> (a -> b -> c) -> f i a -> f j b -> f (LiftA2 f i j) c
gliftA2 f x = gap (gmap f x)
gthen :: ThenInv f i j => f i a -> f j b -> f (Then f i j) b
default gthen :: (GApplicativeThen (ThenUseReplace f) f, DefaultThenCxt (ThenUseReplace f) f i j)
=> f i a -> f j b -> f (Then f i j) b
#if MIN_VERSION_GLASGOW_HASKELL(8,0,1,0)
gthen a b = gdefaultThen @(ThenUseReplace f) a b
#else
gthen a b = gdefaultThenProxy (Proxy :: Proxy (ThenUseReplace f)) a b
#endif
gbut :: ButInv f i j => f i a -> f j b -> f (But f i j) a
default gbut :: (LiftA2 f i j ~ But f i j, LiftA2Inv f i j)
=> f i a -> f j b -> f (But f i j) a
gbut = gliftA2 const