@@ -13,7 +13,7 @@
1313--
1414-----------------------------------------------------------------------------
1515
16−{-# LANGUAGE FlexibleContexts #-}
16+{-# LANGUAGE DoAndIfThenElse, FlexibleContexts #-}
1717
1818module Main where
1919
@@ -25,22 +25,22 @@ import Control.Monad.Trans.Class
2525import Control.Monad.Trans.Maybe (MaybeT(..), runMaybeT)
2626import Control.Monad.Trans.State
2727
28−import Data.List (intercalate, isPrefixOf, nub, sort)
28+import Data.List (intercalate, isPrefixOf, nub, sortBy)
2929import Data.Maybe (mapMaybe)
3030import Data.Traversable (traverse)
3131
32−
3332import System.Console.Haskeline
34−import System.Directory (findExecutable)
33+import System.Directory (doesFileExist, findExecutable, getHomeDirectory)
3534import System.Exit
3635import System.Environment.XDG.BaseDir
36+import System.FilePath ((</>), isPathSeparator)
3737import System.Process
3838
39+import qualified Data.Map as M
3940import qualified Language.PureScript as P
4041import qualified Paths_purescript as Paths
4142import qualified System.IO.UTF8 as U (readFile)
4243import qualified Text.Parsec as Parsec (Parsec, eof, try)
43−import qualified Data.Map as M
4444
4545-- |
4646-- The PSCI state.
@@ -97,7 +97,7 @@ defaultImports = [P.ProperName "Prelude"]
9797--
9898findNodeProcess :: IO (Maybe String)
9999findNodeProcess = runMaybeT . msum $ map (MaybeT . findExecutable) names
100− where names = ["nodejs", "node"]
100+ where names = ["nodejs", "node"]
101101
102102-- |
103103-- Grabs the filename where the history is stored.
@@ -115,10 +115,14 @@ getPreludeFilename = Paths.getDataFileName "prelude/prelude.purs"
115115-- Loads a file for use with imports.
116116--
117117loadModule :: 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
121119
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
122126-- Messages
123127
124128-- |
@@ -162,17 +166,20 @@ completion ms = completeWord Nothing " \t\n\r" findCompletions
162166 findCompletions :: String -> IO [Completion]
163167 findCompletions str = do
164168 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
172− return $ map simpleCompletion matches ++ files
169+ let matches = filter (isPrefixOf str) names
170+ return $ sortBy sorter $ map simpleCompletion matches ++ files
173171 getDeclName :: P.Declaration -> Maybe P.Ident
174172 getDeclName (P.ValueDeclaration ident _ _ _) = Just ident
175173 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
176183
177184-- Compilation
178185
@@ -221,7 +228,7 @@ handleTypeOf value (PSCI imports loadedModules lets) = do
221228 let m = createTemporaryModule False imports lets value
222229 case P.compile options { P.optionsMain = Nothing } (loadedModules ++ [m]) of
223230 Left err -> outputStrLn err
224− Right (_, _, env') -> do
231+ Right (_, _, env') ->
225232 case M.lookup (P.ModuleName [P.ProperName "Main"], P.Ident "it") (P.names env') of
226233 Just (ty, _) -> outputStrLn . P.prettyPrintType $ ty
227234 Nothing -> outputStrLn "Could not find type"
@@ -255,21 +262,37 @@ handleCommand (Expression ls) =
255262 Left err -> inputTToState $ outputStrLn (show err)
256263 Right (Left l) -> modify (updateLets l)
257264 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'
262265handleCommand Help = inputTToState $ outputStrLn helpMessage
263266handleCommand (Import moduleName) = modify (updateImports moduleName)
264267handleCommand (LoadFile filePath) = do
265− mf <- ioToState $ loadModule filePath
266− case mf of
267− Left err -> inputTToState $ outputStrLn err
268− Right mf' -> modify (updateModules mf')
268+ absPath <- ioToState $ expandTilde filePath
269+ exists <- ioToState $ doesFileExist absPath
270+ if exists then
271+ either outputTStrLn (modify . updateModules) =<< ioToState (loadModule absPath)
272+ else
273+ outputTStrLn $ "Couldn't locate: " ++ filePath
269274handleCommand Reload = do
270− (Right prelude) <- ioToState $ getPreludeFilename >>= loadModule
275+ (Right prelude) <- ioToState $ loadModule =<< getPreludeFilename
271276 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
273296
274297-- |
275298-- The PSCI main loop.
@@ -288,5 +311,5 @@ main = do
288311 go = do
289312 c <- inputTToState getCommand
290313 case c of
291− Quit -> inputTToState $ outputStrLn quitMessage
314+ Quit -> outputTStrLn quitMessage
292315 _ -> handleCommand c >> go