fx 0.4.0.1 → 0.7

raw patch · 8 files changed

+138/−823 lines, 8 filesdep +base-preludedep −QuickCheckdep −fxdep −quickcheck-instancesdep ~basedep ~transformersPVP ok

version bump matches the API change (PVP)

Dependencies added: base-prelude

Dependencies removed: QuickCheck, fx, quickcheck-instances, rerebase, selective, stm, tasty, tasty-hunit, tasty-quickcheck, text, unordered-containers

Dependency ranges changed: base, transformers

API changes (from Hackage documentation)

Files

• LICENSE +1/−1
• fx.cabal +44/−41
• library/Fx.hs +0/−594
• library/Fx/EitherEffect.hs +48/−0
• library/Fx/Executor.hs +38/−0
• library/Fx/Prelude.hs +7/−92
• library/Fx/Strings.hs +0/−34
• test/Main.hs +0/−61

@@ -1,4 +1,4 @@-Copyright (c) 2019 Nikita Volkov+Copyright (c) 2017, Nikita Volkov  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation

@@ -1,49 +1,52 @@-name: fx-version: 0.4.0.1-synopsis: Revamped effect system-category: Effects, Resources-homepage: https://github.com/nikita-volkov/fx-bug-reports: https://github.com/nikita-volkov/fx/issues-author: Nikita Volkov <nikita.y.volkov@mail.ru>-maintainer: Nikita Volkov <nikita.y.volkov@mail.ru>-copyright: (c) 2019 Nikita Volkov-license: MIT-license-file: LICENSE-build-type: Simple-cabal-version: >=1.10+name:+  fx+version:+  0.7+synopsis:+  Horizontally composable effects+description:+  This library provides for the horizontal composition of effects,+  serving as an alternative+  to the monad transformers stacking composition.+  It is expected to be faster, but no comparison has been performed yet.+homepage:+  https://github.com/nikita-volkov/fx +bug-reports:+  https://github.com/nikita-volkov/fx/issues +author:+  Nikita Volkov <nikita.y.volkov@mail.ru>+maintainer:+  Nikita Volkov <nikita.y.volkov@mail.ru>+copyright:+  (c) 2017, Nikita Volkov+license:+  MIT+license-file:+  LICENSE+build-type:+  Simple+cabal-version:+  >=1.10  source-repository head-  type: git-  location: git://github.com/nikita-volkov/fx.git+  type:+    git+  location:+    git://github.com/nikita-volkov/fx.git  library-  hs-source-dirs: library-  default-extensions: BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, InstanceSigs, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeApplications, TypeFamilies, TypeOperators, UnboxedTuples-  default-language: Haskell2010+  hs-source-dirs:+    library+  default-extensions:+    Arrows, BangPatterns, ConstraintKinds, DataKinds, DefaultSignatures, DeriveDataTypeable, DeriveFoldable, DeriveFunctor, DeriveGeneric, DeriveTraversable, EmptyDataDecls, FlexibleContexts, FlexibleInstances, FunctionalDependencies, GADTs, GeneralizedNewtypeDeriving, LambdaCase, LiberalTypeSynonyms, MagicHash, MultiParamTypeClasses, MultiWayIf, NoImplicitPrelude, NoMonomorphismRestriction, OverloadedStrings, PatternGuards, PatternSynonyms, ParallelListComp, QuasiQuotes, RankNTypes, RecordWildCards, ScopedTypeVariables, StandaloneDeriving, TemplateHaskell, TupleSections, TypeFamilies, TypeOperators, UnboxedTuples+  default-language:+    Haskell2010   exposed-modules:-    Fx+    Fx.EitherEffect+    Fx.Executor   other-modules:     Fx.Prelude-    Fx.Strings   build-depends:-    base >=4.9 && <5,-    selective >=0.4 && <0.5,-    stm >=2.5 && <3,-    text >=1 && <2,-    transformers >=0.5 && <0.6,-    unordered-containers >=0.2.10 && <0.3--test-suite test-  type: exitcode-stdio-1.0-  hs-source-dirs: test-  default-extensions: BangPatterns, DeriveDataTypeable, DeriveGeneric, DeriveFunctor, DeriveTraversable, FlexibleContexts, FlexibleInstances, LambdaCase, NoImplicitPrelude, RankNTypes, ScopedTypeVariables, StandaloneDeriving, TypeApplications, TypeFamilies-  default-language: Haskell2010-  main-is: Main.hs-  build-depends:-    fx,-    QuickCheck >=2.13 && <3,-    quickcheck-instances >=0.3.22 && <0.4,-    rerebase <2,-    tasty >=1.2.3 && <2,-    tasty-hunit >=0.10.0.2 && <0.11,-    tasty-quickcheck >=0.10.1 && <0.11+    transformers >= 0.3 && < 0.6,+    base-prelude >= 1 && < 2,+    base >= 4.6 && < 5

