packages feed

effect-stack 0.1.0.1 → 0.2

raw patch · 11 files changed

+217/−17 lines, 11 filesdep +constraintsdep +mtldep ~basedep ~transformers

Dependencies added: constraints, mtl

Dependency ranges changed: base, transformers

Files

ChangeLog.md view
@@ -1,5 +1,9 @@ # Revision history for effect-stack -## 0.1.0.0 -- YYYY-mm-dd+## 0.1.0.1 -- 2019-07-04++* Removed an unneeded dependency on mtl.++## 0.1.0.0 -- 2019-07-04  * First version. Released on an unsuspecting world.
Control/Monad/Stack/Accum.hs view
@@ -1,8 +1,13 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Accum where +import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +28,13 @@ class Monad m => AccumStack m where 	type PopAccum m :: * -> * 	liftAccum :: PopAccum m a -> m a++type instance Pop AccumT m = PopAccum m+type AccumDepth n m = IteratePop n AccumT m+type AccumConstraints n m = (KnownNat n, StackConstraints n AccumT AccumStack m)++depthAccum :: forall n m a. AccumConstraints n m => AccumDepth n m a -> m a+depthAccum = depth @n @AccumT @AccumStack liftAccum  instance (Monad m, Monoid w) => AccumStack (AccumT w m) where 	type PopAccum (AccumT w m) = m
Control/Monad/Stack/Cont.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Cont where +import Control.Monad.Cont+import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +30,14 @@ class Monad m => ContStack m where 	type PopCont m :: * -> * 	liftCont :: PopCont m a -> m a++type instance Pop ContTag m = PopCont m+type ContDepth n m = IteratePop n ContTag m+type ContConstraints n m = (KnownNat n, StackConstraints n ContTag ContStack m)+type MonadContDepth n m = (ContConstraints n m, MonadCont (ContDepth n m))++depthCont :: forall n m a. ContConstraints n m => ContDepth n m a -> m a+depthCont = depth @n @ContTag @ContStack liftCont  instance (ContStack m, Monoid w) => ContStack (AccumT w m) where 	type PopCont (AccumT w m) = PopCont m
Control/Monad/Stack/Except.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Except where +import Control.Monad.Except+import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +30,14 @@ class Monad m => ErrorStack m where 	type PopError m :: * -> * 	liftError :: PopError m a -> m a++type instance Pop ExceptT m = PopError m+type ErrorDepth n m = IteratePop n ExceptT m+type ErrorConstraints n m = (KnownNat n, StackConstraints n ExceptT ErrorStack m)+type MonadErrorDepth n m e = (ErrorConstraints n m, MonadError e (ErrorDepth n m))++depthError :: forall n m a. ErrorConstraints n m => ErrorDepth n m a -> m a+depthError = depth @n @ExceptT @ErrorStack liftError  instance (ErrorStack m, Monoid w) => ErrorStack (AccumT w m) where 	type PopError (AccumT w m) = PopError m
Control/Monad/Stack/Fail.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Fail where +import Control.Monad.Fail+import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +30,14 @@ class Monad m => FailStack m where 	type PopFail m :: * -> * 	liftFail :: PopFail m a -> m a++type instance Pop MaybeT m = PopFail m+type FailDepth n m = IteratePop n MaybeT m+type FailConstraints n m = (KnownNat n, StackConstraints n MaybeT FailStack m)+type MonadFailDepth n m = (FailConstraints n m, MonadFail (FailDepth n m))++depthFail :: forall n m a. FailConstraints n m => FailDepth n m a -> m a+depthFail = depth @n @MaybeT @FailStack liftFail  instance (FailStack m, Monoid w) => FailStack (AccumT w m) where 	type PopFail (AccumT w m) = PopFail m
+ Control/Monad/Stack/Internal.hs view
@@ -0,0 +1,62 @@+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+module Control.Monad.Stack.Internal+	( module Control.Monad.Stack.Internal+	, module GHC.TypeNats+	) where++import Data.Constraint+import Data.Kind+import Data.Proxy+import Data.Type.Equality+import GHC.TypeNats+import Unsafe.Coerce++type family Pop (c :: k) (m :: k') :: k'++type family IteratePop (n :: Nat) (c :: k) (m :: Type -> Type) :: Type -> Type where+	IteratePop 0 c m = m+	IteratePop n c m = IteratePop (n-1) c (Pop c m)++type family StackConstraints (n :: Nat) (c :: k) (cSucc :: k' -> Constraint) (m :: k') :: Constraint where+	StackConstraints 0 c cSucc m = ()+	StackConstraints n c cSucc m = (cSucc m, StackConstraints (n-1) c cSucc (Pop c m))++predNat :: forall n. KnownNat n => Either (n :~: 0) (Dict (KnownNat (n-1)))+predNat = case sameNat (Proxy @0) (Proxy @n) of+	Just Refl -> Left Refl+	Nothing -> case someNatVal (natVal @n Proxy - 1) of+		SomeNat p -> Right (unsafeCoerce (wrap p))+	where+	wrap :: KnownNat n' => Proxy n' -> Dict (KnownNat n')+	wrap _ = Dict++nonZeroNat :: forall n c cSucc m a.+	KnownNat (n-1) =>+	( IteratePop n c m a :~: IteratePop (n-1) c (Pop c m) a+	, StackConstraints n c cSucc m :~: (cSucc m, StackConstraints (n-1) c cSucc (Pop c m))+	)+nonZeroNat = unsafeCoerce (Refl, Refl)++depth :: forall n c cSucc m a.+	(KnownNat n, StackConstraints n c cSucc m) =>+	(forall m. cSucc m => Pop c m a -> m a) ->+	IteratePop n c m a ->+	m a+depth lift act = case predNat @n of+	Left Refl -> act+	Right Dict -> case nonZeroNat @n @c @cSucc @m of+		(Refl, Refl) -> lift (depth @(n-1) @c @cSucc lift act)++-- | ContT is polykinded, which leads to issues checking that ContT ~ ContT!+data ContTag
Control/Monad/Stack/Reader.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Reader where +import Control.Monad.Reader+import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +30,14 @@ class Monad m => ReaderStack m where 	type PopReader m :: * -> * 	liftReader :: PopReader m a -> m a++type instance Pop ReaderT m = PopReader m+type ReaderDepth n m = IteratePop n ReaderT m+type ReaderConstraints n m = (KnownNat n, StackConstraints n ReaderT ReaderStack m)+type MonadReaderDepth n m r = (ReaderConstraints n m, MonadReader r (ReaderDepth n m))++depthReader :: forall n m a. ReaderConstraints n m => ReaderDepth n m a -> m a+depthReader = depth @n @ReaderT @ReaderStack liftReader  instance (ReaderStack m, Monoid w) => ReaderStack (AccumT w m) where 	type PopReader (AccumT w m) = PopReader m
Control/Monad/Stack/Select.hs view
@@ -1,8 +1,13 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Select where +import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +28,13 @@ class Monad m => SelectStack m where 	type PopSelect m :: * -> * 	liftSelect :: PopSelect m a -> m a++type instance Pop SelectT m = PopSelect m+type SelectDepth n m = IteratePop n SelectT m+type SelectConstraints n m = (KnownNat n, StackConstraints n SelectT SelectStack m)++depthSelect :: forall n m a. SelectConstraints n m => SelectDepth n m a -> m a+depthSelect = depth @n @SelectT @SelectStack liftSelect  instance (SelectStack m, Monoid w) => SelectStack (AccumT w m) where 	type PopSelect (AccumT w m) = PopSelect m
Control/Monad/Stack/State.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.State where +import Control.Monad.State+import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +30,14 @@ class Monad m => StateStack m where 	type PopState m :: * -> * 	liftState :: PopState m a -> m a++type instance Pop SL.StateT m = PopState m+type StateDepth n m = IteratePop n SL.StateT m+type StateConstraints n m = (KnownNat n, StackConstraints n SL.StateT StateStack m)+type MonadStateDepth n m s = (StateConstraints n m, MonadState s (StateDepth n m))++depthState :: forall n m a. StateConstraints n m => StateDepth n m a -> m a+depthState = depth @n @SL.StateT @StateStack liftState  instance (StateStack m, Monoid w) => StateStack (AccumT w m) where 	type PopState (AccumT w m) = PopState m
Control/Monad/Stack/Writer.hs view
@@ -1,8 +1,15 @@-{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE AllowAmbiguousTypes #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE KindSignatures #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}  module Control.Monad.Stack.Writer where +import Control.Monad.Writer+import Control.Monad.Stack.Internal import Control.Monad.Trans.Accum import Control.Monad.Trans.Class import Control.Monad.Trans.Cont@@ -23,6 +30,14 @@ class Monad m => WriterStack m where 	type PopWriter m :: * -> * 	liftWriter :: PopWriter m a -> m a++type instance Pop WL.WriterT m = PopWriter m+type WriterDepth n m = IteratePop n WL.WriterT m+type WriterConstraints n m = (KnownNat n, StackConstraints n WL.WriterT WriterStack m)+type MonadWriterDepth n m w = (WriterConstraints n m, MonadWriter w (WriterDepth n m))++depthWriter :: forall n m a. WriterConstraints n m => WriterDepth n m a -> m a+depthWriter = depth @n @WL.WriterT @WriterStack liftWriter  instance (WriterStack m, Monoid w) => WriterStack (AccumT w m) where 	type PopWriter (AccumT w m) = PopWriter m
effect-stack.cabal view
@@ -1,5 +1,5 @@ name:                effect-stack-version:             0.1.0.1+version:             0.2 synopsis:            Reducing the pain of transformer stacks with duplicated effects description:         When using monad transformer stacks, it is common to want                      to mix effects from various layers of the stack within a@@ -42,7 +42,16 @@                      @(StateStack m, MonadState inner (PopState m)) => m ()@                      .                      to access the state from underneath the outermost-                     @StateT@, no matter how deep it is.+                     @StateT@, no matter how deep it is. A sample action of+                     that type would be @liftState get >> return ()@.+                     Equivalently, there is+                     some mild sugar that lets you write the type+                     .+                     @MonadStateDepth 1 m inner => m ()@+                     .+                     to mean the same thing as the previous type, and+                     @depthState \@1 get >> return ()@ to mean the same thing+                     as the previous action. license:             BSD3 license-file:        LICENSE author:              Daniel Wagner@@ -51,7 +60,7 @@ category:            Control build-type:          Simple extra-source-files:  ChangeLog.md-cabal-version:       >=1.10+cabal-version:       >=2.0  source-repository head   type:     git@@ -63,17 +72,28 @@                        Control.Monad.Stack.Cont,                        Control.Monad.Stack.Except,                        Control.Monad.Stack.Fail,+                       Control.Monad.Stack.Internal,                        Control.Monad.Stack.Reader,                        Control.Monad.Stack.Select,                        Control.Monad.Stack.State,                        Control.Monad.Stack.Writer-  -- other-modules:   other-extensions:+                       AllowAmbiguousTypes,+                       ConstraintKinds,+                       DataKinds,+                       FlexibleContexts,                        KindSignatures,-                       TypeFamilies+                       PolyKinds,+                       RankNTypes,+                       ScopedTypeVariables,+                       TypeApplications,+                       TypeFamilies,+                       TypeOperators,+                       UndecidableInstances   build-depends:-                       base >=4.12 && <4.13,-                       transformers >=0.5 && <0.6-  -- hs-source-dirs:+                       base ^>=4.12,+                       constraints ^>=0.11,+                       mtl ^>= 2.2,+                       transformers ^>=0.5   default-language:    Haskell2010   ghc-options:         -fno-warn-tabs