cleff 0.2.0.0 → 0.2.1.0

raw patch · 11 files changed

+261/−48 lines, 11 filesdep −transformersPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: transformers

API changes (from Hackage documentation)

Files

• CHANGELOG.md +11/−0
• cleff.cabal +2/−4
• src/Cleff.hs +1/−0
• src/Cleff/Fresh.hs +29/−6
• src/Cleff/Input.hs +29/−4
• src/Cleff/Internal/Base.hs +2/−7
• src/Cleff/Internal/Instances.hs +80/−0
• src/Cleff/Internal/Interpret.hs +8/−0
• src/Cleff/Internal/Monad.hs +36/−19
• src/Cleff/Output.hs +19/−2
• src/Cleff/State.hs +44/−6

@@ -1,5 +1,16 @@ # Changelog for `cleff` +## 0.2.1.0 (2022-02-13)++### Added++- Lifted convenience instances of `Bounded`, `Num`, `Fractional`, `Floating` and `IsString` for `Eff`+- `MonadZip` instance from the `MonadComprehensions` extension for `Eff`+- `freshEnumToState` and `runFreshAtomicCounter` for `Fresh`+- `inputToReader`, `mapInput` and `bindInput` for `Input`+- `mapOutput` and `bindOutput` for `Output`+- `runStateIORef`, `runStateMVar` and `runStateTVar` for `State`+ ## 0.2.0.0 (2022-02-06)  ### Changed

@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           cleff-version:        0.2.0.0+version:        0.2.1.0 synopsis:       Fast and concise extensible effects description:    Please see the README on GitHub at <https://github.com/re-xyr/cleff#readme> category:       Control, Effect, Language@@ -46,6 +46,7 @@       Cleff.Internal.Any       Cleff.Internal.Base       Cleff.Internal.Effect+      Cleff.Internal.Instances       Cleff.Internal.Interpret       Cleff.Internal.Monad       Cleff.Internal.TH@@ -100,7 +101,6 @@     , rec-smallarray ==0.1.*     , template-haskell >=2.14 && <3     , th-abstraction >=0.2.11 && <0.5-    , transformers >=0.5 && <0.7     , transformers-base >=0.4.5 && <0.5     , unliftio >=0.2.8 && <0.3   if flag(dynamic-ioe)@@ -161,7 +161,6 @@     , rec-smallarray ==0.1.*     , template-haskell >=2.14 && <3     , th-abstraction >=0.2.11 && <0.5-    , transformers >=0.5 && <0.7     , transformers-base >=0.4.5 && <0.5     , unliftio >=0.2.8 && <0.3   if flag(dynamic-ioe)@@ -230,7 +229,6 @@     , rec-smallarray ==0.1.*     , template-haskell >=2.14 && <3     , th-abstraction >=0.2.11 && <0.5-    , transformers >=0.5 && <0.7     , transformers-base >=0.4.5 && <0.5     , unliftio >=0.2.8 && <0.3   if flag(dynamic-ioe)

@@ -57,6 +57,7 @@  import           Cleff.Internal.Base import           Cleff.Internal.Effect+import           Cleff.Internal.Instances () import           Cleff.Internal.Interpret import           Cleff.Internal.Monad import           Cleff.Internal.TH

