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 GHC
import DynFlags
import System.Environment
import GhcMonad
testStrings = [
"import Data.Maybe"
, "import qualified Data.Maybe"
, "import Data.Maybe (isJust)"
, "add a b = a+b"
, "data Foo = Foo String"
, "deriving instance Show Foo"
, "{-# WARNING Foo \"Just a warning\" #-}"
, "{-# ANN foo (Just \"Hello\") #-}"
, "{-# RULES \"map/map\" forall f g xs. map f (map g xs) = map (f.g) xs #-}"
, "class HasString a where\n\
\ update :: a -> (String -> String) -> a\n\
\ upcase :: a -> a\n\
\ upcase x = update x (fmap toUpper)\n\
\ content :: a -> String\n\
\ default content :: Show a => a -> String\n\
\ content = show"
, "instance HasString Foo where\n\
\ update (Foo s) f = Foo (f s)\n\
\ content (Foo s) = s"
, "add a b"
, "let foo = add a b"
, "x <- foo y"
, "5 + 8"
, "a <-"
, "2 +"
, "@#"
]
main = do
[libdir] <- getArgs
runGhc (Just libdir) $ do
liftIO (putStrLn "Is import:")
testWithParser isImport
liftIO (putStrLn "Is declaration:")
testWithParser isDecl
liftIO (putStrLn "Is statement:")
testWithParser isStmt
where
testWithParser parser = do
dflags <- getSessionDynFlags
liftIO . putStrLn . unlines $ map (testExpr (parser dflags)) testStrings
testExpr parser expr = do
expr ++ ": " ++ show (parser expr)
|
