module Swarm.Util.Effect where
import Control.Carrier.Accum.FixedStrict
import Control.Carrier.Error.Either (ErrorC (..))
import Control.Carrier.Throw.Either (ThrowC (..), runThrow)
import Control.Effect.Throw
import Control.Monad ((<=<), (>=>))
import Control.Monad.Trans.Except (ExceptT)
import Data.Either.Extra (eitherToMaybe)
import Data.Sequence (Seq)
import Data.Sequence qualified as Seq
import Swarm.Game.Failure (SystemFailure)
import Swarm.Language.Pretty (prettyString)
import Witherable
withThrow :: (Has (Throw e2) sig m) => (e1 -> e2) -> ThrowC e1 m a -> m a
withThrow :: forall e2 (sig :: (* -> *) -> * -> *) (m :: * -> *) e1 a.
Has (Throw e2) sig m =>
(e1 -> e2) -> ThrowC e1 m a -> m a
withThrow e1 -> e2
f = forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Throw e) sig m =>
e -> m a
throwError forall b c a. (b -> c) -> (a -> b) -> a -> c
. e1 -> e2
f) forall (m :: * -> *) a. Monad m => a -> m a
return
throwToMaybe :: forall e m a. Functor m => ThrowC e m a -> m (Maybe a)
throwToMaybe :: forall e (m :: * -> *) a. Functor m => ThrowC e m a -> m (Maybe a)
throwToMaybe = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. Either a b -> Maybe b
eitherToMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow
throwToWarning :: (Has (Accum (Seq e)) sig m) => ThrowC e m a -> m (Maybe a)
throwToWarning :: forall e (sig :: (* -> *) -> * -> *) (m :: * -> *) a.
Has (Accum (Seq e)) sig m =>
ThrowC e m a -> m (Maybe a)
throwToWarning ThrowC e m a
m = do
Either e a
res <- forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow ThrowC e m a
m
case Either e a
res of
Left e
err -> forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn e
err forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right a
a -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just a
a)
ignoreWarnings :: forall e m a. (Monoid e, Functor m) => AccumC e m a -> m a
ignoreWarnings :: forall e (m :: * -> *) a.
(Monoid e, Functor m) =>
AccumC e m a -> m a
ignoreWarnings = forall (m :: * -> *) w a. Functor m => w -> AccumC w m a -> m a
evalAccum forall a. Monoid a => a
mempty
asExceptT :: ThrowC e m a -> ExceptT e m a
asExceptT :: forall e (m :: * -> *) a. ThrowC e m a -> ExceptT e m a
asExceptT (ThrowC (ErrorC ExceptT e m a
m)) = ExceptT e m a
m
warn :: Has (Accum (Seq w)) sig m => w -> m ()
warn :: forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn = forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum w) sig m =>
w -> m ()
add forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Seq a
Seq.singleton
traverseW ::
(Has (Accum (Seq w)) sig m, Witherable t) =>
(a -> m (Either w b)) ->
t a ->
m (t b)
traverseW :: forall w (sig :: (* -> *) -> * -> *) (m :: * -> *) (t :: * -> *) a
b.
(Has (Accum (Seq w)) sig m, Witherable t) =>
(a -> m (Either w b)) -> t a -> m (t b)
traverseW a -> m (Either w b)
f = do
forall (t :: * -> *) (f :: * -> *) a b.
(Witherable t, Applicative f) =>
(a -> f (Maybe b)) -> t a -> f (t b)
wither forall a b. (a -> b) -> a -> b
$
a -> m (Either w b)
f forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> \case
Left w
e -> forall w (sig :: (* -> *) -> * -> *) (m :: * -> *).
Has (Accum (Seq w)) sig m =>
w -> m ()
warn w
e forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
Right b
e -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just b
e
forMW ::
(Has (Accum (Seq w)) sig m, Witherable t) =>
t a ->
(a -> m (Either w b)) ->
m (t b)
forMW :: forall w (sig :: (* -> *) -> * -> *) (m :: * -> *) (t :: * -> *) a
b.
(Has (Accum (Seq w)) sig m, Witherable t) =>
t a -> (a -> m (Either w b)) -> m (t b)
forMW = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall w (sig :: (* -> *) -> * -> *) (m :: * -> *) (t :: * -> *) a
b.
(Has (Accum (Seq w)) sig m, Witherable t) =>
(a -> m (Either w b)) -> t a -> m (t b)
traverseW
simpleErrorHandle :: ThrowC SystemFailure IO a -> IO a
simpleErrorHandle :: forall a. ThrowC SystemFailure IO a -> IO a
simpleErrorHandle = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PrettyPrec a => a -> String
prettyString) forall (f :: * -> *) a. Applicative f => a -> f a
pure forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall e (m :: * -> *) a. ThrowC e m a -> m (Either e a)
runThrow