Skip to content

Commit ae92e06

Browse files
egisatoshiegisatoshi
committed
make the code compatibale to Egison 4.1.2
1 parent 386df83 commit ae92e06

File tree

2 files changed

+84
-74
lines changed

2 files changed

+84
-74
lines changed

‎Main.hs‎

Lines changed: 83 additions & 74 deletions
Original file line numberDiff line numberDiff line change
@@ -1,7 +1,9 @@
11
module Main where
22

3-
import Control.Exception (AsyncException(..), catch)
3+
import Control.Exception (AsyncException (..))
4+
import Control.Monad.Catch (catch)
45
import Control.Monad.Except
6+
import Control.Monad.Reader
57

68
import Data.Version
79
import Data.List
@@ -15,78 +17,85 @@ import System.Console.GetOpt
1517
import System.Exit (ExitCode (..), exitWith)
1618

1719
import Language.Egison
18-
import qualified Language.Egison.CmdOptions as ET
20+
import qualified Language.Egison.CmdOptions as ET
1921
import Language.Egison.Completion (completeEgison)
2022
import qualified Language.Egison.Parser.NonS as Parser
2123
import qualified Paths_egison_tutorial as P
2224

2325
main :: IO ()
2426
main = do args <- getArgs
25-
let (actions, nonOpts, _) = getOpt Permute options args
26-
let opts = foldl (flip id) defaultOptions actions
27-
case opts of
28-
Options {optShowSections = True} -> putStrLn $ show tutorial
29-
Options {optSection = Just sn, optSubSection = Just ssn} -> do
30-
let sn' = (read sn) :: Int
31-
let ssn' = (read ssn) :: Int
32-
let ret = case tutorial of
33-
Tutorial ss ->
34-
if 0 < sn' && sn' <= length ss
35-
then case nth sn' ss of
36-
Section _ cs ->
37-
if 0 < ssn' && ssn' <= length cs
38-
then showContent $ nth ssn' cs
39-
else "error: content out of range"
40-
else "error: section out of range"
41-
putStrLn ret
42-
Options {optShowHelp = True} -> printHelp
43-
Options {optShowVersion = True} -> printVersionNumber
44-
Options {optPrompt = prompt} -> do
45-
env <- initialEnv ET.defaultOption
46-
case nonOpts of
47-
[] -> showBanner >> repl env prompt
48-
_ -> printHelp
49-
50-
data Options = Options {
51-
optShowVersion :: Bool,
52-
optShowHelp :: Bool,
53-
optPrompt :: String,
54-
optShowSections :: Bool,
55-
optSection :: Maybe String,
56-
optSubSection :: Maybe String
27+
let (actions, nonOpts, _) = getOpt Permute tOptions args
28+
let tOpts = foldl (flip id) defaultEgisonTutorialOpts actions
29+
runWithEgisonTutorialOpts tOpts
30+
31+
runWithEgisonTutorialOpts :: EgisonTutorialOpts -> IO ()
32+
runWithEgisonTutorialOpts EgisonTutorialOpts{ tOptShowSections = True } = putStrLn $ show tutorial
33+
runWithEgisonTutorialOpts EgisonTutorialOpts{ tOptSection = Just sn, tOptSubSection = Just ssn } = do
34+
let sn' = (read sn) :: Int
35+
let ssn' = (read ssn) :: Int
36+
let ret = case tutorial of
37+
Tutorial ss ->
38+
if 0 < sn' && sn' <= length ss
39+
then case nth sn' ss of
40+
Section _ cs ->
41+
if 0 < ssn' && ssn' <= length cs
42+
then showContent $ nth ssn' cs
43+
else "error: content out of range"
44+
else "error: section out of range"
45+
putStrLn ret
46+
runWithEgisonTutorialOpts EgisonTutorialOpts{ tOptShowHelp = True } = printHelp
47+
runWithEgisonTutorialOpts EgisonTutorialOpts{ tOptShowVersion = True } = printVersionNumber
48+
runWithEgisonTutorialOpts tOpts = evalRuntimeT ET.defaultOption run
49+
50+
run :: RuntimeM ()
51+
run = do
52+
opts <- ask
53+
coreEnv <- initialEnv
54+
mEnv <- fromEvalT $ evalTopExprs coreEnv $ map Load (optLoadLibs opts) ++ map LoadFile (optLoadFiles opts)
55+
case mEnv of
56+
Left err -> liftIO $ print err
57+
Right env -> repl env
58+
59+
data EgisonTutorialOpts = EgisonTutorialOpts {
60+
tOptShowVersion :: Bool,
61+
tOptShowHelp :: Bool,
62+
tOptPrompt :: String,
63+
tOptShowSections :: Bool,
64+
tOptSection :: Maybe String,
65+
tOptSubSection :: Maybe String
5766
}
5867

59-
defaultOptions :: Options
60-
defaultOptions = Options {
61-
optShowVersion = False,
62-
optShowHelp = False,
63-
optPrompt = "> ",
64-
optShowSections = False,
65-
optSection = Nothing,
66-
optSubSection = Nothing
68+
defaultEgisonTutorialOpts :: EgisonTutorialOpts
69+
defaultEgisonTutorialOpts = EgisonTutorialOpts {
70+
tOptShowVersion = False,
71+
tOptShowHelp = False,
72+
tOptPrompt = "> ",
73+
tOptShowSections = False,
74+
tOptSection = Nothing,
75+
tOptSubSection = Nothing
6776
}
6877

69-
options :: [OptDescr (Options -> Options)]
70-
options = [
78+
tOptions :: [OptDescr (EgisonTutorialOpts -> EgisonTutorialOpts)]
79+
tOptions = [
7180
Option ['v', 'V'] ["version"]
72-
(NoArg (\opts -> opts {optShowVersion = True}))
81+
(NoArg (\tOpts -> tOpts {tOptShowVersion = True}))
7382
"show version number",
7483
Option ['h', '?'] ["help"]
75-
(NoArg (\opts -> opts {optShowHelp = True}))
84+
(NoArg (\tOpts -> tOpts {tOptShowHelp = True}))
7685
"show usage information",
7786
Option ['p'] ["prompt"]
78-
(ReqArg (\prompt opts -> opts {optPrompt = prompt})
87+
(ReqArg (\prompt tOpts -> tOpts {tOptPrompt = prompt})
7988
"String")
8089
"set prompt string",
8190
Option ['l'] ["list"]
82-
(NoArg (\opts -> opts {optShowSections = True}))
91+
(NoArg (\tOpts -> tOpts {tOptShowSections = True}))
8392
"show section list",
8493
Option ['s'] ["section"]
85-
(ReqArg (\sn opts -> opts {optSection = Just sn})
94+
(ReqArg (\sn tOpts -> tOpts {tOptSection = Just sn})
8695
"String")
8796
"set section number",
8897
Option ['c'] ["subsection"]
89-
(ReqArg (\ssn opts -> opts {optSubSection = Just ssn})
98+
(ReqArg (\ssn tOpts -> tOpts {tOptSubSection = Just ssn})
9099
"String")
91100
"set subsection number"
92101
]
@@ -95,7 +104,7 @@ printHelp :: IO ()
95104
printHelp = do
96105
putStrLn "Usage: egison-tutorial [options]"
97106
putStrLn ""
98-
putStrLn "Options:"
107+
putStrLn "EgisonTutorialOpts:"
99108
putStrLn " --help Display this information"
100109
putStrLn " --version Display egison version information"
101110
putStrLn " --prompt string Set prompt of the interpreter"
@@ -166,10 +175,10 @@ getNumber n = do
166175
getNumber n
167176

168177
-- |Get Egison expression from the prompt. We can handle multiline input.
169-
getEgisonExprOrNewLine :: Options -> InputT IO (Either Bool (String, EgisonTopExpr))
178+
getEgisonExprOrNewLine :: EgisonOpts -> InputT RuntimeM (Either Bool (String, TopExpr))
170179
getEgisonExprOrNewLine opts = getEgisonExprOrNewLine' opts ""
171180

172-
getEgisonExprOrNewLine' :: Options -> String -> InputT IO (Either Bool (String, EgisonTopExpr))
181+
getEgisonExprOrNewLine' :: EgisonOpts -> String -> InputT RuntimeM (Either Bool (String, TopExpr))
173182
getEgisonExprOrNewLine' opts prev = do
174183
mLine <- case prev of
175184
"" -> getInputLine $ optPrompt opts
@@ -179,7 +188,7 @@ getEgisonExprOrNewLine' opts prev = do
179188
Just [] -> return $ Left True -- The user's input is 'Enter'.
180189
Just line -> do
181190
let input = prev ++ line
182-
let parsedExpr = Parser.parseTopExpr input
191+
parsedExpr <- lift $ Parser.parseTopExpr input
183192
case parsedExpr of
184193
Left err | show err =~ "unexpected end of input" ->
185194
getEgisonExprOrNewLine' opts $ input ++ "\n"
@@ -188,9 +197,9 @@ getEgisonExprOrNewLine' opts prev = do
188197
getEgisonExprOrNewLine opts
189198
Right topExpr -> return $ Right (input, topExpr)
190199

191-
replSettings :: MonadIO m => FilePath -> Settings m
192-
replSettings home = Settings
193-
{ complete = completeEgison
200+
replSettings :: MonadIO m => FilePath -> Env -> Settings m
201+
replSettings home env = Settings
202+
{ complete = completeEgison env
194203
, historyFile = Just (home </> ".egison_history")
195204
, autoAddHistory = True
196205
}
@@ -202,52 +211,52 @@ nonReplSettings = Settings
202211
, autoAddHistory = False
203212
}
204213

205-
repl :: Env -> String -> IO ()
206-
repl env prompt = do
207-
section <- selectSection tutorial
214+
repl :: Env -> RuntimeM ()
215+
repl env = do
216+
section <- liftIO $ selectSection tutorial
208217
case section of
209218
Section _ cs -> loop env cs True
210219
where
211-
loop :: Env -> [Content] -> Bool -> IO ()
220+
loop :: Env -> [Content] -> Bool -> RuntimeM ()
212221
loop env [] _ = do
213-
-- liftIO $ showFinishMessage
214-
liftIO $ repl env prompt
222+
repl env
215223
loop env (content:contents) b = (do
216224
if b
217225
then liftIO $ putStrLn $ show content
218226
else return ()
219-
home <- getHomeDirectory
220-
input <- liftIO $ runInputT (replSettings home) $ getEgisonExprOrNewLine defaultOptions
227+
home <- liftIO $ getHomeDirectory
228+
input <- runInputT (replSettings home env) $ getEgisonExprOrNewLine ET.defaultOption
221229
case input of
222230
-- The user input 'Control-D'.
223231
Left False -> do
224-
b <- yesOrNo "Do you want to quit?"
232+
b <- liftIO $ yesOrNo "Do you want to quit?"
225233
if b
226234
then return ()
227235
else do
228-
b <- yesOrNo "Do you want to proceed next?"
236+
b <- liftIO $ yesOrNo "Do you want to proceed next?"
229237
if b
230238
then loop env contents True
231239
else loop env (content:contents) False
232240
-- The user input just 'Enter'.
233241
Left True -> do
234-
b <- yesOrNo "Do you want to proceed next?"
242+
b <- liftIO $ yesOrNo "Do you want to proceed next?"
235243
if b
236244
then loop env contents True
237245
else loop env (content:contents) False
238246
Right (topExpr, _) -> do
239-
result <- liftIO $ runEgisonTopExpr ET.defaultOption env topExpr
247+
result <- fromEvalT (runTopExpr env topExpr)
240248
case result of
241249
Left err -> do
242250
liftIO $ putStrLn $ show err
243251
loop env (content:contents) False
244-
Right env' -> 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)
245254
`catch`
246255
(\e -> case e of
247-
UserInterrupt -> putStrLn "" >> loop env (content:contents) False
248-
StackOverflow -> putStrLn "Stack over flow!" >> loop env (content:contents) False
249-
HeapOverflow -> putStrLn "Heap over flow!" >> loop env (content:contents) False
250-
_ -> putStrLn "error!" >> loop env (content:contents) False
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
251260
)
252261

253262
data Tutorial = Tutorial [Section]

‎egison-tutorial.cabal‎

Lines changed: 1 addition & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -29,6 +29,7 @@ Executable egison-tutorial
2929
, directory
3030
, filepath
3131
, regex-posix
32+
, exceptions
3233
ghc-options: -Wall -Wno-name-shadowing
3334
Other-modules: Paths_egison_tutorial
3435
autogen-modules: Paths_egison_tutorial

0 commit comments

Comments
 (0)