simple-effects 0.5.0.3 → 0.6.0.0

raw patch · 3 files changed

+67/−32 lines, 3 filesdep +ghc-primPVP ok

version bump matches the API change (PVP)

Dependencies added: ghc-prim

API changes (from Hackage documentation)

Files

• simple-effects.cabal +13/−1
• src/Control/Effects/Signal.hs +32/−31
• test/Main.hs +22/−0

@@ -1,5 +1,5 @@ name:                simple-effects
-version:             0.5.0.3
+version:             0.6.0.0
 synopsis:            A simple effect system that integrates with MTL
 description:         Please see README.md
 homepage:            https://gitlab.com/LukaHorvat/simple-effects
@@ -30,8 +30,20 @@                      , transformers-base == 0.4.*
                      , list-t
                      , lens
+                     , ghc-prim
   default-extensions:  NoImplicitPrelude
   ghc-options:         -Wall
+
+test-suite tests
+    hs-source-dirs:    test
+    main-is:           Main.hs
+    default-language:  Haskell2010
+    type:              exitcode-stdio-1.0
+    build-depends:     base >= 4.7 && < 5
+                     , simple-effects
+                     , interlude-l >= 0.1.0.6
+    ghc-options:       -Wall
+    default-extensions:NoImplicitPrelude
 
 benchmark bench-effects
   type:                exitcode-stdio-1.0

