in-other-words 0.2.0.0 → 0.2.1.1

raw patch · 29 files changed

Files

• CHANGELOG.md +10/−0
• README.md +2/−0
• in-other-words.cabal +56/−16
• src/Control/Effect/BaseControl.hs +2/−0
• src/Control/Effect/Bracket.hs +2/−2
• src/Control/Effect/Carrier/Internal/Compose.hs +3/−3
• src/Control/Effect/Carrier/Internal/Interpret.hs +15/−13
• src/Control/Effect/Carrier/Internal/Intro.hs +1/−1
• src/Control/Effect/Carrier/Internal/Stepped.hs +4/−0
• src/Control/Effect/Debug.hs +2/−1
• src/Control/Effect/Error.hs +1/−1
• src/Control/Effect/Internal.hs +1/−1
• src/Control/Effect/Internal/Exceptional.hs +1/−1
• src/Control/Effect/Internal/Newtype.hs +3/−3
• src/Control/Effect/Internal/Optional.hs +2/−1
• src/Control/Effect/Internal/Reflection.hs +3/−2
• src/Control/Effect/Internal/Regional.hs +3/−1
• src/Control/Effect/Internal/Union.hs +1/−1
• src/Control/Effect/Internal/Utils.hs +5/−1
• src/Control/Effect/Internal/ViaAlg.hs +3/−2
• src/Control/Effect/Stepped.hs +15/−14
• src/Control/Effect/Type/Alt.hs +3/−1
• src/Control/Effect/Type/Embed.hs +3/−1
• src/Control/Effect/Type/ErrorIO.hs +2/−1
• src/Control/Effect/Type/Fail.hs +3/−1
• src/Control/Effect/Type/Throw.hs +3/−1
• src/Control/Effect/Type/Unlift.hs +52/−2
• src/Control/Monad/Trans/Free/Church/Alternate.hs +1/−1
• src/Control/Monad/Trans/List/Church.hs +3/−1

@@ -1,5 +1,15 @@ # Changelog for `in-other-words` +## 0.2.1.1 (2022-06-15)+### Non-breaking Changes+* GHC 9.2.3 compatiblity++## 0.2.1.0 (2021-11-05)+### Non-breaking Changes+* Added `hoistSteps`+* Added `threadBaseControlViaUnlift`+* GHC 9.0.1 compatiblity (thanks @berberman!)+ ## 0.2.0.0 (2021-01-30) ### Breaking Changes * `-Fast` interpretations of every continuation-related effect have been removed due

