elm-repl 0.2.1 → 0.2.2
raw patch · 5 files changed
+132/−131 lines, 5 files
Files
- elm-repl.cabal +3/−3
- src/Command.hs +46/−26
- src/Evaluator.hs +16/−18
- src/Main.hs +67/−0
- src/Repl.hs +0/−84
elm-repl.cabal view
@@ -1,12 +1,12 @@ Name: elm-repl-Version: 0.2.1+Version: 0.2.2 Synopsis: a REPL for Elm Description: A read-eval-print-loop (REPL) for evaluating Elm expressions, definitions, ADTs, and module imports. This tool is meant to help you play with small expressions and interact with functions deep inside of larger projects. -Homepage: https://github.com/elm-lang/elm-repl#elm-repl+Homepage: https://github.com/elm-lang/elm-repl License: BSD3 License-file: LICENSE@@ -28,7 +28,7 @@ Executable elm-repl ghc-options: -W Hs-Source-Dirs: src- Main-is: Repl.hs+ Main-is: Main.hs other-modules: Action, Command, Completion,
src/Command.hs view
@@ -1,9 +1,8 @@ module Command where -import Data.Functor ((<$>), (<$)) import Control.Monad.Trans (liftIO) import Control.Monad.State (get, modify)-import System.Exit (ExitCode, exitSuccess)+import System.Exit (ExitCode(ExitSuccess)) import qualified Data.List as List @@ -14,35 +13,56 @@ run :: Command -> ReplM (Maybe ExitCode) run cmd = case cmd of- Exit -> Just <$> liftIO exitSuccess- Help m -> displayErr "Bad command\n" m >> display helpInfo- InfoFlags m -> displayErr "Bad flag\n" m >> display flagsInfo- ListFlags -> display . unlines . Env.flags =<< get+ Exit -> return (Just ExitSuccess) - AddFlag flag -> modifyIfPresent True flag "Added " "Flag already added!" $ \env ->- env { Env.flags = Env.flags env ++ [flag] }+ Help m ->+ do displayErr "Bad command\n" m+ display helpInfo - RemoveFlag flag -> modifyIfPresent False flag "Removed flag " "No such flag." $ \env ->- env {Env.flags = List.delete flag $ Env.flags env}+ InfoFlags m ->+ do displayErr "Bad flag\n" m+ display flagsInfo - Reset -> modifyAlways "Environment Reset" (Env.empty . Env.compilerPath)- ClearFlags -> modifyAlways "All flags cleared" $ \env ->- env {Env.flags = []}+ ListFlags ->+ display . unlines . Env.flags =<< get - where display msg = Nothing <$ (liftIO . putStrLn $ msg)- displayErr msg m = case m of+ AddFlag flag ->+ modifyIfPresent True flag "Added " "Flag already added!" $ \env ->+ env { Env.flags = Env.flags env ++ [flag] }++ RemoveFlag flag ->+ modifyIfPresent False flag "Removed flag " "No such flag." $ \env ->+ env {Env.flags = List.delete flag $ Env.flags env}++ Reset ->+ modifyAlways "Environment Reset" (Env.empty . Env.compilerPath)++ ClearFlags ->+ modifyAlways "All flags cleared" $ \env ->+ env {Env.flags = []}++ where+ display msg =+ do liftIO . putStrLn $ msg+ return Nothing++ displayErr msg m =+ case m of Nothing -> return ()- Just err -> liftIO . putStrLn $ (msg ++ err)- modifyIfPresent b flag msgSuc msgFail mod = do- env <- get- if not b `xor` (flag `elem` Env.flags env)- then display msgFail- else Nothing <$ do- liftIO . putStrLn $ msgSuc ++ flag- modify mod- modifyAlways msg mod = Nothing <$ do- liftIO . putStrLn $ msg- modify mod+ Just err -> liftIO . putStrLn $ msg ++ err++ modifyIfPresent b flag msgSuc msgFail mod =+ do env <- get+ if not b `xor` (flag `elem` Env.flags env)+ then display msgFail+ else do liftIO . putStrLn $ msgSuc ++ flag+ modify mod+ return Nothing++ modifyAlways msg mod =+ do liftIO . putStrLn $ msg+ modify mod+ return Nothing xor :: Bool -> Bool -> Bool xor True = not
src/Evaluator.hs view
@@ -46,24 +46,22 @@ nodeArgs = [tempJS] runCmdWithCallback :: FilePath -> [String] -> (BS.ByteString -> IO ()) -> IO ()-runCmdWithCallback name args callback = do- (_, stdout, stderr, handle') <- createProcess (proc name args) { std_out = CreatePipe- , std_err = CreatePipe}- exitCode <- waitForProcess handle'- case (exitCode, stdout, stderr) of- (ExitSuccess, Just out, Just _) ->- callback =<< BS.hGetContents out- (ExitFailure 127, Just _, Just _) -> failure missingExe- (ExitFailure _, Just out, Just err) -> do- e <- BSC.hGetContents err- o <- BSC.hGetContents out- failure (BS.concat [o,e])- (_, _, _) -> failure "Unknown error!"- where failure message = BSC.hPutStrLn stderr message- missingExe = BSC.pack $ unlines $- [ "Error: '" ++ name ++ "' command not found."- , " Do you have it installed?"- , " Can it be run from anywhere? I.e. is it on your PATH?" ]+runCmdWithCallback name args callback =+ do (exitCode, stdout, stderr) <- readProcessWithExitCode name args ""+ case exitCode of+ ExitSuccess -> callback (BSC.pack stdout)+ ExitFailure code+ | code == 127 -> failure missingExe -- UNIX+ | code == 9009 -> failure missingExe -- Windows+ | otherwise -> failure (stdout ++ stderr)+ where+ failure message = hPutStrLn stderr message++ missingExe =+ unlines $+ [ "Error: '" ++ name ++ "' command not found."+ , " Do you have it installed?"+ , " Can it be run from anywhere? I.e. is it on your PATH?" ] reformatJS :: String -> IO () reformatJS tempJS =
+ src/Main.hs view
@@ -0,0 +1,67 @@+module Main where++import Control.Monad+import System.Console.Haskeline hiding (handle)+import System.Directory+import qualified System.Exit as Exit+import System.FilePath ((</>))++import qualified System.Console.CmdArgs as CmdArgs++import Monad++import qualified Repl+import qualified Completion+import qualified Flags++main :: IO ()+main = do+ flags <- CmdArgs.cmdArgs Flags.flags+ buildExisted <- doesDirectoryExist "build"+ cacheExisted <- doesDirectoryExist "cache"+ settings <- mkSettings+ putStrLn welcomeMessage+ exitCode <- ifNodeIsInstalled (Repl.run flags settings)+ unless buildExisted (removeDirectoryRecursiveIfExists "build")+ unless cacheExisted (removeDirectoryRecursiveIfExists "cache")+ Exit.exitWith exitCode++welcomeMessage :: String+welcomeMessage =+ "Elm REPL " ++ Flags.version +++ " <https://github.com/elm-lang/elm-repl#elm-repl>\n\+ \Type :help for help, :exit to exit"++elmdir :: IO FilePath+elmdir = do+ dir <- (</> "repl") `fmap` getAppUserDataDirectory "elm"+ createDirectoryIfMissing True dir+ return dir++mkSettings :: IO (Settings ReplM)+mkSettings = do+ historyFile <- (</> "history") `fmap` elmdir+ return $ Settings { historyFile = Just historyFile+ , autoAddHistory = True+ , complete = Completion.complete+ }++ifNodeIsInstalled :: IO Exit.ExitCode -> IO Exit.ExitCode+ifNodeIsInstalled doSomeStuff =+ do maybePath <- findExecutable "node"+ case maybePath of+ Just _ -> doSomeStuff+ Nothing ->+ do putStrLn nodeNotInstalledMessage+ return (Exit.ExitFailure 1)+ where+ nodeNotInstalledMessage =+ "\n\+ \The REPL relies on node.js to execute JavaScript code outside the browser.\n\+ \ It appears that you do not have node.js installed though!\n\+ \ Install node.js from <http://nodejs.org/> to use elm-repl."+ +removeDirectoryRecursiveIfExists :: FilePath -> IO ()+removeDirectoryRecursiveIfExists path =+ do exists <- doesDirectoryExist path+ when exists (removeDirectoryRecursive path)
− src/Repl.hs
@@ -1,84 +0,0 @@-module Main where--import Control.Monad-import Control.Monad.Trans-import Data.Functor ((<$))-import System.Console.Haskeline hiding (handle)-import System.Directory-import System.Exit-import System.FilePath ((</>))--import qualified System.Console.CmdArgs as CmdArgs--import Monad--import qualified Action as Act-import qualified Command as Cmd-import qualified Completion-import qualified Evaluator as Eval-import qualified Environment as Env-import qualified Flags-import qualified Parse--main :: IO ()-main = do- flags <- CmdArgs.cmdArgs Flags.flags- buildExisted <- doesDirectoryExist "build"- cacheExisted <- doesDirectoryExist "cache"- settings <- mkSettings- putStrLn welcomeMessage- let mt = Env.empty (Flags.compiler flags)- exitCode <- runReplM flags mt . runInputT settings . withInterrupt $ repl- unless buildExisted (removeDirectoryRecursive "build")- unless cacheExisted (removeDirectoryRecursive "cache")- exitWith exitCode--repl :: InputT ReplM ExitCode-repl = do- str' <- handleInterrupt (return . Just $ "") getInput- case str' of- Nothing -> return ExitSuccess- Just str -> do- let act = Parse.input str- m <- lift $ handle act- case m of- Just exit -> return exit- Nothing -> repl--handle :: Act.Action -> ReplM (Maybe ExitCode)-handle (Act.Command cmd) = Cmd.run cmd-handle (Act.Code src) = Nothing <$ Eval.evalPrint src-handle (Act.Skip) = return Nothing--getInput :: (MonadException m) => InputT m (Maybe String)-getInput = go "> " ""- where- go str old = do- input <- getInputLine str- case input of- Nothing -> return Nothing- Just new -> continueWith (old ++ new)-- continueWith str- | null str || last str /= '\\' = return $ Just str- | otherwise = go "| " (init str ++ "\n")--welcomeMessage :: String-welcomeMessage =- "Elm REPL " ++ Flags.version ++- " <https://github.com/elm-lang/elm-repl#elm-repl>\n\- \Type :help for help, :exit to exit"--elmdir :: IO FilePath-elmdir = do- dir <- (</> "repl") `fmap` getAppUserDataDirectory "elm"- createDirectoryIfMissing True dir- return dir--mkSettings :: IO (Settings ReplM)-mkSettings = do- historyFile <- (</> "history") `fmap` elmdir- return $ Settings { historyFile = Just historyFile- , autoAddHistory = True- , complete = Completion.complete- }