elm-repl 0.3 → 0.4
raw patch · 6 files changed
+211/−173 lines, 6 filesdep +binarydep +containersdep +elm-compilerdep −Elm
Dependencies added: binary, containers, elm-compiler, elm-package
Dependencies removed: Elm
Files
- elm-repl.cabal +88/−61
- src/Environment.hs +8/−2
- src/Eval/Code.hs +91/−98
- src/Flags.hs +10/−4
- src/Main.hs +9/−7
- src/Parse.hs +5/−1
elm-repl.cabal view
@@ -1,75 +1,102 @@-Name: elm-repl-Version: 0.3-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.+Name: elm-repl+Version: 0.4 -Homepage: https://github.com/elm-lang/elm-repl+Synopsis:+ a REPL for Elm -License: BSD3-License-file: LICENSE+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. -Author: Evan Czaplicki-Maintainer: info@elm-lang.org-Copyright: Copyright: (c) 2011-2014 Evan Czaplicki+Homepage:+ https://github.com/elm-lang/elm-repl -Category: Tool+License: BSD3+License-file: LICENSE -Build-type: Simple-Extra-source-files: changelog.txt-Cabal-version: >=1.8+Author: Evan Czaplicki+Maintainer: info@elm-lang.org+Copyright: Copyright: (c) 2011-2014 Evan Czaplicki +Category: Tool++Build-type: Simple+Extra-source-files: changelog.txt+Cabal-version: >=1.8+ source-repository head type: git location: git://github.com/elm-lang/elm-repl.git Executable elm-repl- ghc-options: -W- Hs-Source-Dirs: src- Main-is: Main.hs- other-modules: Completion,- Environment,- Eval.Code,- Eval.Command,- Eval.Input,- Eval.Meta,- Flags,- Input,- Loop,- Parse+ ghc-options:+ -W - Build-depends: base >=4.2 && <5,- bytestring >= 0.9 && < 0.11,- bytestring-trie >= 0.2.2 && < 0.3,- cmdargs >= 0.7 && < 0.11,- directory >= 1 && < 2,- Elm >= 0.13 && < 0.14,- filepath >= 1 && < 2,- haskeline >= 0.7 && < 0.8,- mtl >= 2 && < 3,- parsec >= 3.1.1 && < 3.5,- process >= 1 && < 2+ Hs-Source-Dirs:+ src + Main-is:+ Main.hs++ other-modules:+ Completion,+ Environment,+ Eval.Code,+ Eval.Command,+ Eval.Input,+ Eval.Meta,+ Flags,+ Input,+ Loop,+ Parse++ Build-depends:+ base >=4.2 && <5,+ binary,+ bytestring >= 0.9 && < 0.11,+ bytestring-trie >= 0.2.2 && < 0.3,+ cmdargs >= 0.7 && < 0.11,+ containers,+ directory >= 1 && < 2,+ elm-compiler >= 0.14 && < 0.15,+ elm-package,+ filepath >= 1 && < 2,+ haskeline >= 0.7 && < 0.8,+ mtl >= 2 && < 3,+ parsec >= 3.1.1 && < 3.5,+ process >= 1 && < 2++ Test-Suite test- Type: exitcode-stdio-1.0- ghc-options: -W- Hs-Source-Dirs: tests, src- Main-is: Main.hs- build-depends: test-framework,- test-framework-hunit,- test-framework-quickcheck2 >= 0.3,- HUnit,- QuickCheck,- base >=4.2 && <5,- bytestring >= 0.9 && < 0.11,- bytestring-trie >= 0.2.2 && < 0.3,- cmdargs >= 0.7 && < 0.11,- directory >= 1 && < 2,- Elm >= 0.13 && < 0.14,- filepath >= 1 && < 2,- haskeline >= 0.7 && < 0.8,- mtl >= 2 && < 3,- parsec >= 3.1.1 && < 3.5,- process >= 1 && < 2+ Type:+ exitcode-stdio-1.0++ ghc-options:+ -W++ Hs-Source-Dirs:+ tests, src++ Main-is:+ Main.hs++ build-depends:+ test-framework,+ test-framework-hunit,+ test-framework-quickcheck2 >= 0.3,+ HUnit,+ QuickCheck,+ base >=4.2 && <5,+ bytestring >= 0.9 && < 0.11,+ bytestring-trie >= 0.2.2 && < 0.3,+ cmdargs >= 0.7 && < 0.11,+ directory >= 1 && < 2,+ elm-compiler >= 0.14 && < 0.15,+ elm-package,+ filepath >= 1 && < 2,+ haskeline >= 0.7 && < 0.8,+ mtl >= 2 && < 3,+ parsec >= 3.1.1 && < 3.5,+ process >= 1 && < 2
src/Environment.hs view
@@ -17,7 +17,8 @@ , imports :: Trie String , adts :: Trie String , defs :: Trie String- } deriving Show+ }+ deriving Show empty :: FilePath -> FilePath -> Env@@ -38,6 +39,11 @@ lastVar = "deltron3030" +lastVarString :: String+lastVarString =+ BS.unpack lastVar++ toElmCode :: Env -> String toElmCode env = unlines $ "module Repl where" : decls@@ -76,7 +82,7 @@ define lastVar (format body) env where format body =- BS.unpack lastVar ++ " =" ++ concatMap ("\n "++) (lines body)+ lastVarString ++ " =" ++ concatMap ("\n "++) (lines body) noDisplay :: Env -> Env
src/Eval/Code.hs view
@@ -2,34 +2,42 @@ module Eval.Code (eval) where import Control.Monad.Cont (ContT(ContT, runContT))+import Control.Monad.Error (ErrorT, runErrorT, throwError) import Control.Monad.RWS (get, modify) import Control.Monad.Trans (liftIO)-import qualified Data.ByteString.Char8 as BSC-import qualified Data.ByteString as BS-import qualified Data.Char as Char-import qualified Elm.Internal.Paths as Elm+import qualified Data.Binary as Binary+import qualified Data.ByteString.Lazy.Char8 as BS+import qualified Data.List as List+import qualified Data.Map as Map import System.Directory (doesFileExist, removeFile)-import System.Exit (ExitCode(ExitFailure, ExitSuccess)) import System.FilePath ((</>), (<.>), replaceExtension)-import System.IO (hPutStrLn, stderr, stdout)-import System.Process (readProcessWithExitCode)+import System.IO (hPutStrLn, stderr) import qualified Environment as Env import qualified Eval.Command as Eval import qualified Input +import qualified Elm.Compiler.Module as Module+import qualified Elm.Compiler.Type as Type+import qualified Elm.Package.Description as Desc+import qualified Elm.Package.Name as Name+import qualified Elm.Package.Paths as Path+import qualified Elm.Package.Version as Version+import qualified Elm.Utils as Utils + eval :: (Maybe Input.DefName, String) -> Eval.Command () eval code = do modify $ Env.insert code env <- get liftIO $ writeFile tempElmPath (Env.toElmCode env) liftIO . runConts $ do- types <- runCmd (Env.compilerPath env) (Env.flags env ++ elmArgs)- liftIO $ reformatJS tempJsPath+ runCmd (Env.compilerPath env) (Env.flags env ++ elmArgs)+ liftIO $ addNodeRunner tempJsPath value <- runCmd (Env.interpreterPath env) [tempJsPath]- liftIO $ printIfNeeded value (scrapeOutputType types)- liftIO $ removeIfExists tempElmPath+ liftIO $ printIfNeeded value+ liftIO $ removeIfExists tempElmPath+ liftIO $ removeIfExists tempJsPath return () where runConts m = runContT m (\_ -> return ())@@ -38,113 +46,98 @@ "repl-temp-000" <.> "elm" tempJsPath =- "build" </> replaceExtension tempElmPath "js"+ replaceExtension tempElmPath "js" elmArgs =- [ "--make"- , "--only-js"- , "--print-types"- , tempElmPath+ [ tempElmPath+ , "--yes"+ , "--output=" ++ tempJsPath ] -printIfNeeded :: BS.ByteString -> BS.ByteString -> IO ()-printIfNeeded rawValue tipe =- if BSC.null rawValue- then return ()- else BSC.hPutStrLn stdout message- where- value = BSC.init rawValue+printIfNeeded :: String -> IO ()+printIfNeeded rawValue =+ case rawValue of+ "" -> return ()+ _ ->+ do tipe <- getType+ let value = init rawValue - isTooLong =- BSC.isInfixOf "\n" value- || BSC.isInfixOf "\n" tipe- || BSC.length value + BSC.length tipe > 80+ let isTooLong =+ List.isInfixOf "\n" value+ || List.isInfixOf "\n" tipe+ || length value + 3 + length tipe > 80 - message =- BS.concat- [ if isTooLong then rawValue else value- , tipe- ]+ let tipeAnnotation =+ if isTooLong+ then "\n : " ++ List.intercalate "\n " (lines tipe)+ else " : " ++ tipe + putStrLn (value ++ tipeAnnotation) -runCmd :: FilePath -> [String] -> ContT () IO BS.ByteString++runCmd :: FilePath -> [String] -> ContT () IO String runCmd name args = ContT $ \ret ->- do (exitCode, stdout, stderr) <-- liftIO $ readProcessWithExitCode name args ""- case exitCode of- ExitSuccess -> ret (BSC.pack stdout)- ExitFailure code- | code == 127 -> failure missingExe -- UNIX- | code == 9009 -> failure missingExe -- Windows- | otherwise -> failure (stdout ++ stderr)- where- failure message = liftIO $ hPutStrLn stderr message+ do result <- liftIO (Utils.unwrappedRun name args)+ case result of+ Right stdout ->+ ret stdout - 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?" ]+ Left (Utils.MissingExe msg) ->+ liftIO $ hPutStrLn stderr msg + Left (Utils.CommandFailed out err) ->+ liftIO $ hPutStrLn stderr (out ++ err) -reformatJS :: String -> IO ()-reformatJS tempJsPath =- do rts <- BS.readFile Elm.runtime- src <- BS.readFile tempJsPath- BS.length src `seq` BS.writeFile tempJsPath (BS.concat [rts,src,out])- where- out =- BS.concat- [ "process.on('uncaughtException', function(err) {\n"- , " process.stderr.write(err.toString());\n"- , " process.exit(1);\n"- , "});\n"- , "var document = document || {};"- , "var window = window || {};"- , "var context = { inputs:[], addListener:function(){}, node:{} };\n"- , "var repl = Elm.Repl.make(context);\n"- , "var show = Elm.Native.Show.make(context).show;"- , "if ('", Env.lastVar, "' in repl)\n"- , " console.log(show(repl.", Env.lastVar, "));"- ] +addNodeRunner :: String -> IO ()+addNodeRunner tempJsPath =+ BS.appendFile tempJsPath nodeRunner -scrapeOutputType :: BS.ByteString -> BS.ByteString-scrapeOutputType rawTypeDump =- dropName (squashSpace relevantLines)- where- squashSpace :: [BS.ByteString] -> BS.ByteString- squashSpace multiLineTypeDecl =- BSC.unwords (BSC.words (BSC.unwords multiLineTypeDecl)) - dropName :: BS.ByteString -> BS.ByteString- dropName typeDecl =- BSC.cons ' ' (BSC.dropWhile (/= ':') typeDecl)+nodeRunner :: BS.ByteString+nodeRunner =+ BS.pack $+ concat+ [ "process.on('uncaughtException', function(err) {\n\+ \ process.stderr.write(err.toString());\n\+ \ process.exit(1);\n\+ \});\n\+ \var document = document || {};\n\+ \var window = window || {};\n\+ \var context = { inputs:[], addListener:function(){}, node:{} };\n\+ \var repl = Elm.Repl.make(context);\n\+ \var toString = Elm.Native.Show.make(context).toString;\n"+ , "if ('", Env.lastVarString, "' in repl) {\n"+ , " console.log(toString(repl.", Env.lastVarString, "));\n"+ , "}"+ ] - relevantLines :: [BS.ByteString]- relevantLines =- takeType . dropWhile (not . isLastVar) $ BSC.lines rawTypeDump - isLastVar :: BS.ByteString -> Bool- isLastVar line =- BS.isPrefixOf Env.lastVar line- || BS.isPrefixOf (BS.append "Repl." Env.lastVar) line+getType :: IO String+getType =+ do result <- runErrorT getTypeHelp+ case result of+ Right tipe -> return tipe+ Left _ -> return "" - takeType :: [BS.ByteString] -> [BS.ByteString]- takeType lines =- case lines of- [] -> error errorMessage- line : rest ->- line : takeWhile isMoreType rest - isMoreType :: BS.ByteString -> Bool- isMoreType line =- not (BS.null line)- && Char.isSpace (BSC.head line)+getTypeHelp :: ErrorT String IO String+getTypeHelp =+ do description <- Desc.read Path.description+ binary <- liftIO (BS.readFile (interfacePath description))+ let types = Module.interfaceTypes (Binary.decode binary)+ case Map.lookup Env.lastVarString types of+ Just tipe -> return (Type.toString tipe)+ Nothing -> throwError "Type signature not found!" - errorMessage =- "Internal error in elm-repl function scrapeOutputType\n\- \Please report this bug to <https://github.com/elm-lang/elm-repl/issues>"++interfacePath :: Desc.Description -> FilePath+interfacePath description =+ Path.stuffDirectory+ </> "build-artifacts"+ </> Name.toFilePath (Desc.name description)+ </> Version.toString (Desc.version description)+ </> "Repl.elmi" removeIfExists :: FilePath -> IO ()
src/Flags.hs view
@@ -3,22 +3,27 @@ import Data.Version (showVersion) import qualified Paths_elm_repl as This-import System.Console.CmdArgs (Data, Typeable, (&=), explicit, help, helpArg,- name, summary, typFile, versionArg)+import System.Console.CmdArgs+ ( Data, Typeable, (&=), explicit, help, helpArg+ , name, summary, typFile, versionArg+ ) + version = showVersion This.version + data Flags = Flags { compiler :: FilePath , interpreter :: FilePath } deriving (Data,Typeable,Show,Eq) + flags :: Flags flags = Flags- { compiler = "elm"+ { compiler = "elm-make" &= typFile- &= help "Provide a path to a specific Elm compiler."+ &= help "Provide a path to a specific version of elm-make." , interpreter = "node" &= typFile &= help "Provide a path to a specific JavaScript interpreter (e.g. node, nodejs, ...)."@@ -30,6 +35,7 @@ &= versionArg [explicit, name "version", name "v", summary version] &= summary ("Elm REPL " ++ version ++ ", (c) Evan Czaplicki 2011-2014")+ helpMessage :: String helpMessage =
src/Main.hs view
@@ -1,9 +1,9 @@ module Main where -import Control.Monad (unless, when)+import Control.Monad (when) import qualified System.Console.CmdArgs as CmdArgs-import System.Console.Haskeline (Settings(Settings, autoAddHistory, complete,- historyFile))+import System.Console.Haskeline+ (Settings(Settings, autoAddHistory, complete, historyFile)) import qualified System.Directory as Dir import qualified System.Exit as Exit import System.FilePath ((</>))@@ -17,13 +17,15 @@ main :: IO () main = do flags <- CmdArgs.cmdArgs Flags.flags- buildExisted <- Dir.doesDirectoryExist "build"- cacheExisted <- Dir.doesDirectoryExist "cache"+ stuffExisted <- Dir.doesDirectoryExist "elm-stuff"+ pkgJsonExisted <- Dir.doesFileExist "elm-package.json" settings <- mkSettings putStrLn welcomeMessage exitCode <- ifJsInterpExists flags (Loop.loop flags settings)- unless buildExisted (removeDirectoryRecursiveIfExists "build")- unless cacheExisted (removeDirectoryRecursiveIfExists "cache")+ when (not stuffExisted) (removeDirectoryRecursiveIfExists "elm-stuff")+ when (not pkgJsonExisted) $+ do stillExists <- Dir.doesFileExist "elm-package.json"+ when stillExists (Dir.removeFile "elm-package.json") Exit.exitWith exitCode
src/Parse.hs view
@@ -88,7 +88,11 @@ in Just $ Input.Import (getFirstCap (words src)) - | List.isPrefixOf "data " src =+ | List.isPrefixOf "type alias " src =+ let name = takeWhile (/=' ') . drop 11 $ src+ in Just $ Input.DataDef name++ | List.isPrefixOf "type " src = let name = takeWhile (/=' ') . drop 5 $ src in Just $ Input.DataDef name