c03bffa · rowtype-yoga/purescript-native

git.iko.soy/rowtype-yoga/purescript-native

on golang help sign in

Merge pull request #228 from joneshf/psci-fixes

c03bffaPhil Freeman13 years ago

psci/Main.hs+15−14

compare with golang

unifiedsplit

@@ -84,7 +84,7 @@ updateModules modules st = st { psciLoadedModules = psciLoadedModules st ++ modu

84-- Updates the state to have more let bindings.

85--

86updateLets :: (P.Value -> P.Value) -> PSCiState -> PSCiState

87−updateLets name st = st { psciLetBindings = psciLetBindings st ++ [name] }

87+updateLets name st = st { psciLetBindings = name : psciLetBindings st }

89-- File helpers

90-- |

@@ -194,30 +194,32 @@ options = P.Options True False True (Just "Main") True "PS" []

194-- |

195-- Makes a volatile module to execute the current expression.

196--

197−createTemporaryModule :: Bool -> [P.ModuleName] -> [P.Value -> P.Value] -> P.Value -> P.Module

197+createTemporaryModule :: Bool -> PSCiState -> P.Value -> P.Module

198−createTemporaryModule exec imports lets value =

198+createTemporaryModule exec PSCiState{psciImportedModuleNames = imports, psciLetBindings = lets} value =

199 let

200 moduleName = P.ModuleName [P.ProperName "Main"]

201 importDecl m = P.ImportDeclaration m Nothing

202 traceModule = P.ModuleName [P.ProperName "Debug", P.ProperName "Trace"]

203 trace = P.Var (P.Qualified (Just traceModule) (P.Ident "print"))

204− value' = foldr ($) value lets

204+ itValue = foldl (\x f -> f x) value lets

205− itDecl = P.ValueDeclaration (P.Ident "it") [] Nothing value'

206− mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing (P.App trace (P.Var (P.Qualified Nothing (P.Ident "it"))))

205+ mainValue = P.App trace (P.Var (P.Qualified Nothing (P.Ident "it")))

206+ itDecl = P.ValueDeclaration (P.Ident "it") [] Nothing itValue

207+ mainDecl = P.ValueDeclaration (P.Ident "main") [] Nothing mainValue

208+ decls = if exec then [itDecl, mainDecl] else [itDecl]

207 in

209 in

208− P.Module moduleName $ map importDecl imports ++ if exec then [itDecl, mainDecl] else [itDecl]

210+ P.Module moduleName $ map importDecl imports ++ decls

209

211

210-- |

212-- |

211-- Takes a value declaration and evaluates it with the current state.

213-- Takes a value declaration and evaluates it with the current state.

212--

214--

213handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

215handleDeclaration :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

214handleDeclaration value st = do

216handleDeclaration value st = do

215− let m = createTemporaryModule True (psciImportedModuleNames st) (psciLetBindings st) value

217+ let m = createTemporaryModule True st value

216 case P.compile options (psciLoadedModules st ++ [m]) of

218 case P.compile options (psciLoadedModules st ++ [m]) of

217 Left err -> outputStrLn err

219 Left err -> outputStrLn err

218 Right (js, _, _) -> do

220 Right (js, _, _) -> do

219 process <- lift . lift $ findNodeProcess

221 process <- lift . lift $ findNodeProcess

220− result <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process

222+ result <- lift . lift $ traverse (\node -> readProcessWithExitCode node [] js) process

221 case result of

223 case result of

222 Just (ExitSuccess, out, _) -> outputStrLn out

224 Just (ExitSuccess, out, _) -> outputStrLn out

223 Just (ExitFailure _, _, err) -> outputStrLn err

225 Just (ExitFailure _, _, err) -> outputStrLn err

@@ -228,7 +230,7 @@ handleDeclaration value st = do

228--

230--

229handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

231handleTypeOf :: P.Value -> PSCiState -> InputT (StateT PSCiState IO) ()

230handleTypeOf value st = do

232handleTypeOf value st = do

231− let m = createTemporaryModule False (psciImportedModuleNames st) (psciLetBindings st) value

233+ let m = createTemporaryModule False st value

232 case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of

234 case P.compile options { P.optionsMain = Nothing } (psciLoadedModules st ++ [m]) of

233 Left err -> outputStrLn err

235 Left err -> outputStrLn err

234 Right (_, _, env') ->

236 Right (_, _, env') ->

@@ -257,9 +259,9 @@ getCommand = do

257--

259--

258handleCommand :: Command -> InputT (StateT PSCiState IO) ()

260handleCommand :: Command -> InputT (StateT PSCiState IO) ()

259handleCommand (Expression val) = lift get >>= handleDeclaration val

261handleCommand (Expression val) = lift get >>= handleDeclaration val

260−handleCommand (Let l) = lift $ modify (updateLets l)

261handleCommand Help = outputStrLn helpMessage

262handleCommand Help = outputStrLn helpMessage

262handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)

263handleCommand (Import moduleName) = lift $ modify (updateImports moduleName)

264+handleCommand (Let l) = lift $ modify (updateLets l)

263handleCommand (LoadFile filePath) = do

265handleCommand (LoadFile filePath) = do

264 absPath <- lift . lift $ expandTilde filePath

266 absPath <- lift . lift $ expandTilde filePath

265 exists <- lift . lift $ doesFileExist absPath

267 exists <- lift . lift $ doesFileExist absPath

@@ -269,12 +271,11 @@ handleCommand (LoadFile filePath) = do

269 else

271 else

270 outputStrLn $ "Couldn't locate: " ++ filePath

272 outputStrLn $ "Couldn't locate: " ++ filePath

271handleCommand Reset = do

273handleCommand Reset = do

272− preludeFilename <- lift . lift $ getPreludeFilename

273 files <- psciImportedFilenames <$> lift get

274 files <- psciImportedFilenames <$> lift get

274− modulesOrFirstError <- fmap concat . sequence <$> mapM (lift . lift . loadModule) (preludeFilename : files)

275+ modulesOrFirstError <- fmap concat . sequence <$> mapM (lift . lift . loadModule) files

275 case modulesOrFirstError of

276 case modulesOrFirstError of

276 Left err -> lift . lift $ putStrLn err >> exitFailure

277 Left err -> lift . lift $ putStrLn err >> exitFailure

277− Right modules -> lift $ put (PSCiState (preludeFilename : files) defaultImports modules [])

278+ Right modules -> lift $ put (PSCiState files defaultImports modules [])

278handleCommand (TypeOf val) = lift get >>= handleTypeOf val

279handleCommand (TypeOf val) = lift get >>= handleTypeOf val

279handleCommand _ = outputStrLn "Unknown command"

280handleCommand _ = outputStrLn "Unknown command"

280

281