{- | Module : Control.Applicative.Graph Description : Graph indexed applicative functors Copyright : (c) Aaron Friel License : BSD-3 Maintainer : Aaron Friel <mayreply@aaronfriel.com> Stability : unstable Portability : portable -} {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE MultiParamTypeClasses #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE ImpredicativeTypes #-} {-# LANGUAGE AllowAmbiguousTypes #-} -- For the default Apply, Then, and But instances. {-# LANGUAGE UndecidableInstances #-} module Control.Applicative.Graph where import Control.Graphted.Class import Data.Functor.Graph import Data.Pointed.Graph -- | Graph indexed applicative functor. class (GFunctor f, GPointed f) => GApplicative (f :: p -> * -> *) where -- | The apply operation ('<*>') on the graph index. -- -- Default instance: @Apply f i j = 'Combine' f i j@ type family Apply f (i :: p) (j :: p) :: p type instance Apply f i j = Combine f i j -- | An invariant on the indexes of 'Apply'. -- -- Default instance: @ApplyInv m i j = 'Inv' m i j@ type family ApplyInv f (i :: p) (j :: p) :: Constraint type instance ApplyInv f i j = Inv f i j -- | The 'liftA2' operation on the graph index. -- -- Default instance: @Lift f i j = 'Apply' f ('Apply' f ('Pure' f) i) j@ type family LiftA2 f (i :: p) (j :: p) :: p type instance LiftA2 f i j = Apply f (Fmap f i) j -- | An invariant on the indexes of 'But'. -- -- Default instance: @ButInv m i j = 'ApplyInv' m i j@ type family LiftA2Inv f (i :: p) (j :: p) :: Constraint type instance LiftA2Inv f i j = ApplyInv f i j -- | The then operation ('*>') on the graph index. -- -- Default instance: @'Then' f i j = 'Apply' f ('Replace' f i) j@ type family Then f (i :: p) (j :: p) :: p type instance Then f i j = Apply f (Replace f i) j -- | An invariant on the indexes of 'Then'. -- -- Default instance: @ThenInv m i j = 'ApplyInv' m i j@ type family ThenInv f (i :: p) (j :: p) :: Constraint type instance ThenInv f i j = ApplyInv f i j -- | The but operation ('<*') on the graph index. -- -- Default instance: @But f i j = 'LiftA2' f i j@ type family But f (i :: p) (j :: p) :: p type instance But f i j = LiftA2 f i j -- | An invariant on the indexes of 'But'. -- -- Default instance: @ButInv m i j = 'ApplyInv' m i j@ type family ButInv f (i :: p) (j :: p) :: Constraint type instance ButInv f i j = ApplyInv f i j -- | Sequential application ('<*>'). gap :: ApplyInv f i j => f i (a -> b) -> f j a -> f (Apply f i j) b -- | Lift a binary function to actions. -- 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) -- | Sequence actions, discarding the value of the first argument ('*>'). -- -- Default implementation requires the default instance of 'Then'. {-# INLINE gthen #-} gthen :: ThenInv f i j => f i a -> f j b -> f (Then f i j) b default gthen :: (Apply f (Replace f i) j ~ Then f i j, ApplyInv f (Replace f i) j, ThenInv f (Replace f i) j) => f i a -> f j b -> f (Then f i j) b gthen a b = (id `greplace` a) `gap` b -- | Sequence actions, discarding values of the second argument ('<*'). -- -- Default implementation requires the default instance of 'But'. {-# INLINE gbut #-} 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 {-# MINIMAL gap #-}