conflicts

ChangeLog.md

@@ -1,3 +1,13 @@
-# Changelog for too-fast-too-free
+# Changelog for polysemy
+
+## 0.1.1.0 (2019-04-14)
+
+- Added 'runIO' interpretation (thanks to @adamConnerSax)
+- Minor documentation fixes
+
+
+## 0.1.0.0 (2019-04-11)
+
+- Initial release
 
 ## Unreleased changes

bench/Poly.hs

@@ -1,6 +1,8 @@
+{-# LANGUAGE BlockArguments   #-}
 {-# LANGUAGE DataKinds        #-}
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE GADTs            #-}
+{-# LANGUAGE TemplateHaskell  #-}
 {-# LANGUAGE TypeApplications #-}
 
 {-# OPTIONS_GHC -fwarn-all-missed-specializations #-}
@@ -11,6 +13,8 @@ import Polysemy
 import Polysemy.Error
 import Polysemy.Resource
 import Polysemy.State
+import Polysemy.Input
+import Polysemy.Output
 
 
 slowBeforeSpecialization :: Member (State Int) r => Semantic r Int
@@ -43,3 +47,17 @@ zoinks = fmap (fmap snd)
        . runState False
        $ prog
 
+data Console m a where
+  ReadLine :: Console m String
+  WriteLine :: String -> Console m ()
+
+makeSemantic ''Console
+
+runConsoleBoring :: [String] -> Semantic (Console ': r) a -> Semantic r ([String], a)
+runConsoleBoring inputs
+  = runFoldMapOutput (:[])
+  . runListInput inputs
+  . reinterpret2 \case
+      ReadLine -> maybe "" id <$> input
+      WriteLine msg -> output msg
+

package.yaml

@@ -1,5 +1,5 @@
 name:                polysemy
-version:             0.1.0.0
+version:             0.1.1.0
 github:              "isovector/polysemy"
 license:             BSD3
 author:              "Sandy Maguire"

polysemy.cabal

@@ -4,10 +4,10 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: 7cb717c5d021096a74fcdf5652a244182afb2047c7983b351ed1d9067efaa082
+-- hash: 6a7be8e3eda0643719ad6d2a30e4c307a34892d2b083ae8268abff01cccca34b
 
 name:           polysemy
-version:        0.1.0.0
+version:        0.1.1.0
 synopsis:       Higher-order, low-boilerplate, zero-cost free monads.
 description:    Please see the README on GitHub at <https://github.com/isovector/polysemy#readme>
 category:       Language
@@ -54,6 +54,7 @@ library
       Polysemy.Internal.TH.Effect
       Polysemy.Internal.TH.Performance
       Polysemy.Internal.Union
+      Polysemy.IO
       Polysemy.NonDet
       Polysemy.Output
       Polysemy.Random

src/Polysemy.hs

@@ -8,17 +8,17 @@ module Polysemy
   , runM
 
   -- * Interoperating With Other Monads
-  , Lift ()
+  , Lift (..)
   , sendM
 
     -- * Lifting
   , raise
 
     -- * Creating New Effects
-    -- | Effects should be defined as a GADT (enable @-XGADTs@), with kind @(* -> *) -> *@.
-    -- Every primitive action in the effect should be its own constructor of
-    -- the type. For example, we can model an effect which interacts with a tty
-    -- console as follows:
+    -- | Effects should be defined as a GADT (enable @-XGADTs@), with kind @(*
+    -- -> *) -> * -> *@. Every primitive action in the effect should be its
+    -- own constructor of the type. For example, we can model an effect which
+    -- interacts with a tty console as follows:
     --
     -- @
     -- data Console m a where

src/Polysemy/IO.hs

@@ -0,0 +1,41 @@
+{-# LANGUAGE AllowAmbiguousTypes #-}
+
+module Polysemy.IO
+  ( -- * Interpretations
+    runIO
+  ) where
+
+import Polysemy
+import Control.Monad.IO.Class
+
+
+------------------------------------------------------------------------------
+-- | The 'MonadIO' class is conceptually an interpretation of 'IO' to some
+-- other monad. This function reifies that intuition, by transforming an 'IO'
+-- effect into some other 'MonadIO'.
+--
+-- This function is especially useful when using the 'MonadIO' instance for
+-- 'Sem' instance.
+--
+-- Make sure to type-apply the desired 'MonadIO' instance when using 'runIO'.
+--
+-- @since 0.1.1.0
+--
+-- ==== Example
+--
+-- @
+-- foo :: PandocIO ()
+-- foo = 'runM' . 'runIO' @PandocIO $ do
+--   'liftIO' $ putStrLn "hello from polysemy"
+-- @
+--
+runIO
+    :: forall m r a
+     . ( MonadIO m
+       , Member (Lift m) r
+       )
+    => Sem (Lift IO ': r) a
+    -> Sem r a
+runIO = interpret $ sendM . liftIO @m . unLift
+{-# INLINE runIO #-}
+

src/Polysemy/Internal.hs

@@ -11,7 +11,7 @@ module Polysemy.Internal
   , run
   , runM
   , raise
-  , Lift ()
+  , Lift (..)
   , usingSem
   , liftSem
   , hoistSem
@@ -63,7 +63,7 @@ import Polysemy.Internal.Union
 -- monomorphic representation of the @r@ parameter.
 --
 -- After all of your effects are handled, you'll be left with either
--- a @'Sem' '[] a@ or a @'Sem' ('Lift' m) a@ value, which can be
+-- a @'Sem' '[] a@ or a @'Sem' '[ 'Lift' m ] a@ value, which can be
 -- consumed respectively by 'run' and 'runM'.
 --
 -- ==== Examples
@@ -162,18 +162,25 @@ instance Monad (Sem f) where
 
 instance (Member NonDet r) => Alternative (Sem r) where
   empty = send Empty
+  {-# INLINE empty #-}
   a <|> b = do
     send (Choose id) >>= \case
       False -> a
       True  -> b
+  {-# INLINE (<|>) #-}
 
 
+------------------------------------------------------------------------------
+-- | This instance will only lift 'IO' actions. If you want to lift into some
+-- other 'MonadIO' type, use this instance, and handle it via the
+-- 'Polysemy.IO.runIO' interpretation.
 instance (Member (Lift IO) r) => MonadIO (Sem r) where
   liftIO = sendM
   {-# INLINE liftIO #-}
 
 instance Member Fixpoint r => MonadFix (Sem r) where
   mfix f = send $ Fixpoint f
+  {-# INLINE mfix #-}
 
 
 liftSem :: Union r (Sem r) a -> Sem r a

src/Polysemy/Internal/Combinators.hs

@@ -219,7 +219,7 @@ reinterpret3H f (Sem m) = Sem $ \k -> m $ \u ->
 ------------------------------------------------------------------------------
 -- | Like 'reinterpret', but introduces /three/ intermediary effects.
 reinterpret3
-    :: FirstOrder e1 "reinterpret2"
+    :: FirstOrder e1 "reinterpret3"
     => (∀ m x. e1 m x -> Sem (e2 ': e3 ': e4 ': r) x)
        -- ^ A natural transformation from the handled effect to the new effects.
     -> Sem (e1 ': r) a

src/Polysemy/Internal/Lift.hs

@@ -23,7 +23,6 @@ module Polysemy.Internal.Lift where
 --
 -- Consider using 'Polysemy.Trace.trace' and 'Polysemy.Trace.runTraceIO' as
 -- a substitute for using 'putStrLn' directly.
-newtype Lift m (z :: * -> *) a = Lift
-  { unLift :: m a
-  }
+newtype Lift m (z :: * -> *) a where
+  Lift :: { unLift :: m a } -> Lift m z a
 

src/Polysemy/Internal/Tactics.hs

@@ -68,7 +68,7 @@ import Polysemy.Internal.Union
 -- block will not be visible inside of the @dealloc@ block.
 --
 -- Power users may explicitly use 'getInitialStateT' and 'bindT' to construct
--- whatever data flow they'd like; although this is usually necessary.
+-- whatever data flow they'd like; although this is usually unnecessary.
 type Tactical e m r x = ∀ f. (Functor f, Typeable1 f)
                           => Sem (WithTactics e f m r) (f x)