@@ -1,594 +0,0 @@-module Fx-(-  -- * Fx-  Fx,-  -- ** Environment handling-  provideAndUse,-  handleEnv,-  -- ** Concurrency-  start,-  wait,-  concurrently,-  -- ** IO execution-  -- |-  -- These functions leak abstraction in one way or the other,-  -- requiring you to ensure that your code doesn't throw unexpected exceptions.-  -- `try` are `catch` are your tools for that.-  -- -  -- Besides these functions `Fx` also has an instance of `MonadIO`,-  -- which provides the only non-leaky way of running IO, catching all possible exceptions.-  runTotalIO,-  runPartialIO,-  runExceptionalIO,-  runSTM,-  -- * Provider-  Provider,-  acquireAndRelease,-  pool,-  -- * Future-  Future,-  -- * Conc-  Conc,-  -- * Classes-  -- ** FxRunning-  FxRunning(..),-  -- ** ErrHandling-  ErrHandling(..),-  exposeErr,-  absorbErr,-  -- ** EnvMapping-  EnvMapping(..),-  -- * Exceptions-  FxException(..),-  FxExceptionReason(..),-)-where--import Fx.Prelude hiding (app)-import qualified Data.Text as Text-import qualified Data.HashSet as HashSet-import qualified Fx.Strings as Strings----- * IO----------------------------{-|-Execute an effect with no environment and all errors handled.--Conventionally, this is what should be placed in the @main@ function.--}-runFxInIO :: Fx () Void res -> IO res-runFxInIO (Fx m) = uninterruptibleMask $ \ unmask -> do--  fatalErrChan <- newTQueueIO-  resVar <- newEmptyTMVarIO--  forkIO $ do--    tid <- myThreadId--    finalize <- let-      crash tids reason = atomically (writeTQueue fatalErrChan (FxException (tid : tids) reason))-      fxEnv = FxEnv unmask crash ()-      in-        catch-          (do-            resOrVoid <- runExceptT (runReaderT m fxEnv)-            return $ case resOrVoid of-              Right res -> atomically (putTMVar resVar res)-              Left a ->-                catch-                  (do-                    evaluate a-                    crash [] (BugFxExceptionReason "Unexpected void")-                  )-                  (crash [] . ErrorCallFxExceptionReason)-          )-          (\ exc -> return $ case fromException exc of-            -- Catch calls to `error`.-            Just errorCall -> crash [] (ErrorCallFxExceptionReason errorCall)-            -- Catch anything else we could miss. Just in case.-            _ -> crash [] (BugFxExceptionReason (Strings.unexpectedException exc))-          )--    -- Throw errors or post the result-    finalize--  -- Wait for fatal error or result-  join $ catch-    (-      unmask $ atomically $ asum-        [-          do-            fatalErr <- readTQueue fatalErrChan-            return $ throwIO fatalErr-          ,-          do-            res <- readTMVar resVar-            return $ return res-        ]-    )-    (\ (exc :: SomeException) ->-      case fromException exc of-        Just (exc :: AsyncException) -> throwIO exc-        _ -> throwIO (FxException [] (BugFxExceptionReason (Strings.failedWaitingForFinalResult exc))))----- * Fx----------------------------{-|-Effectful computation with explicit errors in the context of provided environment.--Calling `fail` causes the whole app to interrupt outputting a message to console.-`fail` is intended to be used in events which you expect never to happen,-and hence which should be considered bugs.-It is similar to calling `fail` on IO,-with a major difference of the error never getting lost in a concurrent environment.--Calling `fail` results in `ErrorCallFxExceptionReason` in the triggerred `FxException`.-Thus in effect it is the same as calling the `error` function.--}-newtype Fx env err res = Fx (ReaderT (FxEnv env) (ExceptT err IO) res)--deriving instance Functor (Fx env err)-deriving instance Applicative (Fx env err)-deriving instance Selective (Fx env err)-deriving instance Monoid err => Alternative (Fx env err)-deriving instance Monad (Fx env err)-deriving instance Monoid err => MonadPlus (Fx env err)--instance MonadFail (Fx env err) where-  fail msg = Fx $ ReaderT $ \ (FxEnv _ crash _) -> liftIO $ do-    crash [] (ErrorCallFxExceptionReason (ErrorCall msg))-    fail "Crashed"--instance MonadIO (Fx env SomeException) where-  liftIO io = Fx (ReaderT (\ (FxEnv unmask _ _) -> ExceptT (try (unmask io))))--instance Bifunctor (Fx env) where-  bimap lf rf = mapFx (mapReaderT (mapExceptT (fmap (bimap lf rf))))--{-|-Runtime and application environment.--}-data FxEnv env = FxEnv (forall a. IO a -> IO a) ([ThreadId] -> FxExceptionReason -> IO ()) env--mapFx fn (Fx m) = Fx (fn m)--{-|-Turn a non-failing IO action into an effect.--__Warning:__-It is your responsibility to ensure that it does not throw exceptions!--}-runTotalIO :: IO res -> Fx env err res-runTotalIO io = Fx $ ReaderT $ \ (FxEnv unmask crash _) -> lift $-  catch (unmask io)-    (\ (exc :: SomeException) -> do-      crash [] (UncaughtExceptionFxExceptionReason exc)-      fail "Unhandled exception in runTotalIO. Got propagated to top."-    )--{-|-Run IO which produces either an error or result.--__Warning:__-It is your responsibility to ensure that it does not throw exceptions!--}-runPartialIO :: IO (Either err res) -> Fx env err res-runPartialIO io = runTotalIO io >>= either throwErr return--{-|-Run IO which only throws a specific type of exception.--__Warning:__-It is your responsibility to ensure that it doesn't throw any other exceptions!--}-runExceptionalIO :: Exception exc => IO res -> Fx env exc res-runExceptionalIO io =-  Fx $ ReaderT $ \ (FxEnv unmask crash _) -> ExceptT $-  catch (fmap Right (unmask io)) $ \ exc -> case fromException exc of-    Just exc' -> return (Left exc')-    Nothing -> do-      crash [] (UncaughtExceptionFxExceptionReason exc)-      fail "Unhandled exception in runExceptionalIO. Got propagated to top."--{-|-Run STM, crashing in case of STM exceptions.--Same as @`runTotalIO` . `atomically`@.--}-runSTM :: STM res -> Fx env err res-runSTM = runTotalIO . atomically--{-|-Spawn a thread and start running an effect on it,-returning the associated future.--Fatal errors on the spawned thread are guaranteed to get propagated to the top.-By fatal errors we mean calls to `error`, `fail` and uncaught exceptions.--Normal errors (the explicit @err@ parameter) will only propagate-if you use `wait` at some point.--__Warning:__-It is your responsibility to ensure that the whole future executes-before the running `Fx` finishes.-Otherwise you will lose the environment in scope of which the future executes.-To achieve that use `wait`.--}-start :: Fx env err res -> Fx env err' (Future err res)-start (Fx m) =-  Fx $ ReaderT $ \ (FxEnv unmask crash env) -> lift $ do--    futureVar <- newEmptyTMVarIO--    forkIO $ do--      tid <- myThreadId--      let childCrash tids dls = crash (tid : tids) dls--      finalize <--        catch-          (do-            res <- runExceptT (runReaderT m (FxEnv unmask childCrash env))-            return (atomically (putTMVar futureVar (first Just res)))-          )-          (\ exc -> return $ do-            case fromException exc of-              -- Catch calls to `error`.-              Just errorCall -> crash [] (ErrorCallFxExceptionReason errorCall)-              -- Catch anything else we could miss. Just in case.-              _ -> crash [] (BugFxExceptionReason (Strings.unexpectedException exc))-            atomically (putTMVar futureVar (Left Nothing))-          )--      finalize--    return $ Future $ Compose $ readTMVar futureVar--{-|-Block until the future completes either with a result or an error.--}-wait :: Future err res -> Fx env err res-wait (Future m) = Fx $ ReaderT $ \ (FxEnv unmask crash env) -> ExceptT $ join $ catch-  (do-    futureStatus <- unmask (atomically (getCompose m))-    return $ case futureStatus of-      Right res -> return (Right res)-      Left (Just err) -> return (Left err)-      Left Nothing -> fail "Waiting for a future that crashed"-  )-  (\ (exc :: SomeException) -> return $ do-    crash [] (BugFxExceptionReason (Strings.failedWaitingForResult exc))-    fail "Thread crashed with uncaught exception waiting for result."-  )--{-|-Execute concurrent effects.--}-concurrently :: Conc env err res -> Fx env err res-concurrently (Conc fx) = fx--{-|-Execute Fx in the scope of a provided environment.--}-provideAndUse :: Provider err env -> Fx env err res -> Fx env' err res-provideAndUse (Provider (Fx acquire)) (Fx fx) =-  Fx $ ReaderT $ \ (FxEnv unmask crash _) -> ExceptT $ do-    let providerFxEnv = FxEnv unmask crash ()-    acquisition <- runExceptT (runReaderT acquire providerFxEnv)-    case acquisition of-      Left err -> return (Left err)-      Right (env, (Fx release)) -> do-        resOrErr <- runExceptT (runReaderT fx (FxEnv unmask crash env))-        releasing <- runExceptT (runReaderT release providerFxEnv)-        return (resOrErr <* releasing)--{-|-Collapse an env handler into an environmental effect.--__Warning:__-This function leaks the abstraction over the environment.-It is your responsibility to ensure that you don't use it to return-the environment and use it outside of the handler's scope.--}-handleEnv :: (env -> Fx env err res) -> Fx env err res-handleEnv handler =-  Fx $ ReaderT $ \ (FxEnv unmask crash env) ->-    case handler env of-      Fx rdr -> runReaderT rdr (FxEnv unmask crash env)----- * Future----------------------------{-|-Handle to a result of an action which may still be being executed on another thread.--The way you deal with it is thru the `start` and `wait` functions.--}-newtype Future err res = Future (Compose STM (Either (Maybe err)) res)-  deriving (Functor, Applicative)--{-|-Decides whether to wait for the result of another future.--}-deriving instance Selective (Future err)--instance Bifunctor Future where-  bimap lf rf = mapFuture (mapCompose (fmap (bimap (fmap lf) rf)))--mapFuture fn (Future m) = Future (fn m)----- * Conc----------------------------{-|-Wrapper over `Fx`,-whose instances compose by running computations on separate threads.--You can turn `Fx` into `Conc` using `runFx`.--}-newtype Conc env err res = Conc (Fx env err res)--deriving instance Functor (Conc env err)-deriving instance Bifunctor (Conc env)--instance Applicative (Conc env err) where-  pure = Conc . pure-  (<*>) (Conc m1) (Conc m2) = Conc $ do-    future1 <- start m1-    res2 <- m2-    res1 <- wait future1-    return (res1 res2)--{-|-Spawns a computation,-deciding whether to wait for it.--}-instance Selective (Conc env err) where-  select (Conc choose) (Conc act) = Conc $ do-    actFtr <- start act-    chooseRes <- choose-    case chooseRes of-      Left a -> do-        aToB <- wait actFtr-        return (aToB a)-      Right b -> return b--mapConc fn (Conc m) = Conc (fn m)----- * Provider----------------------------{-|-Effectful computation with explicit errors,-which encompasses environment acquisition and releasing.--Composes well, allowing you to merge multiple providers into one.--Builds up on ideas expressed in http://www.haskellforall.com/2013/06/the-resource-applicative.html-and later released as the \"managed\" package.--}-newtype Provider err env = Provider (Fx () err (env, Fx () err ()))--instance Functor (Provider err) where-  fmap f (Provider m) = Provider $ do-    (env, release) <- m-    return (f env, release)--instance Applicative (Provider err) where-  pure env = Provider (pure (env, pure ()))-  Provider m1 <*> Provider m2 = Provider $-    liftA2 (\ (env1, release1) (env2, release2) -> (env1 env2, release2 *> release1)) m1 m2--instance Monad (Provider err) where-  return = pure-  (>>=) (Provider m1) k2 = Provider $ do-    (env1, release1) <- m1-    (env2, release2) <- case k2 env1 of Provider m2 -> m2-    return (env2, release2 >> release1)--instance MonadIO (Provider SomeException) where-  liftIO = runFx . liftIO--instance Bifunctor Provider where-  bimap lf rf (Provider m) = Provider (bimap lf (bimap rf (first lf)) m)-  second = fmap--{-|-Create a resource provider from acquiring and releasing effects.--}-acquireAndRelease :: Fx () err env -> (env -> Fx () err ()) -> Provider err env-acquireAndRelease acquire release = Provider $ do-  env <- acquire-  return (env, release env)--{-|-Convert a single resource provider into a pool provider.--The wrapper provider acquires the specified amount of resources using the original provider,-and returns a modified version of the original provider,-whose acquisition and releasing merely takes one resource out of the pool and puts it back when done.-No actual acquisition or releasing happens in the wrapped provider.-No errors get raised in it either.--Use this when you need to access a resource concurrently.--}-pool :: Int -> Provider err env -> Provider err (Provider err' env)-pool poolSize (Provider acquire) = Provider $ do-  queue <- runSTM newTQueue-  replicateM_ poolSize $ do-    handle <- acquire-    runSTM $ writeTQueue queue handle    -  let-    resourceProvider = Provider $ do-      (env, releaseResource) <- runSTM $ readTQueue queue-      return (env, runSTM (writeTQueue queue (env, releaseResource)))-    release = do-      releasers <- runSTM $ do-        list <- flushTQueue queue-        guard (length list == poolSize)-        return (fmap snd list)-      sequence_ releasers-    in return (resourceProvider, release)----- * Classes------------------------------ ** Fx Running----------------------------{-|-Support for running of `Fx`.--Apart from other things this is your interface to turn `Fx` into `IO` or `Conc`.--}-class FxRunning env err m | m -> env, m -> err where-  runFx :: Fx env err res -> m res--{-|-Executes an effect with no environment and all errors handled.--}-instance FxRunning () Void IO where-  runFx = runFxInIO--instance FxRunning () err (ExceptT err IO) where-  runFx fx = ExceptT (runFx (exposeErr fx))--instance FxRunning env err (ReaderT env (ExceptT err IO)) where-  runFx fx = ReaderT (\ env -> ExceptT (runFx (mapEnv (const env) (exposeErr fx))))--{-|-Executes an effect with no environment and all errors handled in `Fx`-with any environment and error.--Same as @(`mapEnv` (`const` ()) . `first` `absurd`)@.--}-instance FxRunning () Void (Fx env err) where-  runFx = mapEnv (const ()) . first absurd--instance FxRunning env err (Conc env err) where-  runFx = Conc--instance FxRunning () err (Provider err) where-  runFx fx = Provider (fmap (\ env -> (env, pure ())) fx)---- ** ErrHandling----------------------------{-|-Support for error handling.--Functions provided by this class are particularly helpful,-when you need to map into error of type `Void`.--}-class ErrHandling m where--  {-|-  Interrupt the current computation raising an error.-  -}-  throwErr :: err -> m err res--  {-|-  Handle error in another failing action.-  Sort of like a bind operation over the error type parameter.-  -}-  handleErr :: (a -> m b res) -> m a res -> m b res--{-|-Expose the error in result,-producing an action, which is compatible with any error type.--}-exposeErr :: (ErrHandling m, Functor (m a), Applicative (m b)) => m a res -> m b (Either a res)-exposeErr = absorbErr Left . fmap Right--{-|-Map from error to result, leaving the error be anything.--}-absorbErr :: (ErrHandling m, Applicative (m b)) => (a -> res) -> m a res -> m b res-absorbErr fn = handleErr (pure . fn)--instance ErrHandling (Fx env) where-  throwErr = Fx . lift . throwE-  handleErr handler = mapFx $ \ m -> ReaderT $ \ unmask -> ExceptT $ do-    a <- runExceptT (runReaderT m unmask)-    case a of-      Right res -> return (Right res)-      Left err -> case handler err of-        Fx m -> runExceptT (runReaderT m unmask)--instance ErrHandling Future where-  throwErr = Future . Compose . return . Left . Just-  handleErr handler = mapFuture $ \ m -> Compose $ do-    a <- getCompose m-    case a of-      Right res -> return (Right res)-      Left b -> case b of-        Just err -> case handler err of-          Future m' -> getCompose m'-        Nothing -> return (Left Nothing)--deriving instance ErrHandling (Conc env)---- ** Env Mapping----------------------------{-|-Support for mapping of the environment.--}-class EnvMapping m where-  {-|-  Map the environment.-  Please notice that the expected function is contravariant.-  -}-  mapEnv :: (b -> a) -> m a err res -> m b err res--instance EnvMapping Fx where-  mapEnv fn (Fx m) =-    Fx $ ReaderT $ \ (FxEnv unmask crash env) ->-      runReaderT m (FxEnv unmask crash (fn env))--deriving instance EnvMapping Conc----- * Exceptions----------------------------{-|-Fatal failure of an `Fx` application.-Informs of an unrecoverable condition that the application has reached.-It is not meant to be caught,-because it implies that there is either a bug in your code or-a bug in the "fx" library itself, which needs reporting.--Consists of a list of thread identifiers specifying the nesting path of-the faulty thread and the reason of failure.--}-data FxException = FxException [ThreadId] FxExceptionReason--instance Show FxException where-  show (FxException tids reason) = Strings.fatalErrorAtThreadPath tids (show reason)--instance Exception FxException--{-|-Reason of a fatal failure of an `Fx` application.--}-data FxExceptionReason =-  UncaughtExceptionFxExceptionReason SomeException |-  ErrorCallFxExceptionReason ErrorCall |-  BugFxExceptionReason String--instance Show FxExceptionReason where-  show = \ case-    UncaughtExceptionFxExceptionReason exc -> Strings.uncaughtException exc-    ErrorCallFxExceptionReason errorCall -> show errorCall-    BugFxExceptionReason details -> Strings.bug details

@@ -0,0 +1,48 @@+module Fx.EitherEffect+(+  EitherEffect,+  liftEffect1,+  liftEffect2,+  executor,+)+where++import Fx.Prelude+import qualified Fx.Executor as A+++{-|+A sum of two effects (@effect1@ and @effect2@) to be executed+in @context@ producing @result@.+-}+newtype EitherEffect effect1 effect2 context result =+  EitherEffect (ReaderT (A.Executor effect1 context, A.Executor effect2 context) context result)+  deriving (Functor, Applicative, Alternative, Monad, MonadPlus, MonadIO)++instance MonadTrans (EitherEffect effect1 effect2) where+  lift =+    EitherEffect . lift++{-|+Lift the first of the two effects.+-}+liftEffect1 :: effect1 result -> EitherEffect effect1 effect2 context result+liftEffect1 effect =+  EitherEffect (ReaderT (\(executor, _) -> A.execute executor effect))++{-|+Lift the second of the two effects.+-}+liftEffect2 :: effect2 result -> EitherEffect effect1 effect2 context result+liftEffect2 effect =+  EitherEffect (ReaderT (\(_, executor) -> A.execute executor effect))++{-|+Compose the executors of each effect into an executor of either.+-}+executor+  :: A.Executor effect1 context+  -> A.Executor effect2 context+  -> A.Executor (EitherEffect effect1 effect2 context) context+executor executor1 executor2 =+  A.Executor (\(EitherEffect reader) -> runReaderT reader (executor1, executor2))

@@ -0,0 +1,38 @@+module Fx.Executor+(+  Executor(..),+  mapEffect,+  mapContext,+  execute,+)+where++import Fx.Prelude+++{-|+An abstraction over the execution of @effect@ in @context@, both producing the same @result@.+-}+newtype Executor effect context =+  Executor (forall result. effect result -> context result)++{-|+Use the executor to run an effect in a context.+-}+execute :: Executor effect context -> effect result -> context result+execute (Executor def) effect =+  def effect++{-|+Map the effect part of an executor (contravariantly).+-}+mapEffect :: (forall result. newEffect result -> oldEffect result) -> Executor oldEffect context -> Executor newEffect context+mapEffect mapping (Executor fn) =+  Executor (fn . mapping)++{-|+Map the context part of an executor.+-}+mapContext :: (forall result. oldContext result -> newContext result) -> Executor effect oldContext -> Executor effect newContext+mapContext mapping (Executor fn) =+  Executor (mapping . fn)

@@ -1,107 +1,22 @@ module Fx.Prelude-( +(   module Exports,-  mapCompose, ) where --- base++-- base-prelude --------------------------import Control.Applicative as Exports-import Control.Arrow as Exports hiding (first, second)-import Control.Category as Exports-import Control.Concurrent as Exports-import Control.Exception as Exports-import Control.Monad as Exports hiding (fail, mapM_, sequence_, forM_, msum, mapM, sequence, forM)-import Control.Monad.IO.Class as Exports-import Control.Monad.Fail as Exports-import Control.Monad.Fix as Exports hiding (fix)-import Control.Monad.ST as Exports-import Data.Bifunctor as Exports-import Data.Bits as Exports-import Data.Bool as Exports-import Data.Char as Exports-import Data.Coerce as Exports-import Data.Complex as Exports-import Data.Data as Exports-import Data.Dynamic as Exports-import Data.Either as Exports-import Data.Fixed as Exports-import Data.Foldable as Exports-import Data.Function as Exports hiding (id, (.))-import Data.Functor as Exports-import Data.Functor.Compose as Exports-import Data.Functor.Contravariant as Exports-import Data.Int as Exports-import Data.IORef as Exports-import Data.Ix as Exports-import Data.List as Exports hiding (sortOn, isSubsequenceOf, uncons, concat, foldr, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, find, maximumBy, minimumBy, mapAccumL, mapAccumR, foldl')-import Data.List.NonEmpty as Exports (NonEmpty(..))-import Data.Maybe as Exports-import Data.Monoid as Exports hiding (Alt)-import Data.Ord as Exports-import Data.Proxy as Exports-import Data.Ratio as Exports-import Data.STRef as Exports-import Data.String as Exports-import Data.Traversable as Exports-import Data.Tuple as Exports-import Data.Unique as Exports-import Data.Version as Exports-import Data.Void as Exports-import Data.Word as Exports-import Debug.Trace as Exports-import Foreign.ForeignPtr as Exports-import Foreign.Ptr as Exports-import Foreign.StablePtr as Exports-import Foreign.Storable as Exports-import GHC.Conc as Exports hiding (orElse, withMVar, threadWaitWriteSTM, threadWaitWrite, threadWaitReadSTM, threadWaitRead)-import GHC.Exts as Exports (lazy, inline, sortWith, groupWith)-import GHC.Generics as Exports (Generic)-import GHC.IO.Exception as Exports-import Numeric as Exports-import Prelude as Exports hiding (fail, concat, foldr, mapM_, sequence_, foldl1, maximum, minimum, product, sum, all, and, any, concatMap, elem, foldl, foldr1, notElem, or, mapM, sequence, id, (.))-import System.Environment as Exports-import System.Exit as Exports-import System.IO as Exports (Handle, hClose)-import System.IO.Error as Exports-import System.IO.Unsafe as Exports-import System.Mem as Exports-import System.Mem.StableName as Exports-import System.Timeout as Exports-import Text.ParserCombinators.ReadP as Exports (ReadP, ReadS, readP_to_S, readS_to_P)-import Text.ParserCombinators.ReadPrec as Exports (ReadPrec, readPrec_to_P, readP_to_Prec, readPrec_to_S, readS_to_Prec)-import Text.Printf as Exports (printf, hPrintf)-import Text.Read as Exports (Read(..), readMaybe, readEither)-import Unsafe.Coerce as Exports+import BasePrelude as Exports hiding (assert, left, right, isLeft, isRight, (<>), First(..), Last(..), ProtocolError, traceEvent, traceEventIO, traceMarker, traceMarkerIO)  -- transformers -------------------------+import Control.Monad.IO.Class as Exports import Control.Monad.Trans.Class as Exports import Control.Monad.Trans.Cont as Exports hiding (shift, callCC)-import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT, catchE, throwE)+import Control.Monad.Trans.Except as Exports (ExceptT(ExceptT), Except, except, runExcept, runExceptT, mapExcept, mapExceptT, withExcept, withExceptT, throwE, catchE) import Control.Monad.Trans.Maybe as Exports import Control.Monad.Trans.Reader as Exports (Reader, runReader, mapReader, withReader, ReaderT(ReaderT), runReaderT, mapReaderT, withReaderT) import Control.Monad.Trans.State.Strict as Exports (State, runState, evalState, execState, mapState, withState, StateT(StateT), runStateT, evalStateT, execStateT, mapStateT, withStateT) import Control.Monad.Trans.Writer.Strict as Exports (Writer, runWriter, execWriter, mapWriter, WriterT(..), execWriterT, mapWriterT)---- text---------------------------import Data.Text as Exports (Text)---- stm---------------------------import Control.Concurrent.STM as Exports hiding (orElse)---- unordered-containers---------------------------import Data.HashSet as Exports (HashSet)-import Data.HashMap.Strict as Exports (HashMap)---- selective---------------------------import Control.Selective as Exports---mapCompose :: (f (g a) -> f' (g' a')) -> Compose f g a -> Compose f' g' a'-mapCompose fn (Compose m) = Compose (fn m)+import Data.Functor.Compose as Exports

@@ -1,34 +0,0 @@-module Fx.Strings-where--import Fx.Prelude---failedWaitingForFinalResult :: SomeException -> String-failedWaitingForFinalResult exc =-  showString "Failed waiting for final result: " (show exc)--failedWaitingForResult :: SomeException -> String-failedWaitingForResult exc =-  showString "Failed waiting for result: " (show exc)--unexpectedException :: SomeException -> String-unexpectedException exc =-  showString "Unexpected exception: " (show exc)--uncaughtException :: SomeException -> String-uncaughtException exc =-  showString "Uncaught exception: " (show exc)--fatalErrorAtThreadPath :: [ThreadId] -> String -> String-fatalErrorAtThreadPath = let-  showTids = intercalate "/" . fmap (drop 9 . show)-  in \ tids reason ->-    showString ("Fatal error at thread path /") $-    showString (showTids tids) $-    showString ". " $-    reason--bug :: String -> String-bug details =-  showString "Bug in the \"fx\" library. Please report it to maintainers. " details

@@ -1,61 +0,0 @@-module Main where--import Prelude hiding (choose)-import Test.QuickCheck.Instances-import Test.Tasty-import Test.Tasty.Runners-import Test.Tasty.HUnit-import Test.Tasty.QuickCheck-import Fx-import qualified Test.QuickCheck as QuickCheck-import qualified Test.QuickCheck.Property as QuickCheck---main = defaultMain $ testGroup "" $-  [-    testCase "Error call on main thread" $ do-      res <- try $ runFx $ error "A"-      case res of-        Left (FxException _ (ErrorCallFxExceptionReason _)) -> return ()-        Left exc -> assertFailure (show exc)-        _ -> assertFailure "Right"-    ,-    testCase "Error call on forked thread" $ do-      res <- try $ runFx $ do-        future <- start $ error "A"-        wait future-      case res of-        Left (FxException _ (ErrorCallFxExceptionReason _)) -> return ()-        Left exc -> assertFailure (show exc)-        _ -> assertFailure "Right"-    ,-    testCase "Error call on deeply forked thread" $ do-      res <- try $ runFx $ do-        future <- start $ start $ error "A"-        wait future >>= wait-      case res of-        Left (FxException _ (ErrorCallFxExceptionReason _)) -> return ()-        Left exc -> assertFailure (show exc)-        _ -> assertFailure "Right"-    ,-    testException "Fail"-      (fail "A")-      (\ case-        FxException _ (ErrorCallFxExceptionReason _) -> True-        exc -> False)-    ,-    testException "Fail on forked thread"-      (start (fail "A") >>= wait)-      (\ case-        FxException _ (ErrorCallFxExceptionReason _) -> True-        exc -> False)-  ]--testException :: TestName -> Fx () Void a -> (FxException -> Bool) -> TestTree-testException name fx validateExc = testCase name $ do-  res <- try @FxException $ runFx $ fx-  case res of-    Left exc -> if validateExc exc-      then return ()-      else assertFailure (show exc)-    Right _ -> assertFailure "No exception"