Merge pull request #12 from jhenahan/patch-1

Extend examples, make them easy to copy and paste

README.md

@@ -61,55 +61,92 @@ Make sure you read the [Necessary Language
 Extensions](https://github.com/isovector/polysemy#necessary-language-extensions)
 before trying these yourself!
 
-Console effect:
+Teletype effect:
 
 ```haskell
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase, BlockArguments #-}
+{-# LANGUAGE GADTs, FlexibleContexts, TypeOperators, DataKinds, PolyKinds #-}
 
 import Polysemy
+import Polysemy.Input
+import Polysemy.Output
 
-data Console m a where
-  ReadTTY  :: Console m String
-  WriteTTY :: String -> Console m ()
+data Teletype m a where
+  ReadTTY  :: Teletype m String
+  WriteTTY :: String -> Teletype m ()
 
-makeSem ''Console
+makeSem ''Teletype
 
-runConsoleIO :: Member (Lift IO) r => Sem (Console ': r) a -> Sem r a
-runConsoleIO = interpret $ \case
+runTeletypeIO :: Member (Lift IO) r => Sem (Teletype ': r) a -> Sem r a
+runTeletypeIO = interpret $ \case
   ReadTTY      -> sendM getLine
   WriteTTY msg -> sendM $ putStrLn msg
+
+runTeletypePure :: [String] -> Sem (Teletype ': r) a -> Sem r ([String], a)
+runTeletypePure i
+  = runFoldMapOutput pure  -- For each WriteTTY in our program, consume an output by appending it to the list in a ([String], a)
+  . runListInput i         -- Treat each element of our list of strings as a line of input
+  . reinterpret2 \case     -- Reinterpret our effect in terms of Input and Output
+      ReadTTY -> maybe "" id <$> input
+      WriteTTY msg -> output msg
+
+
+echo :: Member Teletype r => Sem r ()
+echo = do
+  i <- readTTY
+  case i of
+    "" -> pure ()
+    _  -> writeTTY i >> echo
+
+
+-- Let's pretend
+echoPure :: [String] -> Sem '[] ([String], ())
+echoPure = flip runTeletypePure echo
+
+pureOutput :: [String] -> [String]
+pureOutput = fst . run . echoPure
+
+-- Now let's do things
+echoIO :: Sem '[Lift IO] ()
+echoIO = runTeletypeIO echo
+
+-- echo forever
+main :: IO ()
+main = runM echoIO
 ```
 
 
 Resource effect:
 
 ```haskell
+{-# OPTIONS_GHC -fplugin=Polysemy.Plugin #-}
 {-# LANGUAGE TemplateHaskell #-}
+{-# LANGUAGE LambdaCase, BlockArguments #-}
+{-# LANGUAGE GADTs, FlexibleContexts, TypeOperators, DataKinds, PolyKinds, TypeApplications #-}
 
-import qualified Control.Exception as X
-import           Polysemy
+import Prelude hiding (throw, catch, bracket)
+import Polysemy
+import Polysemy.Input
+import Polysemy.Output
+import Polysemy.Error
+import Polysemy.Resource
 
-data Resource m a where
-  Bracket :: m a -> (a -> m ()) -> (a -> m b) -> Resource m b
+-- Using Teletype effect from above
 
-makeSem ''Resource
+data CustomException = ThisException | ThatException deriving Show
 
-runResource
-    :: forall r a
-     . Member (Lift IO) r
-    => (∀ x. Sem r x -> IO x)
-    -> Sem (Resource ': r) a
-    -> Sem r a
-runResource finish = interpretH $ \case
-  Bracket alloc dealloc use -> do
-    a <- runT  alloc
-    d <- bindT dealloc
-    u <- bindT use
+program :: Members '[Resource, Teletype, Error CustomException] r => Sem r ()
+program = catch work $ \e -> writeTTY ("Caught " ++ show e)
+  where work = bracket (readTTY) (const $ writeTTY "exiting bracket") $ \input -> do
+          writeTTY "entering bracket"
+          case input of
+            "explode"     -> throw ThisException
+            "weird stuff" -> writeTTY input >> throw ThatException
+            _             -> writeTTY input >> writeTTY "no exceptions"
 
-    let runIt :: Sem (Resource ': r) x -> IO x
-        runIt = finish .@ runResource
-
-    sendM $ X.bracket (runIt a) (runIt . d) (runIt . u)
+main :: IO (Either CustomException ())
+main = (runM .@ runResource .@@ runErrorInIO @CustomException) . runTeletypeIO $ program
 ```
 
 Easy.
@@ -172,4 +209,3 @@ You're going to want to stick all of this into your `package.yaml` file.
     - TypeOperators
     - TypeFamilies
 ```
-