@@ -11,12 +11,14 @@   , -- * Operations     fresh   , -- * Interpretations-    freshIntToState, runFreshUnique+    freshIntToState, runFreshAtomicCounter, runFreshUnique   ) where  import           Cleff+import           Cleff.Internal.Base  (thisIsPureTrustMe) import           Cleff.State-import           Data.Unique (Unique, newUnique)+import           Data.Atomics.Counter (incrCounter, newCounter)+import           Data.Unique          (Unique, newUnique)  -- * Effect @@ -30,13 +32,34 @@  -- * Interpretations --- | Interpret a @'Fresh' 'Int'@ effect in terms of @'State' 'Int'@.+-- | Interpret a @'Fresh' a@ in terms of @'State' a@ for any 'Enum'. Every time 'succ' is called to generate the next+-- value.+--+-- @since 0.2.1.0+freshEnumToState :: Enum a => Eff (Fresh a ': es) ~> Eff (State a ': es)+freshEnumToState = reinterpret \case+  Fresh -> state \s -> (s, succ s)+{-# INLINE freshEnumToState #-}++-- | Interpret a @'Fresh' 'Int'@ effect in terms of @'State' 'Int'@. This is a specialized version of+-- 'freshEnumToState'. freshIntToState :: Eff (Fresh Int ': es) ~> Eff (State Int ': es)-freshIntToState = reinterpret \case-  Fresh -> state \s -> (s, s + 1)+freshIntToState = freshEnumToState {-# INLINE freshIntToState #-} --- | Interpret a @'Fresh' 'Unique'@ effect in terms of IO actions.+-- | Interpret a @'Fresh' 'Int'@ effect in terms of a 'Data.Atomics.Counter.AtomicCounter'. This is usually faster+-- than 'runFreshUnique'.+--+-- @since 0.2.1.0+runFreshAtomicCounter :: Eff (Fresh Int ': es) ~> Eff es+runFreshAtomicCounter m = thisIsPureTrustMe do+  counter <- liftIO $ newCounter minBound+  reinterpret (\case+    Fresh -> liftIO $ incrCounter 1 counter) m+{-# INLINE runFreshAtomicCounter #-}++-- | Interpret a @'Fresh' 'Unique'@ effect in terms of IO actions. This is slower than 'runFreshAtomicCounter', but it+-- won't overflow on @'maxBound' :: 'Int'@. runFreshUnique :: IOE :> es => Eff (Fresh Unique ': es) ~> Eff es runFreshUnique = interpret \case   Fresh -> liftIO newUnique

@@ -11,10 +11,11 @@   , -- * Operations     input, inputs   , -- * Interpretations-    runInputConst, inputToListState, runInputEff+    runInputConst, inputToListState, inputToReader, runInputEff, mapInput, bindInput   ) where  import           Cleff+import           Cleff.Reader import           Cleff.State  -- * Effect@@ -42,13 +43,37 @@ -- | Run an 'Input' effect by going through a list of values. inputToListState :: Eff (Input (Maybe i) ': es) ~> Eff (State [i] ': es) inputToListState = reinterpret \case-  Input -> get >>= \case-    []      -> pure Nothing-    x : xs' -> Just x <$ put xs'+  Input -> state \case+    []     -> (Nothing, [])+    x : xs -> (Just x, xs) {-# INLINE inputToListState #-} +-- | Run an 'Input' in terms of a 'Reader'.+--+-- @since 0.2.1.0+inputToReader :: Eff (Input i ': es) ~> Eff (Reader i ': es)+inputToReader = reinterpret \case+  Input -> ask+{-# INLINE inputToReader #-}+ -- | Run an 'Input' effect by performing a computation for each input request. runInputEff :: Eff es i -> Eff (Input i ': es) ~> Eff es runInputEff m = interpret \case   Input -> m {-# INLINE runInputEff #-}++-- | Transform an 'Input' effect into another one already in the effect stack, by a pure function.+--+-- @since 0.2.1.0+mapInput :: Input i' :> es => (i' -> i) -> Eff (Input i ': es) ~> Eff es+mapInput f = interpret \case+  Input -> f <$> input+{-# INLINE mapInput #-}++-- | Transform an 'Input' effect into another one already in the effect stack, by an effectful computation.+--+-- @since 0.2.1.0+bindInput :: Input i' :> es => (i' -> Eff es i) -> Eff (Input i ': es) ~> Eff es+bindInput f = interpret \case+  Input -> f =<< input+{-# INLINE bindInput #-}

@@ -143,20 +143,15 @@ #endif {-# INLINE thisIsPureTrustMe #-} --- | Extract the 'IO' computation out of an 'Eff' given no effect remains on the stack.-runEff :: Eff '[] a -> IO a-runEff m = unEff m emptyEnv-{-# INLINE runEff #-}- -- | Unwrap an 'Eff' computation with side effects into an 'IO' computation, given that all effects other than 'IOE' are -- interpreted. runIOE :: Eff '[IOE] ~> IO-runIOE = runEff . thisIsPureTrustMe+runIOE m = unEff (thisIsPureTrustMe m) emptyEnv {-# INLINE runIOE #-}  -- | Unwrap a pure 'Eff' computation into a pure value, given that all effects are interpreted. runPure :: Eff '[] a -> a-runPure = unsafeDupablePerformIO . runEff+runPure m = unsafeDupablePerformIO $ unEff m emptyEnv {-# NOINLINE runPure #-}  -- * Effect interpretation

@@ -0,0 +1,80 @@+{-# OPTIONS_GHC -Wno-orphans #-}+-- |+-- Copyright: (c) 2021 Xy Ren+-- License: BSD3+-- Maintainer: xy.r@outlook.com+-- Stability: unstable+-- Portability: non-portable (GHC only)+--+-- This module contains lifted instances of some typeclasses for 'Eff' for convenience. They are all exported in the+-- "Cleff" module so you shouldn't need to import this module.+--+-- __This is an /internal/ module and its API may change even between minor versions.__ Therefore you should be+-- extra careful if you're to depend on this module.+module Cleff.Internal.Instances () where++import           Cleff.Internal.Monad (Eff)+import           Control.Applicative  (Applicative (liftA2))+import           Control.Monad.Zip    (MonadZip (munzip, mzipWith))+import           Data.String          (IsString (fromString))++-- | @since 0.2.1.0+instance Bounded a => Bounded (Eff es a) where+  minBound = pure minBound+  maxBound = pure maxBound++-- | @since 0.2.1.0+instance Num a => Num (Eff es a) where+  (+) = liftA2 (+)+  (-) = liftA2 (-)+  (*) = liftA2 (*)+  negate = fmap negate+  abs = fmap abs+  signum = fmap signum+  fromInteger = pure . fromInteger++-- | @since 0.2.1.0+instance Fractional a => Fractional (Eff es a) where+  (/) = liftA2 (/)+  recip = fmap recip+  fromRational = pure . fromRational++-- | @since 0.2.1.0+instance Floating a => Floating (Eff es a) where+  pi = pure pi+  exp = fmap exp+  log = fmap log+  sqrt = fmap sqrt+  (**) = liftA2 (**)+  logBase = liftA2 logBase+  sin = fmap sin+  cos = fmap cos+  tan = fmap tan+  asin = fmap asin+  acos = fmap acos+  atan = fmap atan+  sinh = fmap sinh+  cosh = fmap cosh+  tanh = fmap tanh+  asinh = fmap asinh+  acosh = fmap acosh+  atanh = fmap atanh++-- | @since 0.2.1.0+instance Semigroup a => Semigroup (Eff es a) where+  (<>) = liftA2 (<>)++-- | @since 0.2.1.0+instance Monoid a => Monoid (Eff es a) where+  mempty = pure mempty++-- | @since 0.2.1.0+instance IsString a => IsString (Eff es a) where+  fromString = pure . fromString++-- | Compatibility instance for @MonadComprehensions@.+--+-- @since 0.2.1.0+instance MonadZip (Eff es) where+  mzipWith = liftA2+  munzip x = (fst <$> x, snd <$> x)

@@ -69,21 +69,29 @@ -- However, note that this function is suited for transforming an existing interpreter into a reinterpreter; if you -- want to define a reinterpreter from scratch, you should still prefer 'reinterpret', which is both easier to use and -- more efficient.+--+-- @since 0.2.0.0 raiseUnder :: ∀ e' e es. Eff (e ': es) ~> Eff (e ': e' ': es) raiseUnder = raiseNUnder @'[e']  -- | Like 'raiseUnder', but allows introducing multiple effects. This function requires @TypeApplications@.+--+-- @since 0.2.0.0 raiseNUnder :: ∀ es' e es. KnownList es' => Eff (e ': es) ~> Eff (e ': es' ++ es) raiseNUnder = raiseNUnderN @es' @'[e]  -- | Like 'raiseUnder', but allows introducing the effect under multiple effects. This function requires -- @TypeApplications@.+--+-- @since 0.2.0.0 raiseUnderN :: ∀ e es' es. KnownList es' => Eff (es' ++ es) ~> Eff (es' ++ e ': es) raiseUnderN = raiseNUnderN @'[e] @es' @es  -- | A generalization of both 'raiseUnderN' and 'raiseNUnder', allowing introducing multiple effects under multiple -- effects. This function requires @TypeApplications@ and is subject to serious type ambiguity; you most likely will -- need to supply all three type variables explicitly.+--+-- @since 0.2.0.0 raiseNUnderN :: ∀ es'' es' es. (KnownList es', KnownList es'') => Eff (es' ++ es) ~> Eff (es' ++ (es'' ++ es)) raiseNUnderN = adjust \re -> Rec.concat   (Rec.take @es' @(es'' ++ es) re) (Rec.drop @es'' @es (Rec.drop @es' @(es'' ++ es) re))

@@ -23,13 +23,12 @@  import           Cleff.Internal.Any import           Cleff.Internal.Effect-import           Control.Monad.Fix          (MonadFix)-import           Control.Monad.Trans.Reader (ReaderT (ReaderT))-import           Data.IntMap.Strict         (IntMap)-import qualified Data.IntMap.Strict         as Map-import           Data.Rec.SmallArray        (KnownList, Rec, Subset, pattern (:~:))-import qualified Data.Rec.SmallArray        as Rec-import           Type.Reflection            (Typeable, typeRep)+import           Control.Applicative   (Applicative (liftA2))+import           Control.Monad.Fix     (MonadFix (mfix))+import           Data.IntMap.Strict    (IntMap)+import qualified Data.IntMap.Strict    as Map+import           Data.Rec.SmallArray   (KnownList, Rec, Subset, pattern (:~:))+import qualified Data.Rec.SmallArray   as Rec  -- * The 'Eff' monad @@ -41,12 +40,6 @@ newtype InternalHandler e = InternalHandler   { runHandler :: ∀ es. e (Eff es) ~> Eff es } --- | @--- 'show' (handler :: 'InternalHandler' E) == "Handler E"--- @-instance Typeable e => Show (InternalHandler e) where-  showsPrec p _ = ("Handler " ++) . showsPrec p (typeRep @e)- -- | The extensible effect monad. A monad @'Eff' es@ is capable of performing any effect in the /effect stack/ @es@, -- which is a type-level list that holds all effects available. However, most of the times, for flexibility, @es@ -- should be a polymorphic type variable, and you should use the '(:>)' and '(:>>)' operators in constraints to@@ -62,9 +55,35 @@ newtype Eff es a = Eff { unEff :: Env es -> IO a }   -- ^ The effect monad receives an effect environment 'Env' that contains all effect handlers and produces an 'IO'   -- action.-  deriving newtype (Semigroup, Monoid)-  deriving (Functor, Applicative, Monad, MonadFix) via (ReaderT (Env es) IO) +instance Functor (Eff es) where+  fmap f (Eff x) = Eff (fmap f . x)+  {-# INLINE fmap #-}+  x <$ Eff y = Eff \es -> x <$ y es+  {-# INLINE (<$) #-}++instance Applicative (Eff es) where+  pure = Eff . const . pure+  {-# INLINE pure #-}+  Eff f <*> Eff x = Eff \es -> f es <*> x es+  {-# INLINE (<*>) #-}+  Eff x <*  Eff y = Eff \es -> x es <*  y es+  {-# INLINE (<*) #-}+  Eff x  *> Eff y = Eff \es -> x es  *> y es+  {-# INLINE (*>) #-}+  liftA2 f (Eff x) (Eff y) = Eff \es -> liftA2 f (x es) (y es)+  {-# INLINE liftA2 #-}++instance Monad (Eff es) where+  Eff x >>= f = Eff \es -> x es >>= \x' -> unEff (f x') es+  {-# INLINE (>>=) #-}+  (>>) = (*>)+  {-# INLINE (>>) #-}++instance MonadFix (Eff es) where+  mfix f = Eff \es -> mfix \x -> unEff (f x) es+  {-# INLINE mfix #-}+ -- * Effect environment  -- | The /effect environment/ that corresponds effects in the stack to their respective 'InternalHandler's. This@@ -81,10 +100,6 @@ -- | A pointer to 'InternalHandler' in an 'Env'. type role HandlerPtr nominal newtype HandlerPtr (e :: Effect) = HandlerPtr { unHandlerPtr :: Int }-  deriving newtype-    ( Eq  -- ^ Pointer equality.-    , Ord -- ^ An arbitrary total order on the pointers.-    )  -- | Create an empty 'Env' with no address allocated. emptyEnv :: Env '[]@@ -140,5 +155,7 @@ -- @ -- 'send' = 'sendVia' 'id' -- @+--+-- @since 0.2.0.0 sendVia :: e :> es' => (Eff es ~> Eff es') -> e (Eff es) ~> Eff es' sendVia f e = Eff \es -> unEff (f (runHandler (readEnv es) e)) es

@@ -11,7 +11,7 @@   , -- * Operations     output   , -- * Interpretations-    outputToListState, outputToWriter, ignoreOutput, runOutputEff+    outputToListState, outputToWriter, ignoreOutput, runOutputEff, mapOutput, bindOutput   ) where  import           Cleff@@ -30,7 +30,8 @@  -- * Interpretations --- | Run an 'Output' effect by accumulating a list.+-- | Run an 'Output' effect by accumulating a list. Note that outputs are being prepended to the head of the list, so+-- in many cases you would want to 'reverse' the result. outputToListState :: Eff (Output o ': es) ~> Eff (State [o] ': es) outputToListState = reinterpret \case   Output x -> modify (x :)@@ -53,3 +54,19 @@ runOutputEff m = interpret \case   Output x -> m x {-# INLINE runOutputEff #-}++-- | Transform an 'Output' effect into another one already in the effect stack, by a pure function.+--+-- @since 0.2.1.0+mapOutput :: Output o' :> es => (o -> o') -> Eff (Output o ': es) ~> Eff es+mapOutput f = interpret \case+  Output x -> output $ f x+{-# INLINE mapOutput #-}++-- | Transform an 'Input' effect into another one already in the effect stack, by an effectful computation.+--+-- @since 0.2.1.0+bindOutput :: Output o' :> es => (o -> Eff es o') -> Eff (Output o ': es) ~> Eff es+bindOutput f = interpret \case+  Output x -> output =<< f x+{-# INLINE bindOutput #-}

@@ -11,15 +11,18 @@   , -- * Operations     get, put, state, gets, modify   , -- * Interpretations-    runState, zoom+    runState, runStateIORef, runStateMVar, runStateTVar, zoom   ) where  import           Cleff import           Cleff.Internal.Base+import           Control.Monad       (void) import           Data.Atomics        (atomicModifyIORefCAS) import           Data.Tuple          (swap) import           Lens.Micro          (Lens', (&), (.~), (^.))-import           UnliftIO.IORef      (newIORef, readIORef, writeIORef)+import           UnliftIO.IORef      (IORef, newIORef, readIORef, writeIORef)+import           UnliftIO.MVar       (MVar, modifyMVar, readMVar, swapMVar)+import           UnliftIO.STM        (TVar, atomically, readTVar, readTVarIO, writeTVar)  -- * Effect @@ -44,6 +47,13 @@  -- * Interpretations +handleIORef :: IOE :> es => IORef s -> Handler (State s) es+handleIORef rs = \case+  Get     -> readIORef rs+  Put s'  -> writeIORef rs s'+  State f -> liftIO $ atomicModifyIORefCAS rs (swap . f)+{-# INLINE handleIORef #-}+ -- | Run the 'State' effect. -- -- __Caveat__: The 'runState' interpreter is implemented with 'Data.IORef.IORef's and there is no way to do arbitrary@@ -58,13 +68,41 @@ runState :: s -> Eff (State s ': es) a -> Eff es (a, s) runState s m = thisIsPureTrustMe do   rs <- newIORef s-  x <- reinterpret (\case-    Get     -> readIORef rs-    Put s'  -> writeIORef rs s'-    State f -> liftIO $ atomicModifyIORefCAS rs (swap . f)) m+  x <- reinterpret (handleIORef rs) m   s' <- readIORef rs   pure (x, s') {-# INLINE runState #-}++-- | Run the 'State' effect in terms of operations on a supplied 'IORef'. The 'state' operation is atomic.+--+-- @since 0.2.1.0+runStateIORef :: IOE :> es => IORef s -> Eff (State s ': es) a -> Eff es a+runStateIORef rs = interpret $ handleIORef rs+{-# INLINE runStateIORef #-}++-- | Run the 'State' effect in terms of operations on a supplied 'MVar'.+--+-- @since 0.2.1.0+runStateMVar :: IOE :> es => MVar s -> Eff (State s ': es) a -> Eff es a+runStateMVar rs = interpret \case+  Get     -> readMVar rs+  Put s'  -> void $ swapMVar rs s'+  State f -> modifyMVar rs \s -> let (x, !s') = f s in pure (s', x)+{-# INLINE runStateMVar #-}++-- | Run the 'State' effect in terms of operations on a supplied 'TVar'.+--+-- @since 0.2.1.0+runStateTVar :: IOE :> es => TVar s -> Eff (State s ': es) a -> Eff es a+runStateTVar rs = interpret \case+  Get -> readTVarIO rs+  Put s' -> atomically $ writeTVar rs s'+  State f -> atomically do+    s <- readTVar rs+    let (x, !s') = f s+    writeTVar rs s'+    pure x+{-# INLINE runStateTVar #-}  -- | Run a 'State' effect in terms of a larger 'State' via a 'Lens''. zoom :: State t :> es => Lens' t s -> Eff (State s ': es) ~> Eff es