using a modern lib - covered briefly
This commit is contained in:
parent
265005f8c6
commit
ad40b9b7f8
54
consoledsl_done.hs
Normal file
54
consoledsl_done.hs
Normal file
@ -0,0 +1,54 @@
|
||||
{-# LANGUAGE GADTs #-}
|
||||
{-# LANGUAGE TypeApplications #-}
|
||||
{-# LANGUAGE FlexibleContexts #-}
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE PolyKinds #-}
|
||||
{-# LANGUAGE TemplateHaskell #-}
|
||||
{-# LANGUAGE LambdaCase #-}
|
||||
{-# LANGUAGE ScopedTypeVariables #-}
|
||||
|
||||
import Polysemy
|
||||
import Test.Hspec
|
||||
|
||||
-- kind must be :: (* -> *) -> * -> *
|
||||
data Console m a where
|
||||
PrintLine :: String -> Console m ()
|
||||
ReadLine :: Console m String
|
||||
|
||||
makeSem ''Console
|
||||
|
||||
-- printLine :: Member Console r => String -> Sem r ()
|
||||
-- readLine :: Member Console r => Sem r a
|
||||
-- run :: Sem '[] a -> a
|
||||
-- runM :: Sem '[Embed m] a -> m a
|
||||
-- embed :: Member (Embed m) r => m a -> Sem r a
|
||||
|
||||
runConsoleIO :: Member (Embed IO) r => Sem (Console ': r) a -> Sem r a
|
||||
runConsoleIO = interpret $ \case
|
||||
PrintLine msg -> embed $ putStrLn msg
|
||||
ReadLine -> embed $ getLine
|
||||
|
||||
runConsolePure :: String -> Sem (Console ': r) a -> Sem r a
|
||||
runConsolePure s = interpret $ \case
|
||||
PrintLine msg -> pure ()
|
||||
ReadLine -> pure s
|
||||
|
||||
spec :: Spec
|
||||
spec = describe "program" $ do
|
||||
it "adds 2 numbers given by user" $ do
|
||||
let res = run . runConsolePure "7" $ program
|
||||
res `shouldBe` (7 + 7)
|
||||
|
||||
program :: Member Console r => Sem r Int
|
||||
program = do
|
||||
printLine "Insert number 1"
|
||||
a <- readLine
|
||||
printLine "Insert number 2"
|
||||
b <- readLine
|
||||
pure $ read a + read b
|
||||
|
||||
main :: IO ()
|
||||
main = execute >>= print
|
||||
where
|
||||
execute = runM . runConsoleIO $ program
|
Loading…
Reference in New Issue
Block a user