📚 3.2 done bitchessssssssssss
This commit is contained in:
@ -78,7 +78,12 @@ runEvalIO evalm = do
|
||||
case result of
|
||||
Right s -> case (lookup key s) of
|
||||
Just val -> runEvalIO' r db $ k val
|
||||
Nothing -> pure $ Left "Cannot find key :)"
|
||||
Nothing -> do
|
||||
input <- prompt $ "Invalid key: "++(show key)++". Enter a replacement: "
|
||||
let val = readVal input
|
||||
case val of
|
||||
Just v -> runEvalIO' r db $ (Free (KvGetOp v k))
|
||||
Nothing -> pure $ Left $ "Invalid key: "++input
|
||||
Left e -> pure $ Left e
|
||||
runEvalIO' r db (Free (KvPutOp key val m)) = do
|
||||
result <- readDB db
|
||||
|
@ -139,11 +139,35 @@ ioTests =
|
||||
r <- evalIO' (Let "_" (KvPut (CstInt 1) (CstInt 2)) (KvGet (CstInt 1)))
|
||||
r @?= Right (ValInt 2),
|
||||
--
|
||||
testCase "KvGetOp Bool" $ do
|
||||
r <- evalIO' (Let "_" (KvPut (CstBool True) (CstBool False)) (KvGet (CstBool True)))
|
||||
r @?= Right (ValBool False),
|
||||
--
|
||||
testCase "KvGetOp shadowing" $ do
|
||||
r <- evalIO' (Let "_" (KvPut (CstInt 1) (CstInt 2)) (Let "_" (KvPut (CstInt 1) (CstInt 3)) (KvGet (CstInt 1))))
|
||||
r @?= Right (ValInt 3),
|
||||
--
|
||||
testCase "KvGetOp fail" $ do
|
||||
r <- evalIO' (KvGet (CstInt 1))
|
||||
r @?= Left "Cannot find key :)"
|
||||
(_, r) <-
|
||||
captureIO [":)"] $
|
||||
evalIO' (KvGet (CstInt 1))
|
||||
r @?= Left "Invalid key: :)",
|
||||
--
|
||||
testCase "KvGetOp invalid int" $ do
|
||||
(_, r) <-
|
||||
captureIO ["ValInt 1"] $
|
||||
evalIO' (Let "_" (KvPut (CstInt 1) (CstInt 2)) (KvGet (CstInt 3)))
|
||||
r @?= Right (ValInt 2),
|
||||
--
|
||||
testCase "KvGetOp invalid bool" $ do
|
||||
(_, r) <-
|
||||
captureIO ["ValBool True"] $
|
||||
evalIO' (Let "_" (KvPut (CstBool True) (CstInt 2)) (KvGet (CstInt 3)))
|
||||
r @?= Right (ValInt 2),
|
||||
--
|
||||
testCase "KvGetOp invalid multiple" $ do
|
||||
(_, r) <-
|
||||
captureIO ["ValInt 1","ValInt 2","ValInt 3"] $
|
||||
evalIO' (Let "_" (KvPut (CstInt 3) (CstInt 2)) (KvGet (CstInt 4)))
|
||||
r @?= Right (ValInt 2)
|
||||
]
|
||||
|
Reference in New Issue
Block a user