{-# LANGUAGE CPP, GADTs, InstanceSigs, KindSignatures, PatternSynonyms #-}
{-# LANGUAGE RankNTypes, RoleAnnotations, ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving, TemplateHaskell, TypeApplications #-}
{-# LANGUAGE TypeFamilies, TypeOperators, UndecidableSuperClasses #-}
module Control.Subcategory.Wrapper.Internal where
import Control.Applicative
#if defined(__GLASGOW_HASKELL__) && __GLASGOW_HASKELL__ < 808
import Control.Monad.Fail
#endif
import Control.Monad.Fix (MonadFix)
import Control.Monad.Zip (MonadZip)
import Data.Coerce
import Data.Kind (Type)
import Data.MonoTraversable
import Data.Pointed
import Data.Semialign (Align, Unalign)
import Data.Zip (Semialign, Unzip, Zip)
import GHC.Base (MonadPlus)
newtype WrapFunctor f (a :: Type) = WrapFunctor {runFunctor :: f a}
deriving newtype (Functor, Applicative, Alternative, Monad, Foldable)
deriving newtype (MonadPlus, MonadFix, MonadFail)
deriving newtype (Pointed, MonadZip, Unalign, Align, Semialign, Zip, Unzip)
instance Traversable f => Traversable (WrapFunctor f) where
traverse f = fmap WrapFunctor . traverse f . runFunctor
type role WrapMono representational nominal
newtype WrapMono mono b = WrapMono' mono
deriving newtype (MonoFoldable, MonoFunctor, Monoid, Semigroup, MonoPointed)
deriving newtype (GrowingAppend)
type instance Element (WrapMono mono b) = Element mono
pattern WrapMono :: b ~ Element mono => b ~ Element mono => mono -> WrapMono mono b
pattern WrapMono {unwrapMono} = WrapMono' unwrapMono
coerceToMono :: WrapMono mono (Element mono) -> mono
{-# INLINE coerceToMono #-}
coerceToMono = coerce
withMonoCoercible
:: (Coercible (WrapMono mono (Element mono)) mono => r)
-> r
{-# INLINE withMonoCoercible #-}
withMonoCoercible = id