@@ -1,15 +1,17 @@ {-# LANGUAGE TypeFamilies, ScopedTypeVariables, FlexibleContexts, Rank2Types, ConstraintKinds #-}
-{-# LANGUAGE DeriveAnyClass, OverloadedStrings, MultiParamTypeClasses, FunctionalDependencies #-}
-{-# LANGUAGE FlexibleInstances, UndecidableInstances #-}
+{-# LANGUAGE DeriveAnyClass, OverloadedStrings, MultiParamTypeClasses, NoMonomorphismRestriction #-}
+{-# LANGUAGE FlexibleInstances, UndecidableInstances, DataKinds, TypeOperators #-}
+{-# OPTIONS_GHC -Wno-redundant-constraints #-}
 module Control.Effects.Signal
-    ( MonadEffectSignal(..), ResumeOrBreak(..), throwSignal, handleSignal, handleAsException
+    ( MonadEffectSignal(..), ResumeOrBreak(..), throwSignal, handleSignal
     , Throws, handleException, handleToEither, module Control.Effects
     , module Control.Monad.Trans.Except, MaybeT(..), discardAllExceptions, showAllExceptions ) where
 
-import Interlude
+import Interlude hiding (TypeError)
 import Control.Monad.Trans.Except
 import Control.Monad.Trans.Maybe
-
+import qualified GHC.TypeLits as TL
+import GHC.TypeLits (TypeError, ErrorMessage(..))
 import Control.Effects
 
 data Signal a b
@@ -18,13 +20,24 @@ 
 data SomeSignal = SomeSignal { getSomeSignal :: Text } deriving (Eq, Ord, Read, Show)
 
-instance {-# OVERLAPPABLE #-} Monad m => MonadEffect (Signal e Void) (ExceptT e m) where
+type family UnhandledError a b :: ErrorMessage where
+    UnhandledError a Void =
+           'TL.Text "Unhandled exception of type " ':<>: 'ShowType a
+     ':$$: 'TL.Text "You need to handle all the exceptions before running the computation"
+    UnhandledError a b =
+           'TL.Text "Unhandled signal of type " ':<>: 'ShowType a
+           ':<>: 'TL.Text " expecting a return value of type " ':<>: 'ShowType b
+     ':$$: 'TL.Text "You need to handle all the signals before running the computation"
+
+instance {-# OVERLAPPABLE #-} Monad m => MonadEffect (Signal e b) (ExceptT e m) where
     effect _ = throwE
-instance (Show e, Monad m) => MonadEffect (Signal e Void) (ExceptT SomeSignal m) where
+instance (Show e, Monad m) => MonadEffect (Signal e b) (ExceptT SomeSignal m) where
     effect _ = throwE . SomeSignal . pshow
-instance Monad m => MonadEffect (Signal a Void) (MaybeT m) where
+instance Monad m => MonadEffect (Signal a b) (MaybeT m) where
     effect _ _ = mzero
-
+instance TypeError (UnhandledError a b)
+      => MonadEffect (Signal a b) IO where
+    effect = undefined
 -- | This class allows you to "throw" a signal. For the most part signals are the same as checked
 --   exceptions. The difference here is that the handler has the option to provide the value that
 --   will be the result _of calling the signal function_. This effectibvely allows you to have
@@ -32,17 +45,18 @@ --
 --   This class can be considered an alias for @MonadEffect (Signal a b)@ so your code isn't
 --   required to provide any instances.
-class MonadEffect (Signal a b) m => MonadEffectSignal a b m | m a -> b where
+class MonadEffect (Signal a b) m => MonadEffectSignal a b m where
     -- | There are no restrictions on the type of values that can be thrown or returned.
     signal :: a -> m b
     signal = effect (Proxy :: Proxy (Signal a b))
 
 type Throws e m = MonadEffectSignal e Void m
 
-instance Monad m => MonadEffectSignal a b (EffectHandler (Signal a b) m)
-instance Monad m => MonadEffectSignal a Void (MaybeT m)
-instance {-# OVERLAPPABLE #-} Monad m => MonadEffectSignal e Void (ExceptT e m)
-instance (Monad m, Show e) => MonadEffectSignal e Void (ExceptT SomeSignal m)
+instance (Monad m, b ~ c) => MonadEffectSignal a c (EffectHandler (Signal a b) m)
+instance Monad m => MonadEffectSignal a b (MaybeT m)
+instance {-# OVERLAPPABLE #-} Monad m => MonadEffectSignal e b (ExceptT e m)
+instance (Monad m, Show e) => MonadEffectSignal e b (ExceptT SomeSignal m)
+instance MonadEffect (Signal a b) IO => MonadEffectSignal a b IO
 instance {-# OVERLAPPABLE #-} (MonadEffectSignal a b m, MonadTrans t, Monad (t m))
          => MonadEffectSignal a b (t m)
 
@@ -80,19 +94,6 @@ 
 -- | This handler can only behave like a regular exception handler. If used along with 'throwSignal'
 --   this module behaves like regular checked exceptions.
-handleAsException :: Monad m
-                  => (a -> m c)
-                  -> EffectHandler (Signal a b) (ExceptT c m) c
-                  -> m c
-handleAsException f = handleSignal (fmap Break . f)
-
--- | In case only 'throwSignal' is used then the function signatures will have a @'Throws' a m@
---   constraint or, equivalently, a @'MonadEffectSignal' a Void m@ constraint. In those cases you
---   can use this function to handle their exceptions. This function will not work for handing other
---   signals because 'ExceptT' doesn't satisfy other constraints.
---
---   The advantage of using this handler is that your inferred transformer stack will have one less
---   layer which can potentially lead to slight performance increases.
 handleException :: Monad m => (a -> m c) -> ExceptT a m c -> m c
 handleException f = either f return <=< runExceptT
 
@@ -100,8 +101,8 @@ handleToEither :: ExceptT e m a -> m (Either e a)
 handleToEither = runExceptT
 
--- | Discard all the 'Throws' constraints. If any exception was thrown the result will be
---   'Nothing'.
+-- | Discard all the 'Throws' and 'MonadEffectSignal' constraints. If any exception was thrown
+--   the result will be 'Nothing'.
 discardAllExceptions :: MaybeT m a -> m (Maybe a)
 discardAllExceptions = runMaybeT
 
@@ -109,7 +110,7 @@ mapLeft f (Left a) = Left (f a)
 mapLeft _ (Right b) = Right b
 
--- | Satisfies all the 'Throws' constraints _if_ they all throw 'Show'able exceptions. The first
---   thrown exception will be shown and returned as a 'Left' result.
+-- | Satisfies all the 'Throws' and 'MonadEffectSignal' constraints _if_ they all throw 'Show'able
+--   exceptions. The first thrown exception will be shown and returned as a 'Left' result.
 showAllExceptions :: Functor m => ExceptT SomeSignal m a -> m (Either Text a)
 showAllExceptions = fmap (mapLeft getSomeSignal) . runExceptT

@@ -0,0 +1,22 @@+{-# LANGUAGE NoMonomorphismRestriction, FlexibleContexts, ScopedTypeVariables #-}
+module Main where
+
+import Interlude
+
+import Control.Effects.Signal
+
+-- Should infer
+ex1 = signal True
+
+-- Should compile
+ex2 :: Throws Bool m => m ()
+ex2 = throwSignal False
+
+ex3 = do
+    discardAllExceptions ex1
+    showAllExceptions ex2
+    handleException (\(b :: Bool) -> return ()) ex2
+    handleSignal (\(_ :: Bool) -> Resume 5) ex1
+
+main :: IO ()
+main = return ()