2e16a83 · rowtype-yoga/purescript-native

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

on golang help sign in

Merge pull request #214 from joneshf/psci-fixes

2e16a83Phil Freeman13 years ago

psci/Main.hs+52−29

compare with golang

unifiedsplit

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

13--

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

16−{-# LANGUAGE FlexibleContexts #-}

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

18module Main where

@@ -25,22 +25,22 @@ import Control.Monad.Trans.Class

25import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)

26import Control.Monad.Trans.State

28−import Data.List (intercalate, isPrefixOf, nub, sort)

28+import Data.List (intercalate, isPrefixOf, nub, sortBy)

29import Data.Maybe (mapMaybe)

30import Data.Traversable (traverse)

32−

33import System.Console.Haskeline

32import System.Console.Haskeline

34−import System.Directory (findExecutable)

33+import System.Directory (doesFileExist, findExecutable, getHomeDirectory)

35import System.Exit

34import System.Exit

36import System.Environment.XDG.BaseDir

35import System.Environment.XDG.BaseDir

36+import System.FilePath ((</>), isPathSeparator)

37import System.Process

39+import qualified Data.Map as M

39import qualified Language.PureScript as P

40import qualified Language.PureScript as P

40import qualified Paths_purescript as Paths

41import qualified Paths_purescript as Paths

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

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

42import qualified Text.Parsec as Parsec (Parsec, eof, try)

43import qualified Text.Parsec as Parsec (Parsec, eof, try)

43−import qualified Data.Map as M

45-- |

46-- The PSCI state.

@@ -97,7 +97,7 @@ defaultImports = [P.ProperName "Prelude"]

97--

98findNodeProcess :: IO (Maybe String)

99findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names

100− where names = ["nodejs", "node"]

100+ where names = ["nodejs", "node"]

101

102-- |

103-- Grabs the filename where the history is stored.

@@ -115,10 +115,14 @@ getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"

115-- Loads a file for use with imports.

116--

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

118−loadModule moduleFile = do

119− moduleText <- U.readFile moduleFile

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

118+loadModule = fmap (either (Left . show) Right . P.runIndentParser "" P.parseModules) . U.readFile

121

119

120+-- |

121+-- Expands tilde in path.

122+--

123+expandTilde :: FilePath -> IO FilePath

124+expandTilde ('~':p:rest) | isPathSeparator p = (</> rest) <$> getHomeDirectory

125+expandTilde p = return p

122-- Messages

126-- Messages

123

127

124-- |

128-- |

@@ -162,17 +166,20 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions

162 findCompletions :: String -> IO [Completion]

166 findCompletions :: String -> IO [Completion]

163 findCompletions str = do

167 findCompletions str = do

164 files <- listFiles str

168 files <- listFiles str

165− let names = nub [ show qual

166− | P.Module moduleName ds <- ms

167− , ident <- mapMaybe getDeclName ds

168− , qual <- [ P.Qualified Nothing ident

169− , P.Qualified (Just moduleName) ident]

170− ]

171− let matches = sort $ filter (isPrefixOf str) names

169+ let matches = filter (isPrefixOf str) names

172− return $ map simpleCompletion matches ++ files

170+ return $ sortBy sorter $ map simpleCompletion matches ++ files

173 getDeclName :: P.Declaration -> Maybe P.Ident

171 getDeclName :: P.Declaration -> Maybe P.Ident

174 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident

172 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident

175 getDeclName _ = Nothing

173 getDeclName _ = Nothing

174+ names :: [String]

175+ names = nub [ show qual

176+ | P.Module moduleName ds <- ms

177+ , ident <- mapMaybe getDeclName ds

178+ , qual <- [ P.Qualified Nothing ident

179+ , P.Qualified (Just moduleName) ident]

180+ ]

181+ sorter :: Completion -> Completion -> Ordering

182+ sorter (Completion _ d1 _) (Completion _ d2 _) = compare d1 d2

176

183

177-- Compilation

184-- Compilation

178

