fc75da0 · rowtype-yoga/purescript-native

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

on golang help sign in

Cleanup.

fc75da0joneshf13 years ago

psci/Main.hs+51−24

compare with golang

unifiedsplit

@@ -13,7 +13,7 @@

13--

14-----------------------------------------------------------------------------

16−{-# LANGUAGE FlexibleContexts #-}

16+{-# LANGUAGE DoAndIfThenElse, FlexibleContexts #-}

18module Main where

@@ -30,7 +30,7 @@ import Data.Maybe (mapMaybe)

30import Data.Traversable (traverse)

32import System.Console.Haskeline

33−import System.Directory (findExecutable)

33+import System.Directory (doesFileExist, findExecutable)

34import System.Exit

35import System.Environment.XDG.BaseDir

36import System.Process

@@ -38,7 +38,7 @@ import System.Process

38import qualified Language.PureScript as P

39import qualified Paths_purescript as Paths

40import qualified System.IO.UTF8 as U (readFile)

41−import qualified Text.Parsec as Parsec (Parsec, eof)

41+import qualified Text.Parsec as Parsec (Parsec, ParseError, eof)

43-- |

44-- The PSCI state.

@@ -113,9 +113,7 @@ getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"

113-- Loads a file for use with imports.

114--

115loadModule :: FilePath -> IO (Either String [P.Module])

116−loadModule moduleFile = do

117− moduleText <- U.readFile moduleFile

118− return . either (Left . show) Right $ P.runIndentParser "" P.parseModules moduleText

116+loadModule = fmap (either (Left . show) Right . parseModules) . U.readFile

119

117

120-- Messages

118-- Messages

121

119

@@ -212,46 +210,75 @@ handleDeclaration value (PSCI imports loadedModules lets) = do

212

210

213-- Parser helpers

211-- Parser helpers

214

212

213+-- |

214+-- PSCI version of the indent parser.

215+-- This really does nothing except provide a shorter alias.

216+--

217+parser :: Parsec.Parsec String P.ParseState a -> String -> Either Parsec.ParseError a

218+parser = P.runIndentParser ""

219+

220+-- |

221+-- Parser for any other valid expression.

222+--

223+parseExpression :: String -> Either Parsec.ParseError P.Value

224+parseExpression = parser (P.whiteSpace *> P.parseValue <* Parsec.eof)

225+

215-- |

226-- |

216-- Parser for our PSCI version of @let@.

227-- Parser for our PSCI version of @let@.

217-- This is essentially let from do-notation.

228-- This is essentially let from do-notation.

218-- However, since we don't support the @Eff@ monad, we actually want the normal @let@.

229-- However, since we don't support the @Eff@ monad, we actually want the normal @let@.

219--

230--

220−parseLet :: Parsec.Parsec String P.ParseState (P.Value -> P.Value)

231+parseLet :: String -> Either Parsec.ParseError (P.Value -> P.Value)

232+parseLet = parser $

221−parseLet = P.Let <$> (P.reserved "let" *> P.indented *> P.parseBinder)

233+ P.Let <$> (P.reserved "let" *> P.indented *> P.parseBinder)

222− <*> (P.indented *> P.reservedOp "=" *> P.parseValue)

234+ <*> (P.indented *> P.reservedOp "=" *> P.parseValue)

223

235

224-- |

236-- |

225−-- Parser for any other valid expression.

237+-- Parser for PSCI modules.

226--

238--

227−parseExpression :: Parsec.Parsec String P.ParseState P.Value

239+parseModules :: String -> Either Parsec.ParseError [P.Module]

228−parseExpression = P.whiteSpace *> P.parseValue <* Parsec.eof

240+parseModules = parser P.parseModules

229

241

230-- Commands

242-- Commands

231

243

232-- |

244-- |

233−-- Performs an action for each meta-command given, and also for expressions..

245+-- Performs an action for each meta-command given, and also for expressions.

234--

246--

235handleCommand :: Command -> StateT PSCI (InputT IO) ()

247handleCommand :: Command -> StateT PSCI (InputT IO) ()

236handleCommand Empty = return ()

248handleCommand Empty = return ()

237handleCommand (Expression ls) =

249handleCommand (Expression ls) =

250+ let expr = unlines ls

238− case P.runIndentParser "" parseLet (unlines ls) of

251+ in case parseLet expr of

239 Left _ ->

252 Left _ ->

240− case P.runIndentParser "" parseExpression (unlines ls) of

241− Left err -> inputTToState $ outputStrLn (show err)

242− Right decl -> get >>= inputTToState . handleDeclaration decl

253+ either outprintT (\decl -> get >>= inputTToState . handleDeclaration decl)

254+ (parseExpression expr)

243 Right l -> modify (updateLets l)

255 Right l -> modify (updateLets l)

244−handleCommand Help = inputTToState $ outputStrLn helpMessage

256+handleCommand Help = outputTStrLn helpMessage

245handleCommand (Import moduleName) = modify (updateImports moduleName)

257handleCommand (Import moduleName) = modify (updateImports moduleName)

246handleCommand (LoadFile filePath) = do

258handleCommand (LoadFile filePath) = do

247− mf <- ioToState $ loadModule filePath

259+ exists <- ioToState $ doesFileExist filePath

248− case mf of

260+ if exists then

249− Left err -> inputTToState $ outputStrLn err

250− Right mf' -> modify (updateModules mf')

261+ ioToState (loadModule filePath) >>= either outputTStrLn (modify . updateModules)

262+ else

263+ outputTStrLn $ "Couldn't locate: " ++ filePath

251handleCommand Reload = do

264handleCommand Reload = do

252 (Right prelude) <- ioToState $ getPreludeFilename >>= loadModule

265 (Right prelude) <- ioToState $ getPreludeFilename >>= loadModule

253 put (PSCI defaultImports prelude [])

266 put (PSCI defaultImports prelude [])

267+handleCommand Unknown = outputTStrLn "Unknown command"

268+

269+-- Command helpers

270+

271+-- |

272+-- Lifts the output call to the StateT.

273+--

274+outputTStrLn :: String -> StateT PSCI (InputT IO) ()

254−handleCommand Unknown = inputTToState $ outputStrLn "Unknown command"

275+outputTStrLn = inputTToState . outputStrLn

276+

277+-- |

278+-- The corresponding @print@ version for the StateT.

279+--

280+outprintT :: Show a => a -> StateT PSCI (InputT IO) ()

281+outprintT = outputTStrLn . show

255

282

256-- |

283-- |

257-- The PSCI main loop.

284-- The PSCI main loop.

@@ -270,5 +297,5 @@ main = do

270 go = do

297 go = do

271 c <- inputTToState getCommand

298 c <- inputTToState getCommand

272 case c of

299 case c of

273− Quit -> inputTToState $ outputStrLn quitMessage

300+ Quit -> outputTStrLn quitMessage

274 _ -> handleCommand c >> go

301 _ -> handleCommand c >> go