elm-repl 0.1.0.2 → 0.2
raw patch · 5 files changed
+221/−76 lines, 5 filesdep +cmdargsdep +parsecdep ~Elm
Dependencies added: cmdargs, parsec
Dependency ranges changed: Elm
Files
- Environment.hs +13/−9
- Evaluator.hs +47/−48
- Flags.hs +22/−0
- Repl.hs +131/−15
- elm-repl.cabal +8/−4
Environment.hs view
@@ -2,19 +2,21 @@ module Environment where import qualified Data.ByteString.Char8 as BS-import Data.Char-import Data.List+import Data.Char (isUpper,isSymbol,isAlpha,isDigit)+import qualified Data.List as List import qualified Data.Map as Map data Repl = Repl- { imports :: Map.Map String String+ { compilerPath :: FilePath+ , flags :: [String]+ , imports :: Map.Map String String , adts :: Map.Map String String , defs :: Map.Map String String- , ctrlc :: Bool } deriving Show -empty :: Repl-empty = Repl Map.empty Map.empty (Map.singleton "t_s_o_l_" "t_s_o_l_ = ()") False+empty :: FilePath -> Repl+empty compilerPath =+ Repl compilerPath [] Map.empty Map.empty (Map.singleton "t_s_o_l_" "t_s_o_l_ = ()") output :: BS.ByteString output = "deltron3030"@@ -25,14 +27,14 @@ insert :: String -> Repl -> Repl insert str env- | "import " `isPrefixOf` str = + | List.isPrefixOf "import " str = let name = getFirstCap (words str) getFirstCap (token@(c:_):rest) = if isUpper c then token else getFirstCap rest getFirstCap _ = str in noDisplay $ env { imports = Map.insert name str (imports env) } - | "data " `isPrefixOf` str =+ | List.isPrefixOf "data " str = let name = takeWhile (/=' ') (drop 5 str) in noDisplay $ env { adts = Map.insert name str (adts env) } @@ -40,7 +42,7 @@ case break (=='=') str of (_,"") -> display str env (beforeEquals, _:c:_)- | isSymbol c || hasLet beforeEquals -> display str env+ | isSymbol c || hasLet beforeEquals || hasBrace beforeEquals -> display str env | otherwise -> let name = declName beforeEquals in define name str (display name env) _ -> error "Environment.hs: Case error. Submit bug report."@@ -54,6 +56,8 @@ where isVarChar c = isAlpha c || isDigit c || elem c "_'" token = takeWhile isVarChar . dropWhile (not . isAlpha)++ hasBrace = elem '{' define :: String -> String -> Repl -> Repl define name body env = env { defs = Map.insert name body (defs env) }
Evaluator.hs view
@@ -1,27 +1,30 @@ {-# LANGUAGE OverloadedStrings #-} module Evaluator where +import qualified Data.Char as Char import qualified Data.ByteString.Char8 as BSC-import qualified Data.ByteString as BS-import qualified Language.Elm as Elm-import qualified Environment as Env+import qualified Data.ByteString as BS+import qualified Elm.Internal.Paths as Elm+import qualified Environment as Env+import qualified Data.Map as Map +import Control.Applicative ((<$>), (<*>))+import Control.Exception+import Control.Monad (unless)+import System.Directory (removeFile)+import System.Exit (ExitCode(..))+import System.FilePath ((</>), replaceExtension) import System.IO-import System.IO.Error (isDoesNotExistError)-import System.Directory (removeFile)-import System.Exit (ExitCode(..))-import System.FilePath ((</>), replaceExtension)+import System.IO.Error (isDoesNotExistError) import System.Process-import Control.Exception-import Control.Monad (unless) runRepl :: String -> Env.Repl -> IO Env.Repl runRepl "" env = return env runRepl input oldEnv = do writeFile tempElm $ Env.toElm newEnv- success <- run "elm" elmArgs $ \types -> do+ success <- runCmdWithCallback (Env.compilerPath newEnv) elmArgs $ \types -> do reformatJS input tempJS- run "node" nodeArgs $ \value' ->+ runCmdWithCallback "node" nodeArgs $ \value' -> let value = BSC.init value' tipe = scrapeOutputType types isTooLong = BSC.isInfixOf "\n" value ||@@ -39,38 +42,37 @@ tempJS = "build" </> replaceExtension tempElm "js" nodeArgs = [tempJS]- elmArgs = ["--make", "--only-js", "--print-types", tempElm]-- run name args nextComputation =- 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 _) ->- nextComputation =<< 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 >> return False- 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?" ]+ elmArgs = Env.flags newEnv ++ ["--make", "--only-js", "--print-types", tempElm] +runCmdWithCallback :: FilePath -> [String] -> (BS.ByteString -> IO Bool) -> IO Bool+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 >> return False+ 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?" ] reformatJS :: String -> String -> IO () reformatJS input tempJS =- do rts <- BS.readFile =<< Elm.runtime+ do rts <- BS.readFile Elm.runtime src <- BS.readFile tempJS BS.length src `seq` BS.writeFile tempJS (BS.concat [rts,src,out]) where out = BS.concat [ "process.on('uncaughtException', function(err) {\n"- , " process.stderr.write(err);\n"+ , " process.stderr.write(err.toString());\n" , " process.exit(1);\n" , "});\n" , "var document = document || {};"@@ -81,21 +83,18 @@ , " console.log(context.Native.Show.values.show(repl.", Env.output, "));" ] scrapeOutputType :: BS.ByteString -> BS.ByteString-scrapeOutputType types- | name == Env.output = tipe- | BS.null rest = ""- | otherwise = scrapeOutputType rest- where- (next,rest) = freshLine types- (name,tipe) = BSC.splitAt (BSC.length Env.output) next+scrapeOutputType = dropName . squashSpace . takeType . dropWhile (not . isOut) . BSC.lines+ where isOut = BS.isPrefixOf Env.output+ dropName = BS.drop $ BSC.length Env.output+ takeType (n:rest) = n : takeWhile isMoreType rest+ isMoreType = (&&) <$> not . BS.null <*> (Char.isSpace . BSC.head)+ squashSpace = BSC.unwords . BSC.words . BSC.unwords - freshLine str- | BSC.take 2 rest' == "\n " = (BS.append line line', rest'')- | BS.null rest' = (line,"")- | otherwise = (line, BS.tail rest')- where- (line,rest') = BSC.break (=='\n') str- (line',rest'') = freshLine rest'+freshLine :: BS.ByteString -> (BS.ByteString, BS.ByteString)+freshLine str | BS.null rest' = (line,"")+ | otherwise = (line, BS.tail rest')+ where+ (line,rest') = BSC.break (=='\n') str removeIfExists :: FilePath -> IO () removeIfExists fileName = removeFile fileName `Control.Exception.catch` handleExists
+ Flags.hs view
@@ -0,0 +1,22 @@+{-# LANGUAGE DeriveDataTypeable #-}+module Flags where++import System.Console.CmdArgs+import Data.Version (showVersion)+import qualified Paths_elm_repl as This++version = showVersion This.version++data Flags = Flags+ { compiler :: FilePath+ }+ deriving (Data,Typeable,Show,Eq)+ +flags = Flags+ { compiler = "elm" &= typFile+ &= help "Provide a path to a specific Elm compiler."+ } &= help "Read-eval-print-loop (REPL) for digging deep into Elm projects.\n\+ \More info at <https://github.com/evancz/elm-repl#elm-repl>"+ &= helpArg [explicit, name "help", name "h"]+ &= versionArg [explicit, name "version", name "v", summary version]+ &= summary ("Elm REPL " ++ version ++ ", (c) Evan Czaplicki 2011-2013")
Repl.hs view
@@ -1,35 +1,68 @@-{-# LANGUAGE OverloadedStrings #-} module Main where import Control.Monad import Control.Monad.Trans+import qualified Data.Map as Map+import qualified Data.List as List import System.Console.Haskeline-import qualified Evaluator as Eval-import qualified Environment as Env+import qualified System.Console.CmdArgs as CmdArgs import System.Directory+import System.Environment import System.Exit+import System.FilePath ((</>))+import Text.Parsec hiding (getInput) +import qualified Evaluator as Eval+import qualified Environment as Env+import qualified Flags++data Command+ = AddFlag String+ | RemoveFlag String+ | ListFlags+ | ClearFlags+ | InfoFlags+ | Help+ | Exit+ | Reset+ deriving Show++welcomeMessage :: String+welcomeMessage =+ "Elm REPL " ++ Flags.version +++ " <https://github.com/evancz/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 :: (MonadIO m) => IO (Settings m)+mkSettings = do+ historyFile <- (</> "history") `fmap` elmdir+ return $ defaultSettings { historyFile = Just historyFile }+ main :: IO () main = do+ flags <- CmdArgs.cmdArgs Flags.flags buildExisted <- doesDirectoryExist "build" cacheExisted <- doesDirectoryExist "cache"- exitCode <- runInputT defaultSettings $ withInterrupt $ loop Env.empty+ settings <- mkSettings+ putStrLn welcomeMessage+ exitCode <- runInputT settings $ withInterrupt $ loop (Env.empty (Flags.compiler flags)) when (not buildExisted) (removeDirectoryRecursive "build") when (not cacheExisted) (removeDirectoryRecursive "cache") exitWith exitCode loop :: Env.Repl -> InputT IO ExitCode-loop environment@(Env.Repl _ _ _ wasCtrlC) = do- str' <- handleInterrupt (return Nothing) getInput+loop environment = do+ str' <- handleInterrupt (return . Just $ "") getInput case str' of- Just input ->- loop =<< liftIO (Eval.runRepl input $ environment {Env.ctrlc = False})-- Nothing- | wasCtrlC -> return (ExitFailure 130)- | otherwise -> do - lift $ putStrLn "(Ctrl-C again to exit)"- loop $ environment {Env.ctrlc = True}+ Just (':':command) -> runCommand environment command+ Just input -> loop =<< liftIO (Eval.runRepl input environment)+ Nothing -> return ExitSuccess getInput :: InputT IO (Maybe String) getInput = get "> " ""@@ -37,9 +70,92 @@ get str old = do input <- getInputLine str case input of- Nothing -> return $ Just old+ Nothing -> return Nothing Just new -> continueWith (old ++ new) continueWith str | null str || last str /= '\\' = return $ Just str | otherwise = get "| " (init str ++ "\n")+ +runCommand :: Env.Repl -> String -> InputT IO ExitCode+runCommand env raw = + case parse commands "" raw of+ Right command -> handleCommand env command+ Left err -> do+ liftIO . putStrLn $ "Could not parse command '" ++ raw ++ "':\n" ++ show err+ loop env++handleCommand :: Env.Repl -> Command -> InputT IO ExitCode+handleCommand env command =+ let loop' (msg,env') = liftIO (putStrLn msg) >> loop env' in+ case command of+ Exit -> liftIO exitSuccess++ Reset -> loop' ("Environment Reset", Env.empty (Env.compilerPath env))++ Help -> loop' (helpInfo, env)++ AddFlag flag ->+ if flag `elem` Env.flags env+ then loop' ( "Flag already added!", env )+ else loop' ( "Added " ++ flag+ , env { Env.flags = Env.flags env ++ [flag] } )++ RemoveFlag flag ->+ if flag `notElem` Env.flags env+ then loop' ( "No such flag.", env )+ else loop' ( "Removed flag " ++ flag+ , env {Env.flags = List.delete flag $ Env.flags env} )++ ListFlags -> loop' (List.intercalate "\n" $ Env.flags env, env)++ ClearFlags -> loop' ("All flags cleared", env {Env.flags = []})++ InfoFlags -> loop' (flagsInfo, env)++commands :: Parsec String () Command+commands = choice (flags : basics)+ where+ basics = map basicCommand [ ("exit",Exit), ("reset",Reset), ("help",Help) ]++ basicCommand (name,command) =+ string name >> spaces >> eof >> return command++flags :: Parsec String () Command+flags = do+ string "flags"+ many space+ choice [ do string "add" >> many1 space >> srcDir+ , do string "remove" >> many1 space+ n <- many1 digit+ return $ RemoveFlag (read n)+ , do string "list"+ return ListFlags+ , do string "clear"+ return ClearFlags+ , return InfoFlags+ ]++srcDir :: Parsec String () Command+srcDir = do+ string "--src-dir="+ dir <- manyTill anyChar (choice [ space >> return (), eof ])+ return $ AddFlag $ "--src-dir=" ++ dir++flagsInfo :: String+flagsInfo = "Usage: flags [operation]\n\+ \\n\+ \ operations:\n\+ \ add --src-dir=FILEPATH\tAdd a compiler flag\n\+ \ remove --src-dir=FILEPATH\tRemove a compiler flag\n\+ \ list\t\t\tList all flags that have been added\n\+ \ clear\t\t\tClears all flags\n" ++helpInfo :: String+helpInfo = "General usage directions: <https://github.com/evancz/elm-repl#elm-repl>\n\+ \Additional commands available from the prompt:\n\+ \\n\+ \ :help\t\t\tList available commands\n\+ \ :flags\t\tManipulate flags sent to elm compiler\n\+ \ :reset\t\tClears all previous imports\n\+ \ :exit\t\t\tExits elm-repl\n"
elm-repl.cabal view
@@ -1,5 +1,5 @@ Name: elm-repl-Version: 0.1.0.2+Version: 0.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@@ -28,15 +28,19 @@ Executable elm-repl Main-is: Repl.hs other-modules: Environment,- Evaluator+ Evaluator,+ Flags Build-depends: base >=4.2 && <5, bytestring,+ cmdargs, containers >= 0.3, directory,- Elm >= 0.10.0.2,+ Elm >= 0.10.1, filepath, haskeline, transformers >= 0.2, mtl >= 2,- process+ process,+ parsec >= 3.0,+ filepath