idris-0.99.2: samples/ST/Intro.idr
import Control.ST
import Data.Vect
-- Basic state
-- increment : (x : Var) -> STrans m () [x ::: State Int]
-- (const [x ::: State Int])
increment : (x : Var) -> ST m () [x ::: State Int]
increment x = do num <- read x
write x (num + 1)
-- makeAndIncrement : Int -> STrans m Int [] (const [])
makeAndIncrement : Int -> ST m Int []
makeAndIncrement init = do var <- new init
increment var
x <- read var
delete var
pure x
ioMakeAndIncrementBad : STrans IO () [] (const [])
ioMakeAndIncrementBad
= do lift $ putStr "Enter a number: "
init <- lift $ getLine
var <- new (cast init)
lift $ putStrLn ("var = " ++ show !(read var))
increment var
lift $ putStrLn ("var = " ++ show !(read var))
delete var
ioMakeAndIncrement : ConsoleIO io => STrans io () [] (const [])
ioMakeAndIncrement
= do putStr "Enter a number: "
init <- getStr
var <- new (cast init)
putStrLn ("var = " ++ show !(read var))
increment var
putStrLn ("var = " ++ show !(read var))
delete var
-- Dependent state
-- addElement : (vec : Var) -> (item : a) ->
-- STrans m () [vec ::: State (Vect n a)]
-- (const [vec ::: State (Vect (S n) a)])
addElement : (vec : Var) -> (item : a) ->
ST m () [vec ::: State (Vect n a) :-> State (Vect (S n) a)]
addElement vec item = do xs <- read vec
write vec (item :: xs)
addElement' : (vec : Var) -> (item : a) ->
STrans m () [vec ::: State (Vect n a)]
(const [vec ::: State (Vect (S n) a)])
addElement' vec item = update vec (item ::)
-- readAndAdd : ConsoleIO io => (vec : Var) ->
-- STrans io Bool [vec ::: State (Vect n Integer)]
-- (\res => [vec ::: State (if res then Vect (S n) Integer
-- else Vect n Integer)])
readAndAdd : ConsoleIO io => (vec : Var) ->
ST io Bool
[vec ::: State (Vect n Integer) :->
\res => State (if res then Vect (S n) Integer
else Vect n Integer)]
readAndAdd vec = do putStr "Enter a number: "
num <- getStr
if all isDigit (unpack num)
then returning True (update vec ((cast num) ::))
else returning False (pure ())
-- newState : STrans m Var [] (\lbl => [lbl ::: State Int])
newState : ST m Var [add (State Int)]
-- removeState : (lbl : Var) -> STrans m () [lbl ::: State Int] (const [])
removeState : (lbl : Var) -> ST m () [remove lbl (State Int)]