🤡 database file

a4/src/APL/InterpIO.hs

@@ -62,9 +62,30 @@ runEvalIO evalm = do
     runEvalIO' :: Env -> FilePath -> EvalM a -> IO (Either Error a)
     runEvalIO' _ _ (Pure x) = pure $ pure x
     runEvalIO' r db (Free (ReadOp k)) = runEvalIO' r db $ k r
-    runEvalIO' r db (Free (StateGetOp k)) = error "TODO in Task 3"
-    runEvalIO' r db (Free (StatePutOp s m)) = error "TODO in Task 3"
+    runEvalIO' r db (Free (StateGetOp k)) = do
+      result <- readDB db
+      case result of
+        Right s -> runEvalIO' r db $ k s
+        Left e -> pure $ Left e
+    runEvalIO' r db (Free (StatePutOp s m)) = do
+      writeDB db s
+      runEvalIO' r db m
     runEvalIO' r db (Free (PrintOp p m)) = do
       putStrLn p
       runEvalIO' r db m
+    runEvalIO' r db (Free (KvGetOp key k)) = do
+      result <- readDB db
+      case result of
+        Right s -> case (lookup key s) of
+          Just val -> runEvalIO' r db $ k val
+          Nothing ->  pure $ Left "Cannot find key :)"
+        Left e -> pure $ Left e
+    runEvalIO' r db (Free (KvPutOp key val m)) = do
+      result <- readDB db
+      case result of
+        Right dbState -> do
+          let dbState' = (key,val):dbState
+          writeDB db dbState'
+          runEvalIO' r db m
+        Left e -> pure $ Left e
     runEvalIO' _ _ (Free (ErrorOp e)) = pure $ Left e

a4/src/APL/Interp_Tests.hs

@@ -113,12 +113,37 @@ ioTests =
               evalPrint s1
               evalPrint s2
         (out, res) @?= ([s1, s2], Right ()),
-        testCase "print 2" $ do
-           (out, res) <-
-             captureIO [] $
-               evalIO' $
-                 Print "This is also 1" $
-                   Print "This is 1" $
-                     CstInt 1
-           (out, res) @?= (["This is 1: 1", "This is also 1: 1"], Right $ ValInt 1)
+      ---
+      testCase "print 2" $ do
+          (out, res) <-
+            captureIO [] $
+              evalIO' $
+                Print "This is also 1" $
+                  Print "This is 1" $
+                    CstInt 1
+          (out, res) @?= (["This is 1: 1", "This is also 1: 1"], Right $ ValInt 1),
+      ---
+      testCase "State" $ do
+        r <- runEvalIO $ do
+          putState [(ValInt 0, ValInt 1)]
+          modifyState $ map (\(key, _) -> (key, ValInt 5))
+          getState
+
+        r @?= Right [(ValInt 0, ValInt 5)],
+      --
+      testCase "KvPutOp" $ do
+        r <- evalIO' (KvPut (CstInt 1) (CstInt 2))
+        r @?= Right (ValInt 2),
+      --
+      testCase "KvGetOp" $ do
+        r <- evalIO' (Let "_" (KvPut (CstInt 1) (CstInt 2)) (KvGet (CstInt 1)))
+        r @?= Right (ValInt 2),
+      --
+      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 :)"
     ]