diff options
author | tomsmeding <tom.smeding@gmail.com> | 2019-03-10 00:13:32 +0100 |
---|---|---|
committer | tomsmeding <tom.smeding@gmail.com> | 2019-03-10 00:13:32 +0100 |
commit | 34d9f21c6ab529e415f38a5a886b1b612bcbd3bc (patch) | |
tree | 15a7f35385515b7bc65a3cc5c84249533e1c62c3 /src/Main.hs |
Initial
Diffstat (limited to 'src/Main.hs')
-rw-r--r-- | src/Main.hs | 58 |
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) |