aboutsummaryrefslogtreecommitdiff
path: root/src/Main.hs
diff options
context:
space:
mode:
authortomsmeding <tom.smeding@gmail.com>2019-03-10 00:13:32 +0100
committertomsmeding <tom.smeding@gmail.com>2019-03-10 00:13:32 +0100
commit34d9f21c6ab529e415f38a5a886b1b612bcbd3bc (patch)
tree15a7f35385515b7bc65a3cc5c84249533e1c62c3 /src/Main.hs
Initial
Diffstat (limited to 'src/Main.hs')
-rw-r--r--src/Main.hs58
1 files changed, 58 insertions, 0 deletions
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..fa4416f
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,58 @@
+module Main where
+
+import Control.Monad
+import Haskell.Env
+import Haskell.SimpleParser
+import System.Environment
+import System.Exit
+import System.IO
+
+
+tryEither :: Either String a -> IO a
+tryEither (Left err) = die err
+tryEither (Right x) = return x
+
+tryEither' :: Show e => Either e a -> IO a
+tryEither' (Left err) = die (show err)
+tryEither' (Right x) = return x
+
+while :: Monad m => a -> (a -> m (Maybe a)) -> m ()
+while val f = f val >>= \case
+ Nothing -> return ()
+ Just val' -> while val' f
+
+whenM :: Monad m => m Bool -> m a -> m ()
+whenM b a = b >>= \b' -> if b' then void a else return ()
+
+main :: IO ()
+main = do
+ fname <- getArgs >>= \case
+ [fname] -> return fname
+ _ -> die "Usage: verify-hs <file.hs>"
+
+ source <- readFile fname
+ ast <- tryEither' (parseAST fname source)
+ print ast
+ env0 <- tryEither (envFromAST ast)
+ print env0
+
+ while env0 $ \env -> do
+ putStrLn ""
+ putStr "> " >> hFlush stdout
+
+ eof <- isEOF
+ if eof
+ then return Nothing
+ else words <$> getLine >>= \case
+ [] -> return (Just env)
+
+ ["forget", name] ->
+ case forget name env of
+ Left err -> putStrLn err >> return (Just env)
+ Right env' -> return (Just env')
+
+ ["show"] -> print env >> return (Just env)
+
+ cmd -> do
+ putStrLn $ "Unrecognised command: " ++ show cmd
+ return (Just env)