Imperative Scripting EDSL

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
import Monad
import Control.Monad.State


data ScriptState a = ScriptState a deriving Show

data Command = Void | Init | Get3Numbers Int Int Int| GetName String | PrintName | PrintSum | Close | PrintMessage String
     deriving (Show)

preRecCommand :: Command -> Command
preRecCommand Init           = Void
preRecCommand GetName {}     = PrintMessage {}
preRecCommand Get3Numbers {} = preRecCommand GetName {}
preRecCommand PrintName      = GetName {}
preRecCommand PrintSum       = Get3Numbers {}

executeCommand :: Command -> StateT (ScriptState Command) IO ()
executeCommand Init = do
               (ScriptState c) <- get
               case c of
                    Void -> liftIO $ putStrLn (show c)
                    _    -> liftIO $ putStrLn "Init already called"
               put (ScriptState Init)
               return ()
executeCommand (GetName x) = do
               (ScriptState c) <- get
               case c of
                    PrintMessage _ -> do { str <- liftIO $ getLine; put (ScriptState (GetName str)); return ()}
                    _              -> liftIO $ putStrLn "PrintMessage not called"
              

executeCommand (PrintMessage m) = do
               liftIO $ putStrLn m
               put (ScriptState (PrintMessage m))
                    


mainloop :: StateT (ScriptState Command) IO ()
mainloop = do
         liftIO $ putStrLn "Hello World"
         executeCommand Init
         executeCommand Init
         executeCommand $ PrintMessage "Enter name"
         executeCommand $ GetName "abcd"
         return ()
         
start = ScriptState Void

main = do
     runStateT mainloop start


1:1: Warning: Use hierarchical imports
Found:
import Monad
Why not:
import Control.Monad
21:38: Error: Use print
Found:
putStrLn (show c)
Why not:
print c
28:51: Warning: Redundant $
Found:
liftIO $ getLine
Why not:
liftIO getLine
49:8: Error: Redundant do
Found:
do runStateT mainloop start
Why not:
runStateT mainloop start