{-# LANGUAGE EmptyCase, ScopedTypeVariables, StandaloneDeriving #-} {-# LANGUAGE CPP #-} {-# OPTIONS_GHC -Wno-orphans #-} module Control.Subcategory.Alternative (CAlternative(..), CChoice(..), CAlt(..)) 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 Data.Coerce (coerce) import qualified Data.Functor.Compose as SOP 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 Data.MonoTraversable (GrowingAppend, MonoFunctor) import qualified Data.Primitive.Array as A import qualified Data.Primitive.PrimArray as PA import qualified Data.Primitive.SmallArray as SA import qualified Data.Semigroup as Sem import qualified Data.Sequence as Seq import qualified Data.Set as Set import qualified Data.Vector as V import qualified Data.Vector.Primitive as P import qualified Data.Vector.Storable as S import qualified Data.Vector.Unboxed as U import Text.ParserCombinators.ReadP (ReadP) import Text.ParserCombinators.ReadPrec (ReadPrec) instance CChoice [] instance CChoice Maybe instance CChoice V.Vector instance CChoice U.Vector where <!> :: forall a. Dom Vector a => Vector a -> Vector a -> Vector a (<!>) = forall a. Semigroup a => a -> a -> a (<>) {-# INLINE [1] (<!>) #-} instance CChoice S.Vector where <!> :: forall a. Dom Vector a => Vector a -> Vector a -> Vector a (<!>) = forall a. Semigroup a => a -> a -> a (<>) {-# INLINE [1] (<!>) #-} instance CChoice P.Vector where <!> :: forall a. Dom Vector a => Vector a -> Vector a -> Vector a (<!>) = forall a. Semigroup a => a -> a -> a (<>) {-# INLINE [1] (<!>) #-} instance CChoice PA.PrimArray where <!> :: forall a. Dom PrimArray a => PrimArray a -> PrimArray a -> PrimArray a (<!>) = forall a. Semigroup a => a -> a -> a (<>) {-# INLINE [1] (<!>) #-} instance CChoice SA.SmallArray instance CChoice A.Array instance CChoice Seq.Seq #if !MIN_VERSION_base(4,16,0) instance CChoice Sem.Option #endif instance CChoice NonEmpty where <!> :: forall a. Dom NonEmpty a => NonEmpty a -> NonEmpty a -> NonEmpty a (<!>) = forall a. Semigroup a => a -> a -> a (Sem.<>) {-# INLINE (<!>) #-} instance CChoice (Either a) where Left a _ <!> :: forall a. Dom (Either a) a => Either a a -> Either a a -> Either a a <!> Either a a b = Either a a b Either a a a <!> Either a a _ = Either a a a {-# INLINE (<!>) #-} instance CChoice IM.IntMap where <!> :: forall a. Dom IntMap a => IntMap a -> IntMap a -> IntMap a (<!>) = forall a. IntMap a -> IntMap a -> IntMap a IM.union instance CChoice ReadP instance CChoice ReadPrec instance (CChoice f, CFunctor g) => CChoice (SOP.Compose f g) where SOP.Compose f (g a) a <!> :: forall a. Dom (Compose f g) a => Compose f g a -> Compose f g a -> Compose f g a <!> SOP.Compose f (g a) b = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a SOP.Compose (f (g a) a forall (f :: * -> *) a. (CChoice f, Dom f a) => f a -> f a -> f a <!> f (g a) b) {-# INLINE (<!>) #-} instance (CChoice f, CChoice g) => CChoice (SOP.Product f g) where SOP.Pair f a a1 g a b1 <!> :: forall a. Dom (Product f g) a => Product f g a -> Product f g a -> Product f g a <!> SOP.Pair f a a2 g a b2 = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> g a -> Product f g a SOP.Pair (f a a1 forall (f :: * -> *) a. (CChoice f, Dom f a) => f a -> f a -> f a <!> f a a2) (g a b1 forall (f :: * -> *) a. (CChoice f, Dom f a) => f a -> f a -> f a <!> g a b2) {-# INLINE (<!>) #-} instance CChoice HS.HashSet where <!> :: forall a. Dom HashSet a => HashSet a -> HashSet a -> HashSet a (<!>) = forall a. (Eq a, Hashable a) => HashSet a -> HashSet a -> HashSet a HS.union {-# INLINE (<!>) #-} instance CChoice Set.Set where <!> :: forall a. Dom Set a => Set a -> Set a -> Set a (<!>) = forall a. Ord a => Set a -> Set a -> Set a Set.union {-# INLINE (<!>) #-} instance Ord k => CChoice (Map.Map k) where <!> :: forall a. Dom (Map k) a => Map k a -> Map k a -> Map k a (<!>) = forall k a. Ord k => Map k a -> Map k a -> Map k a Map.union {-# INLINE (<!>) #-} instance (MonoFunctor mono, GrowingAppend mono, Semigroup mono) => CChoice (WrapMono mono) where <!> :: forall a. Dom (WrapMono mono) a => WrapMono mono a -> WrapMono mono a -> WrapMono mono a (<!>) = forall a. Semigroup a => a -> a -> a (<>) {-# INLINE [1] (<!>) #-} instance (Eq k, Hashable k) => CChoice (HM.HashMap k) where <!> :: forall a. Dom (HashMap k) a => HashMap k a -> HashMap k a -> HashMap k a (<!>) = forall k v. (Eq k, Hashable k) => HashMap k v -> HashMap k v -> HashMap k v HM.union {-# INLINE (<!>) #-} instance CAlternative IM.IntMap where cempty :: forall a. Dom IntMap a => IntMap a cempty = forall a. IntMap a IM.empty {-# INLINE cempty #-} instance (Eq k, Hashable k) => CAlternative (HM.HashMap k) where cempty :: forall a. Dom (HashMap k) a => HashMap k a cempty = forall k v. HashMap k v HM.empty {-# INLINE cempty #-} instance Ord k => CAlternative (Map.Map k) where cempty :: forall a. Dom (Map k) a => Map k a cempty = forall k a. Map k a Map.empty {-# INLINE cempty #-} instance CAlternative HS.HashSet where cempty :: forall a. Dom HashSet a => HashSet a cempty = forall a. HashSet a HS.empty {-# INLINE cempty #-} instance CAlternative Set.Set where cempty :: forall a. Dom Set a => Set a cempty = forall a. Set a Set.empty {-# INLINE cempty #-} instance (MonoFunctor mono, Monoid mono, GrowingAppend mono) => CAlternative (WrapMono mono) where cempty :: forall a. Dom (WrapMono mono) a => WrapMono mono a cempty = forall b mono. (b ~ Element mono, b ~ Element mono) => mono -> WrapMono mono b WrapMono forall a. Monoid a => a mempty {-# INLINE [1] cempty #-} instance (CAlternative f, CFunctor g) => CAlternative (SOP.Compose f g) where cempty :: forall a. Dom (Compose f g) a => Compose f g a cempty = forall {k} {k1} (f :: k -> *) (g :: k1 -> k) (a :: k1). f (g a) -> Compose f g a SOP.Compose forall (f :: * -> *) a. (CAlternative f, Dom f a) => f a cempty {-# INLINE cempty #-} instance (CAlternative f, CAlternative g) => CAlternative (SOP.Product f g) where cempty :: forall a. Dom (Product f g) a => Product f g a cempty = forall {k} (f :: k -> *) (g :: k -> *) (a :: k). f a -> g a -> Product f g a SOP.Pair forall (f :: * -> *) a. (CAlternative f, Dom f a) => f a cempty forall (f :: * -> *) a. (CAlternative f, Dom f a) => f a cempty {-# INLINE cempty #-} instance CAlternative [] instance CAlternative Maybe instance CAlternative Seq.Seq #if !MIN_VERSION_base(4,16,0) instance CAlternative Sem.Option #endif instance CAlternative ReadP instance CAlternative V.Vector instance CAlternative U.Vector where cempty :: forall a. Dom Vector a => Vector a cempty = forall a. Unbox a => Vector a U.empty {-# INLINE [1] cempty #-} instance CAlternative S.Vector where cempty :: forall a. Dom Vector a => Vector a cempty = forall a. Storable a => Vector a S.empty {-# INLINE [1] cempty #-} instance CAlternative P.Vector where cempty :: forall a. Dom Vector a => Vector a cempty = forall a. Prim a => Vector a P.empty {-# INLINE [1] cempty #-} instance CAlternative PA.PrimArray where cempty :: forall a. Dom PrimArray a => PrimArray a cempty = forall a. Prim a => Int -> [a] -> PrimArray a PA.primArrayFromListN Int 0 [] {-# INLINE [1] cempty #-} instance CAlternative SA.SmallArray instance CAlternative A.Array instance CAlternative ReadPrec newtype CAlt f a = CAlt { forall {k} (f :: k -> *) (a :: k). CAlt f a -> f a runAlt :: f a } deriving newtype (forall a b. a -> CAlt f b -> CAlt f a forall a b. (a -> b) -> CAlt f a -> CAlt f b forall (f :: * -> *) a b. Functor f => a -> CAlt f b -> CAlt f a forall (f :: * -> *) a b. Functor f => (a -> b) -> CAlt f a -> CAlt 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 -> CAlt f b -> CAlt f a $c<$ :: forall (f :: * -> *) a b. Functor f => a -> CAlt f b -> CAlt f a fmap :: forall a b. (a -> b) -> CAlt f a -> CAlt f b $cfmap :: forall (f :: * -> *) a b. Functor f => (a -> b) -> CAlt f a -> CAlt f b Functor, forall (f :: * -> *). Constrained f Constrained, forall a. a -> CAlt f a forall a b. CAlt f a -> CAlt f b -> CAlt f a forall a b. CAlt f a -> CAlt f b -> CAlt f b forall a b. CAlt f (a -> b) -> CAlt f a -> CAlt f b forall a b c. (a -> b -> c) -> CAlt f a -> CAlt f b -> CAlt 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 (CAlt f) forall (f :: * -> *) a. Applicative f => a -> CAlt f a forall (f :: * -> *) a b. Applicative f => CAlt f a -> CAlt f b -> CAlt f a forall (f :: * -> *) a b. Applicative f => CAlt f a -> CAlt f b -> CAlt f b forall (f :: * -> *) a b. Applicative f => CAlt f (a -> b) -> CAlt f a -> CAlt f b forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> CAlt f a -> CAlt f b -> CAlt f c <* :: forall a b. CAlt f a -> CAlt f b -> CAlt f a $c<* :: forall (f :: * -> *) a b. Applicative f => CAlt f a -> CAlt f b -> CAlt f a *> :: forall a b. CAlt f a -> CAlt f b -> CAlt f b $c*> :: forall (f :: * -> *) a b. Applicative f => CAlt f a -> CAlt f b -> CAlt f b liftA2 :: forall a b c. (a -> b -> c) -> CAlt f a -> CAlt f b -> CAlt f c $cliftA2 :: forall (f :: * -> *) a b c. Applicative f => (a -> b -> c) -> CAlt f a -> CAlt f b -> CAlt f c <*> :: forall a b. CAlt f (a -> b) -> CAlt f a -> CAlt f b $c<*> :: forall (f :: * -> *) a b. Applicative f => CAlt f (a -> b) -> CAlt f a -> CAlt f b pure :: forall a. a -> CAlt f a $cpure :: forall (f :: * -> *) a. Applicative f => a -> CAlt f a Applicative, forall a. CAlt f a forall a. CAlt f a -> CAlt f [a] forall a. CAlt f a -> CAlt f a -> CAlt 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 (CAlt f) forall (f :: * -> *) a. Alternative f => CAlt f a forall (f :: * -> *) a. Alternative f => CAlt f a -> CAlt f [a] forall (f :: * -> *) a. Alternative f => CAlt f a -> CAlt f a -> CAlt f a many :: forall a. CAlt f a -> CAlt f [a] $cmany :: forall (f :: * -> *) a. Alternative f => CAlt f a -> CAlt f [a] some :: forall a. CAlt f a -> CAlt f [a] $csome :: forall (f :: * -> *) a. Alternative f => CAlt f a -> CAlt f [a] <|> :: forall a. CAlt f a -> CAlt f a -> CAlt f a $c<|> :: forall (f :: * -> *) a. Alternative f => CAlt f a -> CAlt f a -> CAlt f a empty :: forall a. CAlt f a $cempty :: forall (f :: * -> *) a. Alternative f => CAlt f a App.Alternative) deriving newtype instance CFunctor f => CFunctor (CAlt f) deriving newtype instance CChoice f => CChoice (CAlt f) deriving newtype instance CAlternative f => CAlternative (CAlt f) deriving newtype instance CApplicative f => CApplicative (CAlt f) deriving newtype instance CPointed f => CPointed (CAlt f) instance (Dom f a, CChoice f) => Sem.Semigroup (CAlt f a) where <> :: CAlt f a -> CAlt f a -> CAlt f a (<>) = coerce :: forall a b. Coercible a b => a -> b coerce @(f a -> f a -> f a) forall (f :: * -> *) a. (CChoice f, Dom f a) => f a -> f a -> f a (<!>) instance (Dom f a, CAlternative f) => Monoid (CAlt f a) where mempty :: CAlt f a mempty = coerce :: forall a b. Coercible a b => a -> b coerce @(f a) forall (f :: * -> *) a. (CAlternative f, Dom f a) => f a cempty mappend :: CAlt f a -> CAlt f a -> CAlt f a mappend = forall a. Semigroup a => a -> a -> a (<>)