mirror of
https://github.com/idris-lang/Idris2.git
synced 2024-12-17 00:10:31 +03:00
53 lines
1.6 KiB
Idris
53 lines
1.6 KiB
Idris
|
module Store
|
||
|
|
|
||
|
|
import Control.App
|
||
|
|
import Control.App.Console
|
||
|
|
|
||
|
|
data Access = LoggedOut | LoggedIn
|
||
|
|
data Store : Access -> Type where
|
||
|
|
MkStore : (secret : String) -> Store a
|
||
|
|
|
||
|
|
interface StoreI e where
|
||
|
|
connect : App1 e (Store LoggedOut)
|
||
|
|
login : (1 d : Store LoggedOut) -> (password : String) ->
|
||
|
|
App1 e (Res Bool (\ok => Store (if ok then LoggedIn else LoggedOut)))
|
||
|
|
logout : (1 d : Store LoggedIn) -> App1 e (Store LoggedOut)
|
||
|
|
readSecret : (1 d : Store LoggedIn) ->
|
||
|
|
App1 e (Res String (const (Store LoggedIn)))
|
||
|
|
disconnect : (1 d : Store LoggedOut) -> App {l} e ()
|
||
|
|
|
||
|
|
Has [Console] e => StoreI e where
|
||
|
|
connect
|
||
|
|
= do app $ putStrLn "Connect"
|
||
|
|
pure1 (MkStore "xyzzy")
|
||
|
|
|
||
|
|
login (MkStore str) pwd
|
||
|
|
= if pwd == "Mornington Crescent"
|
||
|
|
then pure1 (True @@ MkStore str)
|
||
|
|
else pure1 (False @@ MkStore str)
|
||
|
|
logout (MkStore str) = pure1 (MkStore str)
|
||
|
|
readSecret (MkStore str) = pure1 (str @@ MkStore str)
|
||
|
|
|
||
|
|
disconnect (MkStore _)
|
||
|
|
= putStrLn "Door destroyed"
|
||
|
|
|
||
|
|
storeProg : Has [Console, StoreI] e =>
|
||
|
|
App e ()
|
||
|
|
storeProg
|
||
|
|
= app1 $ do
|
||
|
|
s <- connect
|
||
|
|
app $ putStr "Password: "
|
||
|
|
pwd <- app $ getStr
|
||
|
|
True @@ s <- login s pwd
|
||
|
|
| False @@ s => do app $ putStrLn "Login failed"
|
||
|
|
app $ disconnect s
|
||
|
|
app $ putStrLn "Logged in"
|
||
|
|
secret @@ s <- readSecret s
|
||
|
|
app $ putStrLn ("Secret: " ++ secret)
|
||
|
|
s <- logout s
|
||
|
|
app $ putStrLn "Logged out"
|
||
|
|
app $ disconnect s
|
||
|
|
|
||
|
|
main : IO ()
|
||
|
|
main = run storeProg
|