commit
6dc3043254
|
@ -0,0 +1,33 @@
|
||||||
|
steps:
|
||||||
|
- simple_align:
|
||||||
|
cases: true
|
||||||
|
top_level_patterns: true
|
||||||
|
records: true
|
||||||
|
|
||||||
|
- imports:
|
||||||
|
align: file
|
||||||
|
list_align: after_alias
|
||||||
|
pad_module_names: false
|
||||||
|
long_list_align: new_line_multiline
|
||||||
|
empty_list_align: inherit
|
||||||
|
list_padding: 2
|
||||||
|
separate_lists: false
|
||||||
|
space_surround: false
|
||||||
|
|
||||||
|
- language_pragmas:
|
||||||
|
style: vertical
|
||||||
|
align: false
|
||||||
|
remove_redundant: true
|
||||||
|
|
||||||
|
- tabs:
|
||||||
|
spaces: 2
|
||||||
|
|
||||||
|
- trailing_whitespace: {}
|
||||||
|
|
||||||
|
columns: 120
|
||||||
|
|
||||||
|
newline: native
|
||||||
|
|
||||||
|
language_extensions:
|
||||||
|
- FlexibleContexts
|
||||||
|
- MultiParamTypeClasses
|
|
@ -33,7 +33,7 @@ library
|
||||||
Control.Effect.Exception
|
Control.Effect.Exception
|
||||||
build-depends:
|
build-depends:
|
||||||
base >= 4.7 && < 5
|
base >= 4.7 && < 5
|
||||||
, fused-effects >= 1
|
, fused-effects >= 1.1
|
||||||
, transformers >= 0.4 && < 0.6
|
, transformers >= 0.4 && < 0.6
|
||||||
|
|
||||||
test-suite test
|
test-suite test
|
||||||
|
|
|
@ -1,4 +1,12 @@
|
||||||
{-# LANGUAGE FlexibleInstances, GeneralizedNewtypeDeriving, MultiParamTypeClasses, RankNTypes, TypeOperators, UndecidableInstances #-}
|
{-# LANGUAGE FlexibleInstances #-}
|
||||||
|
{-# LANGUAGE GADTs #-}
|
||||||
|
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
|
||||||
|
{-# LANGUAGE MultiParamTypeClasses #-}
|
||||||
|
{-# LANGUAGE RankNTypes #-}
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
{-# LANGUAGE TypeApplications #-}
|
||||||
|
{-# LANGUAGE TypeOperators #-}
|
||||||
|
{-# LANGUAGE UndecidableInstances #-}
|
||||||
|
|
||||||
{- | A carrier for the 'State' effect. It uses an 'IORef' internally to handle its state, and thus is safe to use with "Control.Carrier.Resource". Underlying 'IORef' operations are performed with 'readIORef' and 'writeIORef'.
|
{- | A carrier for the 'State' effect. It uses an 'IORef' internally to handle its state, and thus is safe to use with "Control.Carrier.Resource". Underlying 'IORef' operations are performed with 'readIORef' and 'writeIORef'.
|
||||||
|
|
||||||
|
@ -14,11 +22,11 @@ module Control.Carrier.State.IORef
|
||||||
, module Control.Effect.State
|
, module Control.Effect.State
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Applicative (Alternative (..))
|
|
||||||
import Control.Algebra
|
import Control.Algebra
|
||||||
|
import Control.Applicative (Alternative(..))
|
||||||
import Control.Carrier.Reader
|
import Control.Carrier.Reader
|
||||||
import Control.Effect.State
|
import Control.Effect.State
|
||||||
import Control.Monad (MonadPlus (..))
|
import Control.Monad (MonadPlus(..))
|
||||||
import qualified Control.Monad.Fail as Fail
|
import qualified Control.Monad.Fail as Fail
|
||||||
import Control.Monad.Fix
|
import Control.Monad.Fix
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
|
@ -62,11 +70,12 @@ execState s = fmap fst . runState s
|
||||||
newtype StateC s m a = StateC { runStateC :: ReaderC (IORef s) m a }
|
newtype StateC s m a = StateC { runStateC :: ReaderC (IORef s) m a }
|
||||||
deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)
|
deriving (Alternative, Applicative, Functor, Monad, Fail.MonadFail, MonadFix, MonadIO, MonadPlus)
|
||||||
|
|
||||||
instance (MonadIO m, Algebra sig m, Effect sig) => Algebra (State s :+: sig) (StateC s m) where
|
instance (MonadIO m, Algebra sig m) => Algebra (State s :+: sig) (StateC s m) where
|
||||||
alg (L act) = do
|
alg hdl sig ctx = case sig of
|
||||||
ref <- StateC ask
|
L act -> do
|
||||||
case act of
|
ref <- StateC (ask @(IORef s))
|
||||||
Put s k -> liftIO (writeIORef ref s) *> k
|
(<$ ctx) <$> case act of
|
||||||
Get k -> liftIO (readIORef ref) >>= k
|
Put s -> liftIO (writeIORef ref s)
|
||||||
alg (R other) = StateC (alg (R (handleCoercible other)))
|
Get -> liftIO (readIORef ref)
|
||||||
|
R other -> StateC (alg (runStateC . hdl) (R other) ctx)
|
||||||
{-# INLINE alg #-}
|
{-# INLINE alg #-}
|
||||||
|
|
|
@ -92,13 +92,13 @@ throwTo thread = sendM . Exc.throwTo thread
|
||||||
--
|
--
|
||||||
-- @since 1.0.0.0
|
-- @since 1.0.0.0
|
||||||
catch :: (Exc.Exception e, Has (Lift IO) sig m) => m a -> (e -> m a) -> m a
|
catch :: (Exc.Exception e, Has (Lift IO) sig m) => m a -> (e -> m a) -> m a
|
||||||
catch m h = liftWith $ \ ctx run -> run (m <$ ctx) `Exc.catch` (run . (<$ ctx) . h)
|
catch m h = liftWith $ \ run ctx -> run (m <$ ctx) `Exc.catch` (run . (<$ ctx) . h)
|
||||||
|
|
||||||
-- | See @"Control.Exception".'Exc.catches'@.
|
-- | See @"Control.Exception".'Exc.catches'@.
|
||||||
--
|
--
|
||||||
-- @since 1.0.0.0
|
-- @since 1.0.0.0
|
||||||
catches :: Has (Lift IO) sig m => m a -> [Handler m a] -> m a
|
catches :: Has (Lift IO) sig m => m a -> [Handler m a] -> m a
|
||||||
catches m hs = liftWith $ \ ctx run ->
|
catches m hs = liftWith $ \ run ctx ->
|
||||||
Exc.catches (run (m <$ ctx)) (map (\ (Handler h) -> Exc.Handler (run . (<$ ctx) . h)) hs)
|
Exc.catches (run (m <$ ctx)) (map (\ (Handler h) -> Exc.Handler (run . (<$ ctx) . h)) hs)
|
||||||
|
|
||||||
-- | See @"Control.Exception".'Exc.Handler'@.
|
-- | See @"Control.Exception".'Exc.Handler'@.
|
||||||
|
@ -118,7 +118,7 @@ catchJust
|
||||||
-> m a
|
-> m a
|
||||||
-> (b -> m a)
|
-> (b -> m a)
|
||||||
-> m a
|
-> m a
|
||||||
catchJust p m h = liftWith $ \ ctx run -> Exc.catchJust p (run (m <$ ctx)) (run . (<$ ctx) . h)
|
catchJust p m h = liftWith $ \ run ctx -> Exc.catchJust p (run (m <$ ctx)) (run . (<$ ctx) . h)
|
||||||
|
|
||||||
-- | See @"Control.Exception".'Exc.handle'@.
|
-- | See @"Control.Exception".'Exc.handle'@.
|
||||||
--
|
--
|
||||||
|
@ -159,8 +159,8 @@ evaluate = sendM . Exc.evaluate
|
||||||
--
|
--
|
||||||
-- @since 1.0.0.0
|
-- @since 1.0.0.0
|
||||||
mask :: Has (Lift IO) sig m => ((forall a . m a -> m a) -> m b) -> m b
|
mask :: Has (Lift IO) sig m => ((forall a . m a -> m a) -> m b) -> m b
|
||||||
mask with = liftWith $ \ ctx run -> Exc.mask $ \ restore ->
|
mask with = liftWith $ \ run ctx -> Exc.mask $ \ restore ->
|
||||||
run (with (\ m -> liftWith $ \ ctx' run' -> restore (run' (m <$ ctx'))) <$ ctx)
|
run (with (\ m -> liftWith $ \ run' ctx' -> restore (run' (m <$ ctx'))) <$ ctx)
|
||||||
|
|
||||||
-- | See @"Control.Exception".'Exc.mask_'@.
|
-- | See @"Control.Exception".'Exc.mask_'@.
|
||||||
--
|
--
|
||||||
|
@ -172,8 +172,8 @@ mask_ m = mask $ const m
|
||||||
--
|
--
|
||||||
-- @since 1.0.0.0
|
-- @since 1.0.0.0
|
||||||
uninterruptibleMask :: Has (Lift IO) sig m => ((forall a . m a -> m a) -> m b) -> m b
|
uninterruptibleMask :: Has (Lift IO) sig m => ((forall a . m a -> m a) -> m b) -> m b
|
||||||
uninterruptibleMask with = liftWith $ \ ctx run -> Exc.uninterruptibleMask $ \ restore ->
|
uninterruptibleMask with = liftWith $ \ run ctx -> Exc.uninterruptibleMask $ \ restore ->
|
||||||
run (with (\ m -> liftWith $ \ ctx' run' -> restore (run' (m <$ ctx'))) <$ ctx)
|
run (with (\ m -> liftWith $ \ run' ctx' -> restore (run' (m <$ ctx'))) <$ ctx)
|
||||||
|
|
||||||
-- | See @"Control.Exception".'Exc.uninterruptibleMask_'@.
|
-- | See @"Control.Exception".'Exc.uninterruptibleMask_'@.
|
||||||
--
|
--
|
||||||
|
@ -191,7 +191,7 @@ getMaskingState = sendM Exc.getMaskingState
|
||||||
--
|
--
|
||||||
-- @since 1.0.0.0
|
-- @since 1.0.0.0
|
||||||
interruptible :: Has (Lift IO) sig m => m a -> m a
|
interruptible :: Has (Lift IO) sig m => m a -> m a
|
||||||
interruptible m = liftWith $ \ ctx run -> Exc.interruptible (run (m <$ ctx))
|
interruptible m = liftWith $ \ run ctx -> Exc.interruptible (run (m <$ ctx))
|
||||||
|
|
||||||
-- | See @"Control.Exception".'Exc.allowInterrupt'@.
|
-- | See @"Control.Exception".'Exc.allowInterrupt'@.
|
||||||
--
|
--
|
||||||
|
|
Loading…
Reference in New Issue