mirror of
https://github.com/polysemy-research/polysemy.git
synced 2024-09-11 02:25:43 +03:00
f30da0c178
* Properly track skolems for plugin unification * Update haddock * Cleanup imports * Guard the import of unify
48 lines
1.3 KiB
Haskell
48 lines
1.3 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module ExampleSpec where
|
|
|
|
import Polysemy
|
|
import Polysemy.Error
|
|
import Polysemy.Input
|
|
import Polysemy.Output
|
|
import Polysemy.Resource
|
|
import Test.Hspec
|
|
|
|
data Teletype m a where
|
|
ReadTTY :: Teletype m String
|
|
WriteTTY :: String -> Teletype m ()
|
|
|
|
makeSem ''Teletype
|
|
|
|
teletypeToIO :: Member (Embed IO) r => Sem (Teletype ': r) a -> Sem r a
|
|
teletypeToIO = interpret $ \case
|
|
ReadTTY -> embed getLine
|
|
WriteTTY msg -> embed $ putStrLn msg
|
|
|
|
data CustomException = ThisException | ThatException deriving Show
|
|
|
|
program :: Members '[Teletype, Resource, Error CustomException] r => Sem r ()
|
|
program = catch @CustomException work $ \e -> writeTTY ("Caught " ++ show e)
|
|
where work = bracket (readTTY) (const $ writeTTY "exiting bracket") $ \i -> do
|
|
writeTTY "entering bracket"
|
|
case i of
|
|
"explode" -> throw ThisException
|
|
"weird stuff" -> writeTTY i >> throw ThatException
|
|
_ -> writeTTY i >> writeTTY "no exceptions"
|
|
|
|
foo :: IO (Either CustomException ())
|
|
foo =
|
|
runFinal
|
|
. embedToFinal @IO
|
|
. resourceToIOFinal
|
|
. errorToIOFinal @CustomException
|
|
. teletypeToIO
|
|
$ program
|
|
|
|
spec :: Spec
|
|
spec = describe "example" $ do
|
|
it "should compile!" $ do
|
|
True `shouldBe` True
|
|
|