@@ -12,7 +12,7 @@ import Text.Regex.Posix
12
12
import System.Environment
13
13
import System.Directory (getHomeDirectory )
14
14
import System.FilePath ((</>) )
15
- import System.Console.Haskeline hiding ( handle , catch , throwTo )
15
+ import System.Console.Haskeline
16
16
import System.Console.GetOpt
17
17
import System.Exit (ExitCode (.. ), exitWith )
18
18
@@ -24,7 +24,7 @@ import qualified Paths_egison_tutorial as P
24
24
25
25
main :: IO ()
26
26
main = do args <- getArgs
27
- let (actions, nonOpts , _) = getOpt Permute tOptions args
27
+ let (actions, _ , _) = getOpt Permute tOptions args
28
28
let tOpts = foldl (flip id ) defaultEgisonTutorialOpts actions
29
29
runWithEgisonTutorialOpts tOpts
30
30
@@ -45,7 +45,7 @@ runWithEgisonTutorialOpts EgisonTutorialOpts{ tOptSection = Just sn, tOptSubSect
45
45
putStrLn ret
46
46
runWithEgisonTutorialOpts EgisonTutorialOpts { tOptShowHelp = True } = printHelp
47
47
runWithEgisonTutorialOpts EgisonTutorialOpts { tOptShowVersion = True } = printVersionNumber
48
- runWithEgisonTutorialOpts tOpts = evalRuntimeT ET. defaultOption run
48
+ runWithEgisonTutorialOpts EgisonTutorialOpts { tOptPrompt = prompt } = evalRuntimeT ET. defaultOption { optPrompt = prompt } run
49
49
50
50
run :: RuntimeM ()
51
51
run = do
@@ -175,14 +175,15 @@ getNumber n = do
175
175
getNumber n
176
176
177
177
-- | Get Egison expression from the prompt. We can handle multiline input.
178
- getEgisonExprOrNewLine :: EgisonOpts -> InputT RuntimeM (Either Bool (String , TopExpr ))
179
- getEgisonExprOrNewLine opts = getEgisonExprOrNewLine' opts " "
178
+ getEgisonExprOrNewLine :: InputT RuntimeM (Either Bool (String , TopExpr ))
179
+ getEgisonExprOrNewLine = getEgisonExprOrNewLine' " "
180
180
181
- getEgisonExprOrNewLine' :: EgisonOpts -> String -> InputT RuntimeM (Either Bool (String , TopExpr ))
182
- getEgisonExprOrNewLine' opts prev = do
181
+ getEgisonExprOrNewLine' :: String -> InputT RuntimeM (Either Bool (String , TopExpr ))
182
+ getEgisonExprOrNewLine' prev = do
183
+ opts <- lift ask
183
184
mLine <- case prev of
184
185
" " -> getInputLine $ optPrompt opts
185
- _ -> getInputLine $ replicate (length $ optPrompt opts) ' '
186
+ _ -> getInputLine $ replicate (length ( optPrompt opts) ) ' '
186
187
case mLine of
187
188
Nothing -> return $ Left False -- The user's input is 'Control-D'.
188
189
Just [] -> return $ Left True -- The user's input is 'Enter'.
@@ -191,10 +192,10 @@ getEgisonExprOrNewLine' opts prev = do
191
192
parsedExpr <- lift $ Parser. parseTopExpr input
192
193
case parsedExpr of
193
194
Left err | show err =~ " unexpected end of input" ->
194
- getEgisonExprOrNewLine' opts $ input ++ " \n "
195
+ getEgisonExprOrNewLine' ( input ++ " \n " )
195
196
Left err -> do
196
197
liftIO $ print err
197
- getEgisonExprOrNewLine opts
198
+ getEgisonExprOrNewLine
198
199
Right topExpr -> return $ Right (input, topExpr)
199
200
200
201
replSettings :: MonadIO m => FilePath -> Env -> Settings m
@@ -215,17 +216,17 @@ repl :: Env -> RuntimeM ()
215
216
repl env = do
216
217
section <- liftIO $ selectSection tutorial
217
218
case section of
218
- Section _ cs -> loop env cs True
219
+ Section _ cs -> repl' env cs True
219
220
where
220
- loop :: Env -> [Content ] -> Bool -> RuntimeM ()
221
- loop env [] _ = do
221
+ repl' :: Env -> [Content ] -> Bool -> RuntimeM ()
222
+ repl' env [] _ = do
222
223
repl env
223
- loop env (content: contents) b = (do
224
+ repl' env (content: contents) b = (do
224
225
if b
225
226
then liftIO $ putStrLn $ show content
226
227
else return ()
227
228
home <- liftIO $ getHomeDirectory
228
- input <- runInputT (replSettings home env) $ getEgisonExprOrNewLine ET. defaultOption
229
+ input <- runInputT (replSettings home env) $ getEgisonExprOrNewLine
229
230
case input of
230
231
-- The user input 'Control-D'.
231
232
Left False -> do
@@ -235,28 +236,28 @@ repl env = do
235
236
else do
236
237
b <- liftIO $ yesOrNo " Do you want to proceed next?"
237
238
if b
238
- then loop env contents True
239
- else loop env (content: contents) False
239
+ then repl' env contents True
240
+ else repl' env (content: contents) False
240
241
-- The user input just 'Enter'.
241
242
Left True -> do
242
243
b <- liftIO $ yesOrNo " Do you want to proceed next?"
243
244
if b
244
- then loop env contents True
245
- else loop env (content: contents) False
245
+ then repl' env contents True
246
+ else repl' env (content: contents) False
246
247
Right (topExpr, _) -> do
247
- result <- fromEvalT (runTopExpr env topExpr)
248
+ result <- fromEvalT (runTopExprStr env topExpr)
248
249
case result of
249
250
Left err -> do
250
251
liftIO $ putStrLn $ show err
251
- loop env (content: contents) False
252
- Right (Just ret , env') -> liftIO (putStrLn ( show ret)) >> loop env' (content: contents) False
253
- Right (Nothing , env') -> loop env' (content: contents) False )
252
+ repl' env (content: contents) False
253
+ Right (Just output , env') -> liftIO (putStrLn output) >> repl' env' (content: contents) False
254
+ Right (Nothing , env') -> repl' env' (content: contents) False )
254
255
`catch`
255
256
(\ e -> case e of
256
- UserInterrupt -> liftIO (putStrLn " " ) >> loop env (content: contents) False
257
- StackOverflow -> liftIO (putStrLn " Stack over flow!" ) >> loop env (content: contents) False
258
- HeapOverflow -> liftIO (putStrLn " Heap over flow!" ) >> loop env (content: contents) False
259
- _ -> liftIO (putStrLn " error!" ) >> loop env (content: contents) False
257
+ UserInterrupt -> liftIO (putStrLn " " ) >> repl' env (content: contents) False
258
+ StackOverflow -> liftIO (putStrLn " Stack over flow!" ) >> repl' env (content: contents) False
259
+ HeapOverflow -> liftIO (putStrLn " Heap over flow!" ) >> repl' env (content: contents) False
260
+ _ -> liftIO (putStrLn " error!" ) >> repl' env (content: contents) False
260
261
)
261
262
262
263
data Tutorial = Tutorial [Section ]
0 commit comments