185

@@ -221,7 +228,7 @@ handleTypeOf value (PSCI imports loadedModules lets) = do

221 let m = createTemporaryModule False imports lets value

228 let m = createTemporaryModule False imports lets value

222 case P.compile options { P.optionsMain = Nothing } (loadedModules ++ [m]) of

229 case P.compile options { P.optionsMain = Nothing } (loadedModules ++ [m]) of

223 Left err -> outputStrLn err

230 Left err -> outputStrLn err

224− Right (_, _, env') -> do

231+ Right (_, _, env') ->

225 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

232 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of

226 Just (ty, _) -> outputStrLn . P.prettyPrintType $ ty

233 Just (ty, _) -> outputStrLn . P.prettyPrintType $ ty

227 Nothing -> outputStrLn "Could not find type"

234 Nothing -> outputStrLn "Could not find type"

@@ -255,21 +262,37 @@ handleCommand (Expression ls) =

255 Left err -> inputTToState $ outputStrLn (show err)

262 Left err -> inputTToState $ outputStrLn (show err)

256 Right (Left l) -> modify (updateLets l)

263 Right (Left l) -> modify (updateLets l)

257 Right (Right decl) -> get >>= inputTToState . handleDeclaration decl

264 Right (Right decl) -> get >>= inputTToState . handleDeclaration decl

258−handleCommand (TypeOf expr) =

259− case P.runIndentParser "" parseExpression expr of

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

261− Right expr' -> get >>= inputTToState . handleTypeOf expr'

262handleCommand Help = inputTToState $ outputStrLn helpMessage

265handleCommand Help = inputTToState $ outputStrLn helpMessage

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

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

264handleCommand (LoadFile filePath) = do

267handleCommand (LoadFile filePath) = do

265− mf <- ioToState $ loadModule filePath

268+ absPath <- ioToState $ expandTilde filePath

266− case mf of

269+ exists <- ioToState $ doesFileExist absPath

267− Left err -> inputTToState $ outputStrLn err

270+ if exists then

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

271+ either outputTStrLn (modify . updateModules) =<< ioToState (loadModule absPath)

272+ else

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

269handleCommand Reload = do

274handleCommand Reload = do

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

275+ (Right prelude) <- ioToState $ loadModule =<< getPreludeFilename

271 put (PSCI defaultImports prelude [])

276 put (PSCI defaultImports prelude [])

272−handleCommand _ = inputTToState $ outputStrLn "Unknown command"

277+handleCommand (TypeOf expr) =

278+ case P.runIndentParser "" parseExpression expr of

279+ Left err -> inputTToState $ outputStrLn (show err)

280+ Right expr' -> get >>= inputTToState . handleTypeOf expr'

281+handleCommand _ = outputTStrLn "Unknown command"

282+

283+-- Command helpers

284+

285+-- |

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

287+--

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

289+outputTStrLn = inputTToState . outputStrLn

290+

291+-- |

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

293+--

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

295+outprintT = outputTStrLn . show

273

296

274-- |

297-- |

275-- The PSCI main loop.

298-- The PSCI main loop.

@@ -288,5 +311,5 @@ main = do

288 go = do

311 go = do

289 c <- inputTToState getCommand

312 c <- inputTToState getCommand

290 case c of

313 case c of

291− Quit -> inputTToState $ outputStrLn quitMessage

314+ Quit -> outputTStrLn quitMessage

292 _ -> handleCommand c >> go

315 _ -> handleCommand c >> go

purescript.cabal+1−1

@@ -84,7 +84,7 @@ executable psc

84 ghc-options: -Wall -O2 -fno-warn-unused-do-bind

86executable psci

87− build-depends: base >=4 && <5, containers -any, directory -any,

87+ build-depends: base >=4 && <5, containers -any, directory -any, filepath -any,

88 mtl -any, parsec -any, haskeline <=0.7.1.1, purescript -any,

89 syb -any, transformers -any, utf8-string -any, process -any,

90 xdg-basedir -any