blob: fa4416f70838160665dcd3e457cec5e275caf10e (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
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)
|