@@ -3,6 +3,8 @@ [![build GHC 8.6](https://github.com/KingoftheHomeless/in-other-words/workflows/build%20GHC%208.6/badge.svg)](https://github.com/KingoftheHomeless/in-other-words/actions?query=workflow%3A%22build+GHC+8.6%22) [![build GHC 8.8](https://github.com/KingoftheHomeless/in-other-words/workflows/build%20GHC%208.8/badge.svg)](https://github.com/KingoftheHomeless/in-other-words/actions?query=workflow%3A%22build+GHC+8.8%22) [![build GHC 8.10](https://github.com/KingoftheHomeless/in-other-words/workflows/build%20GHC%208.10/badge.svg)](https://github.com/KingoftheHomeless/in-other-words/actions?query=workflow%3A%22build+GHC+8.10%22)+[![build GHC 9.0.2](https://github.com/KingoftheHomeless/in-other-words/workflows/build%20GHC%209.0.2/badge.svg)](https://github.com/KingoftheHomeless/in-other-words/actions?query=workflow%3A%22build+GHC+9.0.2%22)+[![build GHC 9.2.3](https://github.com/KingoftheHomeless/in-other-words/workflows/build%20GHC%209.2.3/badge.svg)](https://github.com/KingoftheHomeless/in-other-words/actions?query=workflow%3A%22build+GHC+9.2.3%22)  - [Overview][] - [Features][]

@@ -1,19 +1,19 @@ cabal-version: 1.12
 --- This file has been generated from package.yaml by hpack version 0.33.0.+-- This file has been generated from package.yaml by hpack version 0.34.4. -- -- see: https://github.com/sol/hpack ----- hash: 94e61819ea6e924b216d8fa7fe755ab80100afa6a3ebf73d3da409a983481ce9+-- hash: cb8b99f7f5a97bd2225716b40c6c61d182c84c8f61b047561eff935b7da2e482  name:           in-other-words-version:        0.2.0.0+version:        0.2.1.1 synopsis:       A higher-order effect system where the sky's the limit description:    A low-boilerplate effect system with easy higher-order effects and very high expressive power category:       Control homepage:       https://github.com/KingoftheHomeless/in-other-words#readme author:         Love Waern-maintainer:     combiner8761@gmail.com+maintainer:     love.waern@gmail.com copyright:      BSD3 license:        BSD3 license-file:   LICENSE@@ -109,15 +109,35 @@       Paths_in_other_words   hs-source-dirs:       src-  default-extensions: BangPatterns ConstraintKinds DataKinds DerivingStrategies EmptyCase FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase PolyKinds QuantifiedConstraints RankNTypes ScopedTypeVariables StandaloneDeriving TypeApplications TypeOperators TypeFamilies UndecidableInstances+  default-extensions:+      BangPatterns+      ConstraintKinds+      DataKinds+      DerivingStrategies+      EmptyCase+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      PolyKinds+      QuantifiedConstraints+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      TypeApplications+      TypeOperators+      TypeFamilies+      UndecidableInstances   ghc-options: -Wall -haddock   build-depends:-      async >=2.2 && <2.3+      async ==2.2.*     , base >=4.7 && <5-    , exceptions >=0.10 && <0.11-    , monad-control >=1.0 && <1.1-    , mtl >=2.2 && <2.3-    , stm >=2.5 && <2.6+    , exceptions ==0.10.*+    , monad-control ==1.0.*+    , mtl ==2.2.*+    , stm ==2.5.*     , transformers >=0.5.6 && <0.6     , transformers-base >=0.4.5 && <0.5   default-language: Haskell2010@@ -134,19 +154,39 @@       Paths_in_other_words   hs-source-dirs:       test-  default-extensions: BangPatterns ConstraintKinds DataKinds DerivingStrategies EmptyCase FlexibleContexts FlexibleInstances FunctionalDependencies GADTs GeneralizedNewtypeDeriving LambdaCase PolyKinds QuantifiedConstraints RankNTypes ScopedTypeVariables StandaloneDeriving TypeApplications TypeOperators TypeFamilies UndecidableInstances+  default-extensions:+      BangPatterns+      ConstraintKinds+      DataKinds+      DerivingStrategies+      EmptyCase+      FlexibleContexts+      FlexibleInstances+      FunctionalDependencies+      GADTs+      GeneralizedNewtypeDeriving+      LambdaCase+      PolyKinds+      QuantifiedConstraints+      RankNTypes+      ScopedTypeVariables+      StandaloneDeriving+      TypeApplications+      TypeOperators+      TypeFamilies+      UndecidableInstances   ghc-options: -threaded -rtsopts -with-rtsopts=-N -O0   build-tool-depends:       hspec-discover:hspec-discover >=2.0   build-depends:-      async >=2.2 && <2.3+      async ==2.2.*     , base >=4.7 && <5-    , exceptions >=0.10 && <0.11+    , exceptions ==0.10.*     , hspec >=2.6.0 && <3     , in-other-words-    , monad-control >=1.0 && <1.1-    , mtl >=2.2 && <2.3-    , stm >=2.5 && <2.6+    , monad-control ==1.0.*+    , mtl ==2.2.*+    , stm ==2.5.*     , transformers >=0.5.6 && <0.6     , transformers-base >=0.4.5 && <0.5   default-language: Haskell2010

@@ -17,6 +17,7 @@     -- * Threading utilities   , threadBaseControlViaClass+  , threadBaseControlViaUnlift      -- * Combinators for 'Algebra's     -- Intended to be used for custom 'Carrier' instances when@@ -40,6 +41,7 @@ import Control.Effect.Type.Internal.BaseControl import Control.Effect.Internal.BaseControl import Control.Effect.Internal.Itself+import Control.Effect.Type.Unlift  import Control.Effect.Internal.Utils 

@@ -103,7 +103,7 @@ type BracketToIOC = InterpretPrimC BracketToIOH Bracket  --- | Run a 'Bracket' by effect that protects against+-- | Run a 'Bracket' effect that protects against -- any abortive computation of any effect, as well -- as any IO exceptions and asynchronous exceptions. --@@ -131,7 +131,7 @@  type BracketToIOUnsafeC = InterpretPrimC BracketToIOUnsafeH Bracket --- | Run a 'Bracket' by effect that protects against+-- | Run a 'Bracket' effect that protects against -- any abortive computation of any effect, as well -- as any IO exceptions and asynchronous exceptions. --

@@ -16,7 +16,7 @@ import Unsafe.Coerce  -- | Composition of monad/carrier transformers.-newtype ComposeT t (u :: (* -> *) -> * -> *) m a = ComposeT {+newtype ComposeT t (u :: (Type -> Type) -> Type -> Type) m a = ComposeT {     getComposeT :: t (u m) a   }   deriving ( Functor, Applicative, Monad@@ -135,13 +135,13 @@ -- such as InterpretSimpleC. -- -- So only with a left fold can we guarantee that the unsafeCoerce in runComposition is safe.-type family CompositionBaseT' acc ts :: (* -> *) -> * -> * where+type family CompositionBaseT' acc ts :: (Type -> Type) -> Type -> Type where   CompositionBaseT' acc '[] = acc   CompositionBaseT' acc (t ': ts) = CompositionBaseT' (ComposeT acc t) ts  type CompositionBaseT ts = CompositionBaseT' IdentityT ts -type family CompositionBaseM (ts :: [(* -> *) -> * -> *]) (m :: * -> *) where+type family CompositionBaseM (ts :: [(Type -> Type) -> Type -> Type]) (m :: Type -> Type) where   CompositionBaseM '[] m = m   CompositionBaseM (t ': ts) m = t (CompositionBaseM ts m) 

@@ -32,11 +32,11 @@  newtype     HandlerC-      (sHandler :: *)-      (sReform :: *)+      (sHandler :: Type)+      (sReform :: Type)       (r :: [Effect])       (p :: [Effect])-      (m :: * -> *) z (a :: *)+      (m :: Type -> Type) z (a :: Type)   = HandlerC { unHandlerC :: z a }   deriving (Functor, Applicative, Monad) via z @@ -45,7 +45,7 @@ instance (Carrier m, r ~ Derivs m, p ~ Prims m)       => Reifies (CarrierReform m)                  (ReifiedReformulation r p m) where-  reflect = ReifiedReformulation reformulate+  reflect = ReifiedReformulation $ \n alg -> reformulate n alg   {-# INLINE reflect #-}  @@ -94,7 +94,7 @@       HandlerC (n m)   {-# INLINE liftBase #-} -newtype InterpretPrimC (s :: *) (e :: Effect) (m :: * -> *) a =+newtype InterpretPrimC (s :: Type) (e :: Effect) (m :: Type -> Type) a =   InterpretPrimC {       unInterpretPrimC :: m a     }@@ -125,7 +125,7 @@ class ( RepresentationalEff e       , Carrier m       )-   => Handler (h :: *) e m where+   => Handler (h :: Type) e m where   effHandler :: EffHandler e m  @@ -204,7 +204,7 @@ -- See 'EffPrimHandler'. class ( RepresentationalEff e       , Carrier m-      ) => PrimHandler (h :: *) e m where+      ) => PrimHandler (h :: Type) e m where   effPrimHandler :: EffPrimHandler e m  instance ( Carrier m@@ -229,7 +229,7 @@     InterpretC $ unItself $ runEffly $ effHandler @h @e (coerce e)   {-# INLINEABLE algDerivs #-} -newtype InterpretC (h :: *) (e :: Effect) (m :: * -> *) a = InterpretC {+newtype InterpretC (h :: Type) (e :: Effect) (m :: Type -> Type) a = InterpretC {       unInterpretC :: m a     }   deriving ( Functor, Applicative, Monad@@ -275,19 +275,21 @@       (coerceHandler (effPrimHandler @h @e @m))   {-# INLINEABLE algDerivs #-} -data ViaReifiedH (s :: *)+data ViaReifiedH (s :: Type)  instance ( RepresentationalEff e          , Carrier m          , Reifies s (ReifiedHandler e m)-         ) => Handler (ViaReifiedH s) e m where+         )+        => Handler (ViaReifiedH s) e m where   effHandler = getReifiedHandler (reflect @s)   {-# INLINE effHandler #-}  instance ( RepresentationalEff e          , Carrier m          , Reifies s (ReifiedPrimHandler e m)-         ) => PrimHandler (ViaReifiedH s) e m where+         )+      => PrimHandler (ViaReifiedH s) e m where   effPrimHandler = getReifiedPrimHandler (reflect @s)   {-# INLINE effPrimHandler #-} @@ -301,7 +303,7 @@    . ReifiesPrimHandler s e m   => InterpretPrimC (ViaReifiedH s) e m a -newtype InterpretSimpleC (e :: Effect) (m :: * -> *) a = InterpretSimpleC {+newtype InterpretSimpleC (e :: Effect) (m :: Type -> Type) a = InterpretSimpleC {       unInterpretSimpleC :: ReaderT (ReifiedHandler e m) m a     }   deriving ( Functor, Applicative, Monad@@ -335,7 +337,7 @@         handler (coerce e)   {-# INLINEABLE reformulate #-} -newtype InterpretPrimSimpleC (e :: Effect) (m :: * -> *) a =+newtype InterpretPrimSimpleC (e :: Effect) (m :: Type -> Type) a =     InterpretPrimSimpleC {       unInterpretPrimSimpleC :: ReaderT (ReifiedPrimHandler e m) m a     }

@@ -18,7 +18,7 @@  newtype IntroC (top :: [Effect])                (new :: [Effect])-               (m :: * -> *)+               (m :: Type -> Type)                a     = IntroC { runIntroC :: m a }   deriving ( Functor, Applicative, Monad

@@ -95,6 +95,10 @@ liftSteps (Done a) = Done a liftSteps (More e c) = More e (lift . fmap liftSteps . c) +hoistSteps :: Functor n => (forall x. m x -> n x) -> Steps e m a -> Steps e n a+hoistSteps _ (Done a) = Done a+hoistSteps n (More e c) = More e (fmap (hoistSteps n) . n . c)+ -- | Execute all the steps of a computation. unsteps :: forall e m a          . ( FirstOrder e

@@ -2,11 +2,12 @@ module Control.Effect.Debug where
 
 import Control.Effect.Carrier
+import Data.Kind (Type)
 import GHC.TypeLits
 
 -- Type family needed to delay the TypeError until when 'debugEffects'
 -- is used.
-type family DebugEffects (m :: * -> *) :: k where
+type family DebugEffects (m :: Type -> Type) :: k where
   DebugEffects m = TypeError (     'Text "Control.Effect.Debug.debugEffects"
                              ':$$: 'Text "Derivs: " ':<>: 'ShowType (Derivs m)
                              ':$$: 'Text "Prims:  " ':<>: 'ShowType (Prims m)

@@ -76,7 +76,7 @@   throw :: Eff (Throw e) m => e -> m a-throw = send . Throw+throw = send .# Throw {-# INLINE throw #-}  catch :: Eff (Catch e) m => m a -> (e -> m a) -> m a

@@ -142,7 +142,7 @@ send = algDerivs . inj {-# INLINE send #-} -deriving via (m :: * -> *) instance Carrier m => Carrier (IdentityT m)+deriving via (m :: Type -> Type) instance Carrier m => Carrier (IdentityT m)  -- | A constraint that @'Prims' m@ satisfies all the constraints in the list -- @cs@.

@@ -71,7 +71,7 @@ which is just noise in this case.
 -}
 
-newtype ExceptionallyC (eff :: Effect) (exc :: *) m a = ExceptionallyC {
+newtype ExceptionallyC (eff :: Effect) (exc :: Type) m a = ExceptionallyC {
     unExceptionallyC :: m a
   }
   deriving ( Functor, Applicative, Monad

@@ -27,7 +27,7 @@ newtype WrapC (e :: Effect)               (e' :: Effect)               m-              (a :: *) = WrapC { unWrapC :: m a }+              (a :: Type) = WrapC { unWrapC :: m a }   deriving ( Functor, Applicative, Monad            , Alternative, MonadPlus            , MonadFix, MonadFail, MonadIO@@ -89,7 +89,7 @@  newtype UnwrapC (e :: Effect)                 m-                (a :: *) = UnwrapC { unUnwrapC :: m a }+                (a :: Type) = UnwrapC { unUnwrapC :: m a }   deriving ( Functor, Applicative, Monad            , Alternative, MonadPlus            , MonadFix, MonadFail, MonadIO@@ -119,7 +119,7 @@  newtype UnwrapTopC (e :: Effect)                 m-                (a :: *) = UnwrapTopC { unUnwrapTopC :: m a }+                (a :: Type) = UnwrapTopC { unUnwrapTopC :: m a }   deriving ( Functor, Applicative, Monad            , Alternative, MonadPlus            , MonadFix, MonadFail, MonadIO

@@ -12,6 +12,7 @@  import Control.Effect.Type.Optional +import Data.Kind (Type)  newtype HoistOptionCall b a = HoistOptionCall (forall x. (a -> x) -> b x -> b x)   deriving (Functor)@@ -19,7 +20,7 @@ -- | A useful specialization of 'Optional' where the functor is -- @'HoistOptionCall' b@. From this, you can derive -- 'Control.Effect.Optional.hoistOption'.-type HoistOption (b :: * -> *) = Optional (HoistOptionCall b)+type HoistOption (b :: Type -> Type) = Optional (HoistOptionCall b)  data HoistOptionH 

@@ -8,6 +8,7 @@   ) where
 
 import Unsafe.Coerce
+import Data.Kind (Type)
 import Data.Proxy
 
 newtype Tagged s a = Tagged { getTagged :: a }
@@ -24,10 +25,10 @@ newtype Magic a r = Magic (Reifies Skolem a => Tagged Skolem r)
 
 
-reifyTagged :: forall a r. a -> (forall (s :: *). Reifies s a => Tagged s r) -> r
+reifyTagged :: forall a r. a -> (forall (s :: Type). Reifies s a => Tagged s r) -> r
 reifyTagged a k = unsafeCoerce (Magic k :: Magic a r) a
 {-# INLINE reifyTagged #-}
 
-reify :: forall a r. a -> (forall (s :: *) pr. (pr ~ Proxy, Reifies s a) => pr s -> r) -> r
+reify :: forall a r. a -> (forall (s :: Type) pr. (pr ~ Proxy, Reifies s a) => pr s -> r) -> r
 reify a k = reifyTagged a (unproxy k)
 {-# INLINE reify #-}

@@ -11,12 +11,14 @@  import Control.Monad.Trans.Control +import Data.Kind (Type)+ newtype HoistCall b = HoistCall (forall x. b x -> b x)  -- | A useful specialization of 'Regional' where the -- constant type is @'HoistCall' b@. From this, -- you can derive 'Control.Effect.Regional.hoist'.-type Hoist (b :: * -> *) = Regional (HoistCall b)+type Hoist (b :: Type -> Type) = Regional (HoistCall b)  data HoistH 

@@ -21,7 +21,7 @@ --   Output :: o -> InOut i o m () -- @ ---type Effect = (* -> *) -> * -> *+type Effect = (Type -> Type) -> Type -> Type  -- | An effect for collecting multiple effects into one effect. --

@@ -1,6 +1,10 @@-module Control.Effect.Internal.Utils where
+module Control.Effect.Internal.Utils
+  ( Type,
+    module Control.Effect.Internal.Utils
+  ) where
 
 import Data.Coerce
+import Data.Kind (Type)
 
 infixr 9 #.
 (#.) :: Coercible c b => (b -> c) -> (a -> b) -> (a -> c)

@@ -1,11 +1,12 @@ module Control.Effect.Internal.ViaAlg where
 
-import Data.Coerce
 import Control.Effect.Internal.Union
+import Data.Coerce
+import Data.Kind (Type)
 
 type RepresentationalT = RepresentationalEff
 
-newtype ViaAlg (s :: *) (e :: Effect) m a = ViaAlg {
+newtype ViaAlg (s :: Type) (e :: Effect) m a = ViaAlg {
     unViaAlg :: m a
   }
   deriving (Functor, Applicative, Monad)

@@ -1,14 +1,15 @@-module Control.Effect.Stepped
-  ( SteppedC
-  , Steps(..)
-  , steps
-  , unsteps
-  , liftSteps
-
-  , FirstOrder
-
-    -- Threading constraints
-  , SteppedThreads
-  ) where
-
-import Control.Effect.Carrier.Internal.Stepped
+module Control.Effect.Stepped+  ( SteppedC+  , Steps(..)+  , steps+  , unsteps+  , liftSteps+  , hoistSteps++  , FirstOrder++    -- Threading constraints+  , SteppedThreads+  ) where++import Control.Effect.Carrier.Internal.Stepped

@@ -1,6 +1,8 @@ {-# OPTIONS_HADDOCK not-home #-} module Control.Effect.Type.Alt where +import Data.Kind (Type)+ -- | An effect corresponding to the -- 'Control.Applicative.Alternative' type class. --@@ -14,6 +16,6 @@ -- how it interprets 'Alt'. This means you can use -- an 'Alt' interpreter to locally gain access to an 'Control.Applicative.Alternative' -- instance inside of application code.-data Alt (m :: * -> *) a where+data Alt (m :: Type -> Type) a where   Empty :: Alt m a   Alt   :: m a -> m a -> Alt m a

@@ -1,6 +1,8 @@ {-# OPTIONS_HADDOCK not-home #-}
 module Control.Effect.Type.Embed where
 
+import Data.Kind (Type)
+
 -- | An effect for embedding actions of a base monad into the current one.
-newtype Embed b (m :: * -> *) a where
+newtype Embed b (m :: Type -> Type) a where
   Embed :: { unEmbed :: b a } -> Embed b m a

@@ -2,8 +2,9 @@ module Control.Effect.Type.ErrorIO where
 
 import Control.Exception
+import Data.Kind (Type)
 
 -- | An effect for throwing and catching 'IO'-based exceptions.
-data ErrorIO (m :: * -> *) a where
+data ErrorIO (m :: Type -> Type) a where
   ThrowIO :: Exception e => e -> ErrorIO m a
   CatchIO :: Exception e => m a -> (e -> m a) -> ErrorIO m a

@@ -1,6 +1,8 @@ {-# OPTIONS_HADDOCK not-home #-} module Control.Effect.Type.Fail where +import Data.Kind (Type)+ -- | An effect corresponding to the 'Control.Monad.Fail.MonadFail' type class. -- -- 'Control.Effect.Effly''s 'Control.Monad.Fail.MonadFail' instance is based@@ -12,5 +14,5 @@ -- how it interprets 'Fail'. This means you can use -- an 'Fail' interpreter to locally gain access to an 'Control.Monad.Fail.MonadFail' -- instance inside of application code.-newtype Fail (m :: * -> *) (a :: *) where+newtype Fail (m :: Type -> Type) (a :: Type) where   Fail :: String -> Fail m a

@@ -1,7 +1,9 @@ {-# OPTIONS_HADDOCK not-home #-} module Control.Effect.Type.Throw where +import Data.Kind (Type)+ -- | An effect for throwing exceptions of type @e@.-newtype Throw e (m :: * -> *) (a :: *) where+newtype Throw e (m :: Type -> Type) (a :: Type) where   Throw :: e -> Throw e m a 

@@ -1,3 +1,4 @@+{-# LANGUAGE MagicHash #-} {-# OPTIONS_HADDOCK not-home #-} module Control.Effect.Type.Unlift  ( -- * Effects@@ -5,6 +6,7 @@     -- Threading utilities  , threadUnliftViaClass+ , threadBaseControlViaUnlift     -- 'MonadBaseControlPure' and 'MonadTransControlPure'  , MonadBaseControlPure@@ -14,7 +16,13 @@  , unliftT  ) where +import GHC.Exts (Proxy#, proxy#)+import Data.Coerce import Control.Effect.Internal.Union+import Control.Effect.Internal.Utils+import Control.Effect.Type.Internal.BaseControl+import Control.Monad.Base+import Control.Monad.Trans import Control.Monad.Trans.Control import Control.Monad.Trans.Reader @@ -88,8 +96,9 @@ newtype Unlift b :: Effect where   Unlift :: forall b m a. ((forall x. m x -> b x) -> b a) -> Unlift b m a --- | A valid definition of 'threadEff' for a @'ThreadsEff' ('Unlift' b) t@ instance,--- given that @t@ is a 'MonadTransControl' where @'StT' t a ~ a@ holds for all @a@.+-- | A valid definition of 'threadEff' for a @'ThreadsEff' ('Unlift' b) t@+-- instance, given that @t@ is a 'MonadTransControl' where @'StT' t a ~ a@ holds+-- for all @a@. threadUnliftViaClass :: forall b t m a                       . (MonadTransControlPure t, Monad m)                      => (forall x. Unlift b m x -> m x)@@ -97,6 +106,47 @@ threadUnliftViaClass alg (Unlift main) = unliftT $ \lowerT ->   alg $ Unlift $ \lowerM -> main (lowerM . lowerT) {-# INLINE threadUnliftViaClass #-}++-- | A valid definition of 'threadEff' for a @'ThreadsEff' ('BaseControl' b) t@+-- instance, given that @t@ threads @'Unlift' z@ for any 'Monad' @z@.+threadBaseControlViaUnlift :: forall b t m a+                            . ( Monad m+                              , MonadTrans t+                              , forall z. Monad z => Monad (t z)+                              ,    forall z+                                 . Coercible z m+                                => Coercible (t z) (t m)+                              , forall z. Monad z => ThreadsEff t (Unlift z)+                              )+                           => (forall x. BaseControl b m x -> m x)+                           -> BaseControl b (t m) a -> t m a+threadBaseControlViaUnlift alg (GainBaseControl main) =+    lift $ alg $ GainBaseControl $ \(_ :: Proxy# z) ->+      main (proxy# :: Proxy# (Unlifted t z))+{-# INLINE threadBaseControlViaUnlift #-}++newtype Unlifted t m a = Unlifted { unUnlifted :: t m a }+  deriving (Functor, Applicative, Monad)+  deriving MonadTrans++instance (MonadBase b m, MonadTrans t, Monad (t m))+      => MonadBase b (Unlifted t m) where+  liftBase = lift . liftBase+  {-# INLINE liftBase #-}++instance (MonadBaseControl b m, MonadTrans t, ThreadsEff t (Unlift m),+          Monad (t m))+      => MonadBaseControl b (Unlifted t m) where+  type StM (Unlifted t m) a = StM m a++  liftBaseWith main =+    Unlifted $ threadEff (\(Unlift main') -> main' id) $ Unlift $ \lower ->+      liftBaseWith $ \run_it -> main $ run_it . lower .# unUnlifted+  {-# INLINE liftBaseWith #-}++  restoreM = Unlifted #. lift . restoreM+  {-# INLINE restoreM #-}+  instance ThreadsEff (ReaderT i) (Unlift b) where   threadEff alg (Unlift main) = ReaderT $ \s ->

@@ -14,7 +14,7 @@ import Control.Effect.Type.Optional import Control.Monad.Catch hiding (handle) -newtype FreeT f (m :: * -> *) a = FreeT {+newtype FreeT f (m :: Type -> Type) a = FreeT {     unFreeT :: forall r              . (forall x. f x -> (x -> m r) -> m r)             -> (a -> m r) -> m r

@@ -7,6 +7,8 @@ import qualified Control.Monad.Catch as C import qualified Control.Monad.Fail as Fail +import Data.Kind (Type)+ import Control.Effect.Carrier  import Control.Effect.Type.ListenPrim@@ -16,7 +18,7 @@ import Control.Effect.Type.Unravel import Control.Effect.Type.ReaderPrim -newtype ListT (m :: * -> *) a = ListT {+newtype ListT (m :: Type -> Type) a = ListT {   unListT :: forall r            . (a -> m r -> m r)           -> m r -- lose