Base instances

.gitattributes

@@ -0,0 +1 @@
+*.hs-boot linguist-language=Haskell

src/Control/Carrier.hs

@@ -9,7 +9,7 @@ module Control.Carrier
 , send
 ) where
 
-import Control.Carrier.Class
+import {-# SOURCE #-} Control.Carrier.Class
 import Control.Carrier.Pure
 import Control.Effect.Class
 import Control.Effect.Sum

src/Control/Carrier.hs-boot

@@ -0,0 +1,19 @@
+{-# LANGUAGE ConstraintKinds #-}
+module Control.Carrier
+( -- * Re-exports
+  module Control.Carrier.Class
+, module Control.Carrier.Pure
+, module Control.Effect.Class
+, (:+:)(..)
+, Has
+, send
+) where
+
+import {-# SOURCE #-} Control.Carrier.Class
+import Control.Carrier.Pure
+import Control.Effect.Class
+import Control.Effect.Sum
+
+type Has eff sig m = (Inject eff sig, Carrier sig m)
+
+send :: Has eff sig m => eff m a -> m a

src/Control/Carrier/Class.hs

@@ -1,11 +1,40 @@
-{-# LANGUAGE FunctionalDependencies #-}
+{-# LANGUAGE FlexibleInstances, FunctionalDependencies #-}
 module Control.Carrier.Class
 ( Carrier(..)
 ) where
 
 import Control.Effect.Class
+import Control.Effect.Choose (Choose(..))
+import Control.Effect.Empty (Empty(..))
+import Control.Effect.Error (Error(..))
+import Control.Effect.NonDet (NonDet)
+import Control.Effect.Reader (Reader(..))
+import Control.Effect.Sum ((:+:)(..))
+import Control.Effect.Writer (Writer(..))
+import Control.Monad ((<=<))
 
 -- | The class of carriers (results) for algebras (effect handlers) over signatures (effects), whose actions are given by the 'eff' method.
 class (HFunctor sig, Monad m) => Carrier sig m | m -> sig where
   -- | Construct a value in the carrier for an effect signature (typically a sum of a handled effect and any remaining effects).
   eff :: sig m a -> m a
+
+
+instance Carrier Empty Maybe where
+  eff Empty = Nothing
+
+instance Carrier (Error e) (Either e) where
+  eff (Throw e)     = Left e
+  eff (Catch m h k) = either (k <=< h) k m
+
+instance Carrier (Reader r) ((->) r) where
+  eff (Ask       k) r = k r r
+  eff (Local f m k) r = k (m (f r)) r
+
+instance Carrier NonDet [] where
+  eff (L Empty)      = []
+  eff (R (Choose k)) = k True ++ k False
+
+instance Monoid w => Carrier (Writer w) ((,) w) where
+  eff (Tell w (w', k))    = (mappend w w', k)
+  eff (Listen m k)        = uncurry k m
+  eff (Censor f (w, a) k) = let (w', a') = k a in (mappend (f w) w', a')

src/Control/Carrier/Class.hs-boot

@@ -0,0 +1,9 @@
+{-# LANGUAGE FunctionalDependencies #-}
+module Control.Carrier.Class
+( Carrier(..)
+) where
+
+import Control.Effect.Class
+
+class (HFunctor sig, Monad m) => Carrier sig m | m -> sig where
+  eff :: sig m a -> m a

src/Control/Carrier/Pure.hs

@@ -8,7 +8,7 @@ module Control.Carrier.Pure
 ) where
 
 import Control.Applicative
-import Control.Carrier.Class
+import {-# SOURCE #-} Control.Carrier.Class
 import Control.Effect.Pure
 import Control.Monad.Fix
 import Data.Coerce

src/Control/Effect/Choose.hs

@@ -11,7 +11,7 @@ module Control.Effect.Choose
 , Choosing(..)
 ) where
 
-import Control.Carrier
+import {-# SOURCE #-} Control.Carrier
 import Control.Effect.Empty
 import Data.Bool (bool)
 import Data.List.NonEmpty (NonEmpty (..))

src/Control/Effect/Empty.hs

@@ -6,7 +6,7 @@ module Control.Effect.Empty
 , guard
 ) where
 
-import Control.Carrier
+import {-# SOURCE #-} Control.Carrier
 import GHC.Generics (Generic1)
 
 -- | An effect modelling nondeterminism without choice.

src/Control/Effect/Error.hs

@@ -6,7 +6,7 @@ module Control.Effect.Error
 , catchError
 ) where
 
-import Control.Carrier
+import {-# SOURCE #-} Control.Carrier
 
 data Error exc m k
   = Throw exc

src/Control/Effect/Reader.hs

@@ -7,7 +7,7 @@ module Control.Effect.Reader
 , local
 ) where
 
-import Control.Carrier
+import {-# SOURCE #-} Control.Carrier
 
 data Reader r m k
   = Ask (r -> m k)

src/Control/Effect/Writer.hs

@@ -8,7 +8,7 @@ module Control.Effect.Writer
 , censor
 ) where
 
-import Control.Carrier
+import {-# SOURCE #-} Control.Carrier
 
 data Writer w m k
   = Tell w (m k)