├── .gitignore ├── .travis.yml ├── LICENSE ├── README.md ├── Setup.hs ├── changelog.txt ├── elm-repl.cabal ├── man └── elm-repl.1 ├── src ├── Completion.hs ├── Environment.hs ├── Eval.hs ├── Eval │ ├── Code.hs │ └── Meta.hs ├── Flags.hs ├── Loop.hs ├── Main.hs └── Read.hs └── tests └── Main.hs /.gitignore: -------------------------------------------------------------------------------- 1 | dist 2 | .cabal-sandbox/ 3 | cabal.sandbox.config 4 | *~ 5 | elm-stuff -------------------------------------------------------------------------------- /.travis.yml: -------------------------------------------------------------------------------- 1 | language: haskell 2 | install: 3 | - git clone https://github.com/elm-lang/Elm.git 4 | - cabal sandbox init 5 | - cabal sandbox add-source Elm 6 | - cabal install --only-dependencies --enable-tests 7 | script: cabal test 8 | -------------------------------------------------------------------------------- /LICENSE: -------------------------------------------------------------------------------- 1 | Copyright (c) 2013-2014, Evan Czaplicki 2 | 3 | All rights reserved. 4 | 5 | Redistribution and use in source and binary forms, with or without 6 | modification, are permitted provided that the following conditions are met: 7 | 8 | * Redistributions of source code must retain the above copyright 9 | notice, this list of conditions and the following disclaimer. 10 | 11 | * Redistributions in binary form must reproduce the above 12 | copyright notice, this list of conditions and the following 13 | disclaimer in the documentation and/or other materials provided 14 | with the distribution. 15 | 16 | * Neither the name of Evan Czaplicki nor the names of other 17 | contributors may be used to endorse or promote products derived 18 | from this software without specific prior written permission. 19 | 20 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS 21 | "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT 22 | LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR 23 | A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT 24 | OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, 25 | SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT 26 | LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, 27 | DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY 28 | THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT 29 | (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE 30 | OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. 31 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Merged into [`elm/compiler`](https://github.com/elm/compiler) 2 | -------------------------------------------------------------------------------- /Setup.hs: -------------------------------------------------------------------------------- 1 | import Distribution.Simple 2 | main = defaultMain 3 | -------------------------------------------------------------------------------- /changelog.txt: -------------------------------------------------------------------------------- 1 | Release 0.2.1 2 | ============= 3 | Features: 4 | * Basic auto-completion. 5 | * Better error messages. 6 | 7 | Bug Fixes: 8 | * Fix error when running consecutive commands quickly. 9 | 10 | Release 0.2 11 | =========== 12 | Features: 13 | * Compiler flag control. 14 | * Repl commands: help, manipulate flags, clear environment, exit. 15 | * Exit on EOF. 16 | * Interrupt on Ctrl-c. 17 | 18 | Bug fixes: 19 | * Fix infinite loop when printing long types. 20 | * Fix node.js type error when errors are thrown. 21 | * Top-level record literals work. 22 | -------------------------------------------------------------------------------- /elm-repl.cabal: -------------------------------------------------------------------------------- 1 | Name: elm-repl 2 | Version: 0.18 3 | 4 | Synopsis: 5 | a REPL for Elm 6 | 7 | Description: 8 | A read-eval-print-loop (REPL) for evaluating Elm expressions, 9 | definitions, ADTs, and module imports. This tool is meant to 10 | help you play with small expressions and interact with 11 | functions deep inside of larger projects. 12 | 13 | Homepage: 14 | https://github.com/elm-lang/elm-repl 15 | 16 | License: BSD3 17 | License-file: LICENSE 18 | 19 | Author: Evan Czaplicki 20 | Maintainer: info@elm-lang.org 21 | Copyright: Copyright: (c) 2011-2014 Evan Czaplicki 22 | 23 | Category: Tool 24 | 25 | Build-type: Simple 26 | Extra-source-files: changelog.txt 27 | Cabal-version: >=1.8 28 | 29 | source-repository head 30 | type: git 31 | location: git://github.com/elm-lang/elm-repl.git 32 | 33 | Executable elm-repl 34 | ghc-options: 35 | -W 36 | 37 | Hs-Source-Dirs: 38 | src 39 | 40 | Main-is: 41 | Main.hs 42 | 43 | other-modules: 44 | Completion, 45 | Environment, 46 | Eval, 47 | Eval.Code, 48 | Eval.Meta, 49 | Flags, 50 | Loop, 51 | Read 52 | 53 | Build-depends: 54 | base >=4.2 && <5, 55 | binary, 56 | bytestring >= 0.9 && < 0.11, 57 | bytestring-trie >= 0.2.2 && < 0.3, 58 | cmdargs >= 0.7 && < 0.11, 59 | containers, 60 | directory >= 1 && < 2, 61 | elm-compiler == 0.18, 62 | elm-package, 63 | filepath >= 1 && < 2, 64 | haskeline >= 0.7 && < 0.8, 65 | mtl >= 2.2.1 && < 3, 66 | parsec >= 3.1.1 && < 3.5, 67 | text 68 | 69 | 70 | Test-Suite test 71 | Type: 72 | exitcode-stdio-1.0 73 | 74 | ghc-options: 75 | -W 76 | 77 | Hs-Source-Dirs: 78 | tests, src 79 | 80 | Main-is: 81 | Main.hs 82 | 83 | build-depends: 84 | test-framework, 85 | test-framework-hunit, 86 | test-framework-quickcheck2 >= 0.3, 87 | HUnit, 88 | QuickCheck, 89 | base >=4.2 && <5, 90 | bytestring >= 0.9 && < 0.11, 91 | bytestring-trie >= 0.2.2 && < 0.3, 92 | cmdargs >= 0.7 && < 0.11, 93 | directory >= 1 && < 2, 94 | elm-compiler == 0.18, 95 | elm-package, 96 | filepath >= 1 && < 2, 97 | haskeline >= 0.7 && < 0.8, 98 | mtl >= 2 && < 3, 99 | parsec >= 3.1.1 && < 3.5 100 | -------------------------------------------------------------------------------- /man/elm-repl.1: -------------------------------------------------------------------------------- 1 | .TH ELM-REPL "1" "June 2014" "elm-repl 0.2.2.1" "User Commands" 2 | .SH NAME 3 | elm-repl \- Read-eval-print-loop for Elm 4 | .SH DESCRIPTION 5 | Elm REPL 0.2.2.1, (c) Evan Czaplicki 2011\-2013 6 | .PP 7 | flags [OPTIONS] 8 | .IP 9 | Read\-eval\-print\-loop (REPL) for digging deep into Elm projects. 10 | .SS "Common flags:" 11 | .TP 12 | \fB\-c\fR \fB\-\-compiler\fR=\fIFILE\fR 13 | Provide a path to a specific Elm compiler (default "elm"). 14 | .TP 15 | \fB\-j\fR \fB\-\-js-cmd\fR=\fIFILE\fR 16 | Provide a path to a specific JavaScript interpreter (default "node"). 17 | .TP 18 | \fB\-h\fR \fB\-\-help\fR 19 | Display help message 20 | .TP 21 | \fB\-v\fR \fB\-\-version\fR 22 | Print version information 23 | -------------------------------------------------------------------------------- /src/Completion.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Completion (complete) where 3 | 4 | import Control.Monad.State (get) 5 | import qualified Data.ByteString.Char8 as BS 6 | import qualified Data.Trie as Trie 7 | import System.Console.Haskeline.Completion (Completion(Completion), CompletionFunc, completeWord) 8 | 9 | import qualified Environment as Env 10 | 11 | 12 | complete :: CompletionFunc Env.Task 13 | complete = 14 | completeWord Nothing " \t" lookupCompletions 15 | 16 | 17 | lookupCompletions :: String -> Env.Task [Completion] 18 | lookupCompletions string = 19 | do env <- get 20 | let defs = adjustDefs (Env.defs env) 21 | return (completions string defs) 22 | where 23 | adjustDefs defs = 24 | Trie.unionL cmds $ 25 | Trie.delete Env.firstVar $ 26 | Trie.delete Env.lastVar defs 27 | 28 | cmds = 29 | Trie.fromList 30 | [ (":exit", "") 31 | , (":reset", "") 32 | , (":help", "") 33 | , (":flags", "") 34 | ] 35 | 36 | 37 | completions :: String -> Trie.Trie a -> [Completion] 38 | completions string = 39 | Trie.lookupBy go (BS.pack string) 40 | where 41 | go :: Maybe a -> Trie.Trie a -> [Completion] 42 | go isElem suffixesTrie = 43 | maybeCurrent ++ suffixCompletions 44 | where 45 | maybeCurrent = 46 | case isElem of 47 | Nothing -> [] 48 | Just _ -> [ Completion string string True ] 49 | 50 | suffixCompletions = 51 | map (suffixCompletion . BS.unpack) (Trie.keys suffixesTrie) 52 | 53 | suffixCompletion suffix = 54 | let full = string ++ suffix in 55 | Completion full full False 56 | -------------------------------------------------------------------------------- /src/Environment.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Environment where 3 | 4 | import Control.Monad.RWS (RWST, runRWST) 5 | import Data.ByteString (ByteString) 6 | import qualified Data.ByteString.Char8 as BS 7 | import Data.Monoid ((<>)) 8 | import Data.Trie (Trie) -- TODO: Switch to a Char-based trie. 9 | import qualified Data.Trie as Trie 10 | 11 | 12 | 13 | -- TASKS 14 | 15 | 16 | type Task = 17 | RWST () () Env IO 18 | 19 | 20 | run :: Env -> Task a -> IO a 21 | run env task = 22 | do (x,_,_) <- runRWST task () env 23 | return x 24 | 25 | 26 | 27 | -- USER INPUT 28 | 29 | 30 | data Input 31 | = Meta Config 32 | | Code (Maybe DefName, String) 33 | | Skip 34 | deriving (Show, Eq) 35 | 36 | 37 | data Config 38 | = AddFlag String 39 | | RemoveFlag String 40 | | ListFlags 41 | | ClearFlags 42 | -- Just if this was triggered by an error 43 | | InfoFlags (Maybe String) 44 | | Help (Maybe String) 45 | | Exit 46 | | Reset 47 | deriving (Show, Eq) 48 | 49 | 50 | data DefName 51 | = VarDef String 52 | | DataDef String 53 | | Import String 54 | deriving (Show, Eq) 55 | 56 | 57 | needsPrint :: Maybe DefName -> Bool 58 | needsPrint maybeDefName = 59 | case maybeDefName of 60 | Just (VarDef _) -> 61 | True 62 | 63 | Nothing -> 64 | True 65 | 66 | Just _ -> 67 | False 68 | 69 | 70 | 71 | -- ENVIRONMENT 72 | 73 | 74 | data Env = Env 75 | { compilerPath :: FilePath 76 | , interpreterPath :: FilePath 77 | , flags :: [String] 78 | , imports :: Trie String 79 | , adts :: Trie String 80 | , defs :: Trie String 81 | } 82 | deriving Show 83 | 84 | 85 | empty :: FilePath -> FilePath -> Env 86 | empty compiler interpreter = 87 | Env compiler 88 | interpreter 89 | [] 90 | Trie.empty 91 | Trie.empty 92 | (Trie.singleton firstVar (BS.unpack firstVar <> " = ()")) 93 | 94 | 95 | firstVar :: ByteString 96 | firstVar = 97 | "t_s_o_l" 98 | 99 | 100 | lastVar :: ByteString 101 | lastVar = 102 | "d_e_l_t_r_o_n_3_0_3_0" 103 | 104 | 105 | lastVarString :: String 106 | lastVarString = 107 | BS.unpack lastVar 108 | 109 | 110 | toElmCode :: Env -> String 111 | toElmCode env = 112 | unlines $ "module Repl exposing (..)" : decls 113 | where 114 | decls = 115 | concatMap Trie.elems [ imports env, adts env, defs env ] 116 | 117 | 118 | insert :: (Maybe DefName, String) -> Env -> Env 119 | insert (maybeName, src) env = 120 | case maybeName of 121 | Nothing -> 122 | display src env 123 | 124 | Just (Import name) -> 125 | noDisplay $ env 126 | { imports = Trie.insert (BS.pack name) src (imports env) 127 | } 128 | 129 | Just (DataDef name) -> 130 | noDisplay $ env 131 | { adts = Trie.insert (BS.pack name) src (adts env) 132 | } 133 | 134 | Just (VarDef name) -> 135 | define (BS.pack name) src (display name env) 136 | 137 | 138 | define :: ByteString -> String -> Env -> Env 139 | define name body env = 140 | env { defs = Trie.insert name body (defs env) } 141 | 142 | 143 | display :: String -> Env -> Env 144 | display body env = 145 | define lastVar (format body) env 146 | where 147 | format body = 148 | lastVarString ++ " =" ++ concatMap ("\n "++) (lines body) 149 | 150 | 151 | noDisplay :: Env -> Env 152 | noDisplay env = 153 | env { defs = Trie.delete lastVar (defs env) } 154 | -------------------------------------------------------------------------------- /src/Eval.hs: -------------------------------------------------------------------------------- 1 | module Eval (eval) where 2 | 3 | import Control.Monad.Trans (liftIO) 4 | import System.Console.Haskeline (handleInterrupt) 5 | import qualified System.Exit as Exit 6 | 7 | import qualified Environment as Env 8 | import qualified Eval.Code as Code 9 | import qualified Eval.Meta as Meta 10 | 11 | 12 | eval :: Env.Input -> Env.Task (Maybe Exit.ExitCode) 13 | eval action = 14 | case action of 15 | Env.Meta cmd -> 16 | Meta.eval cmd 17 | 18 | Env.Skip -> 19 | return Nothing 20 | 21 | Env.Code code -> 22 | do handleInterrupt interruptedMsg (Code.eval code) 23 | return Nothing 24 | where 25 | interruptedMsg = 26 | liftIO $ putStrLn " Computation interrupted, any definitions were not completed." 27 | -------------------------------------------------------------------------------- /src/Eval/Code.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Eval.Code (eval) where 3 | 4 | import Control.Monad.Except (ExceptT, runExceptT, throwError, when) 5 | import qualified Control.Monad.RWS as State 6 | import Control.Monad.Trans (liftIO) 7 | import qualified Data.Binary as Binary 8 | import qualified Data.ByteString.Lazy.Char8 as BS 9 | import qualified Data.List as List 10 | import qualified Data.Map as Map 11 | import qualified Data.Text as Text 12 | import qualified Data.Text.IO as Text 13 | import System.Directory (doesFileExist, removeFile) 14 | import System.FilePath ((), (<.>), replaceExtension) 15 | import System.IO (hPutStrLn, stderr) 16 | 17 | import qualified Environment as Env 18 | 19 | import qualified Elm.Compiler as Compiler 20 | import qualified Elm.Compiler.Module as Module 21 | import qualified Elm.Compiler.Type as Type 22 | import qualified Elm.Package as Pkg 23 | import qualified Elm.Package.Description as Desc 24 | import qualified Elm.Package.Paths as Path 25 | import qualified Elm.Utils as Utils 26 | 27 | 28 | eval :: (Maybe Env.DefName, String) -> Env.Task () 29 | eval code = 30 | let 31 | tempElmPath = 32 | "repl-temp-000" <.> "elm" 33 | 34 | tempJsPath = 35 | replaceExtension tempElmPath "js" 36 | in 37 | do oldEnv <- State.get 38 | let newEnv = Env.insert code oldEnv 39 | 40 | liftIO $ writeFile tempElmPath (Env.toElmCode newEnv) 41 | let needsPrint = Env.needsPrint (fst code) 42 | 43 | result <- liftIO (runExceptT (tryCompile tempElmPath tempJsPath newEnv needsPrint)) 44 | 45 | liftIO $ removeIfExists tempElmPath 46 | liftIO $ removeIfExists tempJsPath 47 | 48 | case result of 49 | Left msg -> 50 | liftIO (hPutStrLn stderr msg) 51 | 52 | Right () -> 53 | State.put newEnv 54 | 55 | 56 | tryCompile :: FilePath -> FilePath -> Env.Env -> Bool -> ExceptT String IO () 57 | tryCompile tempElmPath tempJsPath env needsPrint = 58 | do run (Env.compilerPath env) (Env.flags env ++ elmArgs) 59 | when needsPrint (liftIO (addHook tempJsPath)) 60 | value <- run (Env.interpreterPath env) [tempJsPath] 61 | liftIO $ printIfNeeded value 62 | where 63 | elmArgs = 64 | [ tempElmPath 65 | , "--yes" 66 | , "--output=" ++ tempJsPath 67 | ] 68 | 69 | 70 | addHook :: FilePath -> IO () 71 | addHook tempJsPath = 72 | do js <- Text.readFile tempJsPath 73 | let (body, outro) = Text.breakOnEnd "var Elm = {};" js 74 | let (intro, midtro) = Text.breakOnEnd lastVar body 75 | Text.writeFile tempJsPath $ Text.concat $ 76 | [ nodeHeader 77 | , intro 78 | , " = " 79 | , lastVar 80 | , midtro 81 | , nodeFooter 82 | , outro 83 | ] 84 | 85 | 86 | printIfNeeded :: String -> IO () 87 | printIfNeeded rawValue = 88 | case rawValue of 89 | "" -> 90 | return () 91 | 92 | _ -> 93 | do tipe <- getType 94 | 95 | let value = 96 | init rawValue 97 | 98 | let isTooLong = 99 | List.isInfixOf "\n" value 100 | || List.isInfixOf "\n" tipe 101 | || length value + 3 + length tipe > 80 102 | 103 | let tipeAnnotation = 104 | if isTooLong then 105 | "\n : " ++ List.intercalate "\n " (lines tipe) 106 | 107 | else 108 | " : " ++ tipe 109 | 110 | putStrLn (value ++ tipeAnnotation) 111 | 112 | 113 | run :: FilePath -> [String] -> ExceptT String IO String 114 | run name args = 115 | do result <- liftIO (Utils.unwrappedRun name args) 116 | case result of 117 | Right stdout -> 118 | return stdout 119 | 120 | Left (Utils.MissingExe msg) -> 121 | throwError msg 122 | 123 | Left (Utils.CommandFailed _out err) -> 124 | throwError err 125 | 126 | 127 | nodeHeader :: Text.Text 128 | nodeHeader = 129 | Text.concat 130 | [ "process.on('uncaughtException', function(err) {\n\ 131 | \ process.stderr.write(err.toString());\n\ 132 | \ process.exit(1);\n\ 133 | \});\n\ 134 | \var ", lastVar, ";\n" 135 | ] 136 | 137 | 138 | nodeFooter :: Text.Text 139 | nodeFooter = 140 | Text.concat 141 | [ "\n" 142 | , "if (typeof ", lastVar, " !== 'undefined') {\n" 143 | , " console.log(_elm_lang$core$Native_Utils.toString(", lastVar, "));\n" 144 | , "}\n" 145 | ] 146 | 147 | 148 | lastVar :: Text.Text 149 | lastVar = 150 | Text.pack Env.lastVarString 151 | 152 | 153 | getType :: IO String 154 | getType = 155 | do result <- runExceptT getTypeHelp 156 | case result of 157 | Right tipe -> return tipe 158 | Left _ -> return "" 159 | 160 | 161 | getTypeHelp :: ExceptT String IO String 162 | getTypeHelp = 163 | do description <- Desc.read id Path.description 164 | binary <- liftIO (BS.readFile (interfacePath description)) 165 | let types = Module.interfaceAliasedTypes (Binary.decode binary) 166 | case Map.lookup lastVar types of 167 | Just tipe -> return (Type.toString tipe) 168 | Nothing -> throwError "Type signature not found!" 169 | 170 | 171 | interfacePath :: Desc.Description -> FilePath 172 | interfacePath description = 173 | Path.stuffDirectory 174 | "build-artifacts" 175 | Pkg.versionToString Compiler.version 176 | Pkg.toFilePath (Desc.name description) 177 | Pkg.versionToString (Desc.version description) 178 | "Repl.elmi" 179 | 180 | 181 | removeIfExists :: FilePath -> IO () 182 | removeIfExists fileName = 183 | do exists <- doesFileExist fileName 184 | if exists 185 | then removeFile fileName 186 | else return () 187 | -------------------------------------------------------------------------------- /src/Eval/Meta.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE FlexibleContexts #-} 2 | module Eval.Meta (eval) where 3 | 4 | import Control.Monad.State (get, modify) 5 | import Control.Monad.Trans (liftIO) 6 | import qualified Data.List as List 7 | import System.Exit (ExitCode(ExitSuccess)) 8 | 9 | import qualified Environment as Env 10 | 11 | 12 | eval :: Env.Config -> Env.Task (Maybe ExitCode) 13 | eval config = 14 | case config of 15 | Env.Exit -> 16 | return (Just ExitSuccess) 17 | 18 | Env.Help m -> 19 | do displayErr "Bad command\n" m 20 | display helpInfo 21 | 22 | Env.InfoFlags m -> 23 | do displayErr "Bad flag\n" m 24 | display flagsInfo 25 | 26 | Env.ListFlags -> 27 | display . unlines . Env.flags =<< get 28 | 29 | Env.AddFlag flag -> 30 | modifyIfPresent True flag "Added " "Flag already added!" $ \env -> 31 | env { Env.flags = Env.flags env ++ [flag] } 32 | 33 | Env.RemoveFlag flag -> 34 | modifyIfPresent False flag "Removed flag " "No such flag." $ \env -> 35 | env {Env.flags = List.delete flag $ Env.flags env} 36 | 37 | Env.Reset -> 38 | modifyAlways "Environment Reset" $ \env -> 39 | Env.empty (Env.compilerPath env) (Env.interpreterPath env) 40 | 41 | Env.ClearFlags -> 42 | modifyAlways "All flags cleared" $ \env -> 43 | env {Env.flags = []} 44 | 45 | where 46 | display msg = 47 | do liftIO . putStrLn $ msg 48 | return Nothing 49 | 50 | displayErr msg m = 51 | case m of 52 | Nothing -> return () 53 | Just err -> liftIO . putStrLn $ msg ++ err 54 | 55 | modifyIfPresent b flag msgSuc msgFail mod = 56 | do env <- get 57 | if not b `xor` (flag `elem` Env.flags env) 58 | then display msgFail 59 | else do liftIO . putStrLn $ msgSuc ++ flag 60 | modify mod 61 | return Nothing 62 | 63 | modifyAlways msg mod = 64 | do liftIO . putStrLn $ msg 65 | modify mod 66 | return Nothing 67 | 68 | 69 | xor :: Bool -> Bool -> Bool 70 | xor boolean boolean' = 71 | boolean /= boolean' 72 | 73 | 74 | flagsInfo :: String 75 | flagsInfo = 76 | "Usage: flags [operation]\n\ 77 | \\n\ 78 | \ operations:\n\ 79 | \ add --src-dir=FILEPATH\tAdd a compiler flag\n\ 80 | \ remove --src-dir=FILEPATH\tRemove a compiler flag\n\ 81 | \ list\t\t\tList all flags that have been added\n\ 82 | \ clear\t\t\tClears all flags\n" 83 | 84 | helpInfo :: String 85 | helpInfo = 86 | "General usage directions: \n\ 87 | \Additional commands available from the prompt:\n\ 88 | \\n\ 89 | \ :help\t\t\tList available commands\n\ 90 | \ :flags\t\tManipulate flags sent to elm compiler\n\ 91 | \ :reset\t\tClears all previous imports\n\ 92 | \ :exit\t\t\tExits elm-repl\n" 93 | -------------------------------------------------------------------------------- /src/Flags.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE DeriveDataTypeable #-} 2 | module Flags where 3 | 4 | import System.Console.CmdArgs 5 | ( Data, Typeable, (&=), explicit, help, helpArg 6 | , name, summary, typFile, versionArg 7 | ) 8 | 9 | import qualified Elm.Compiler as Compiler 10 | import qualified Elm.Package as Pkg 11 | 12 | 13 | version :: String 14 | version = 15 | Pkg.versionToString Compiler.version 16 | 17 | 18 | data Flags = Flags 19 | { compiler :: FilePath 20 | , interpreter :: Maybe FilePath 21 | } 22 | deriving (Data,Typeable,Show,Eq) 23 | 24 | 25 | flags :: Flags 26 | flags = Flags 27 | { compiler = "elm-make" 28 | &= typFile 29 | &= help "Provide a path to a specific version of elm-make." 30 | 31 | , interpreter = Nothing 32 | &= typFile 33 | &= help "Provide a path to a specific JavaScript interpreter (e.g. node, nodejs, ...)." 34 | } 35 | &= help helpMessage 36 | 37 | &= helpArg 38 | [ explicit 39 | , name "help" 40 | , name "h" 41 | ] 42 | 43 | &= versionArg 44 | [ explicit 45 | , name "version" 46 | , name "v" 47 | , summary version 48 | ] 49 | 50 | &= summary ("elm repl " ++ version) 51 | 52 | 53 | helpMessage :: String 54 | helpMessage = 55 | "Read-eval-print-loop (REPL) for digging deep into Elm projects.\n\ 56 | \More info at " -------------------------------------------------------------------------------- /src/Loop.hs: -------------------------------------------------------------------------------- 1 | module Loop (loop) where 2 | 3 | import Control.Monad.Trans (lift) 4 | import System.Console.Haskeline 5 | ( InputT, MonadException, Settings, getInputLine 6 | , handleInterrupt, runInputT, withInterrupt 7 | ) 8 | import System.Exit (ExitCode(ExitSuccess)) 9 | 10 | import qualified Environment as Env 11 | import qualified Eval 12 | import qualified Read 13 | 14 | 15 | loop :: Env.Env -> Settings Env.Task -> IO ExitCode 16 | loop env settings = 17 | Env.run env $ runInputT settings (withInterrupt acceptInput) 18 | 19 | 20 | acceptInput :: InputT Env.Task ExitCode 21 | acceptInput = 22 | do rawInput <- handleInterrupt (return (Just "")) getInput 23 | case rawInput of 24 | Nothing -> 25 | return ExitSuccess 26 | 27 | Just string -> 28 | do let input = Read.input string 29 | result <- lift (Eval.eval input) 30 | case result of 31 | Just exit -> return exit 32 | Nothing -> acceptInput 33 | 34 | 35 | getInput :: (MonadException m) => InputT m (Maybe String) 36 | getInput = 37 | go "> " "" 38 | where 39 | go lineStart inputSoFar = 40 | do input <- getInputLine lineStart 41 | case input of 42 | Nothing -> return Nothing 43 | Just new -> continueWith (inputSoFar ++ new) 44 | 45 | continueWith inputSoFar = 46 | if null inputSoFar || last inputSoFar /= '\\' 47 | then return (Just inputSoFar) 48 | else go "| " (init inputSoFar ++ "\n") 49 | -------------------------------------------------------------------------------- /src/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import Control.Applicative ((<|>)) 4 | import Control.Monad (when) 5 | import qualified System.Console.CmdArgs as CmdArgs 6 | import System.Console.Haskeline 7 | ( Settings(Settings, autoAddHistory, complete, historyFile) 8 | ) 9 | import qualified System.Directory as Dir 10 | import qualified System.Exit as Exit 11 | import System.FilePath (()) 12 | import System.IO (hPutStrLn, stderr) 13 | 14 | import qualified Completion 15 | import qualified Environment as Env 16 | import qualified Flags 17 | import qualified Loop 18 | import qualified Elm.Compiler as Elm 19 | import qualified Elm.Package as Pkg 20 | 21 | 22 | main :: IO () 23 | main = 24 | do flags <- CmdArgs.cmdArgs Flags.flags 25 | stuffExisted <- Dir.doesDirectoryExist "elm-stuff" 26 | pkgJsonExisted <- Dir.doesFileExist "elm-package.json" 27 | exitCode <- runRepl flags 28 | when (not stuffExisted) (removeDirectoryRecursiveIfExists "elm-stuff") 29 | when (not pkgJsonExisted) (removeFileIfExists "elm-package.json") 30 | Exit.exitWith exitCode 31 | 32 | 33 | -- CLEANUP 34 | 35 | removeDirectoryRecursiveIfExists :: FilePath -> IO () 36 | removeDirectoryRecursiveIfExists path = 37 | do exists <- Dir.doesDirectoryExist path 38 | when exists (Dir.removeDirectoryRecursive path) 39 | 40 | 41 | removeFileIfExists :: FilePath -> IO () 42 | removeFileIfExists path = 43 | do exists <- Dir.doesFileExist path 44 | when exists (Dir.removeFile path) 45 | 46 | 47 | -- RUN THE REPL 48 | 49 | runRepl :: Flags.Flags -> IO Exit.ExitCode 50 | runRepl flags = 51 | do putStrLn welcomeMessage 52 | (name, maybeInterpreter) <- findExe (Flags.interpreter flags) 53 | case maybeInterpreter of 54 | Nothing -> 55 | do hPutStrLn stderr (exeNotFound name) 56 | return (Exit.ExitFailure 1) 57 | 58 | Just interpreter -> 59 | do settings <- initSettings 60 | let env = Env.empty (Flags.compiler flags) interpreter 61 | Loop.loop env settings 62 | 63 | 64 | -- FIND JS INTERPRETER 65 | 66 | findExe :: Maybe String -> IO (String, Maybe FilePath) 67 | findExe maybeName = 68 | case maybeName of 69 | Just name -> 70 | (,) name <$> Dir.findExecutable name 71 | 72 | Nothing -> 73 | do maybeInterpreter <- 74 | (<|>) <$> Dir.findExecutable "node" 75 | <*> Dir.findExecutable "nodejs" 76 | 77 | return ("node' or 'nodejs", maybeInterpreter) 78 | 79 | 80 | exeNotFound :: String -> String 81 | exeNotFound stuff = 82 | "The REPL relies on node.js to execute JavaScript code outside the browser.\n" 83 | ++ "I could not find executable '" ++ stuff ++ "' on your computer though!\n\n" 84 | ++ "You can install node.js from . If it is already installed\n" 85 | ++ "but has a different name, use the --interpreter flag." 86 | 87 | 88 | -- WELCOME 89 | 90 | welcomeMessage :: String 91 | welcomeMessage = 92 | let 93 | starter = 94 | "---- elm-repl " ++ Pkg.versionToString Elm.version ++ " " 95 | in 96 | starter ++ replicate (80 - length starter) '-' ++ "\n" 97 | ++ " :help for help, :exit to exit, more at \n" 98 | ++ "--------------------------------------------------------------------------------" 99 | 100 | 101 | -- SETTINGS 102 | 103 | initSettings :: IO (Settings Env.Task) 104 | initSettings = 105 | do dataDir <- getDataDir 106 | return $ Settings 107 | { historyFile = Just (dataDir "history") 108 | , autoAddHistory = True 109 | , complete = Completion.complete 110 | } 111 | 112 | 113 | getDataDir :: IO FilePath 114 | getDataDir = 115 | do root <- Dir.getAppUserDataDirectory "elm" 116 | let dir = root Pkg.versionToString Elm.version "repl" 117 | Dir.createDirectoryIfMissing True dir 118 | return dir 119 | 120 | -------------------------------------------------------------------------------- /src/Read.hs: -------------------------------------------------------------------------------- 1 | {-# LANGUAGE OverloadedStrings #-} 2 | module Read (input) where 3 | 4 | import qualified Data.Char as Char 5 | import qualified Data.List as List 6 | import qualified Data.Text as Text 7 | import Text.Parsec 8 | ( Parsec, (<|>), anyChar, char, choice, eof, many, many1 9 | , manyTill, parse, satisfy, space, spaces, string 10 | ) 11 | 12 | import qualified Elm.Utils as Utils 13 | import qualified Environment as Env 14 | 15 | 16 | type Parser = Parsec String () 17 | 18 | 19 | input :: String -> Env.Input 20 | input string = 21 | case parse result "" string of 22 | Right action -> 23 | action 24 | 25 | Left errorMessage -> 26 | Env.Meta (Env.Help (Just (show errorMessage))) 27 | 28 | 29 | result :: Parser Env.Input 30 | result = 31 | do spaces 32 | choice 33 | [ do eof 34 | return Env.Skip 35 | , do char ':' 36 | Env.Meta <$> config 37 | , do string <- many anyChar 38 | return (Env.Code (extractCode string)) 39 | ] 40 | 41 | 42 | -- PARSE CONFIG 43 | 44 | config :: Parser Env.Config 45 | config = 46 | let 47 | ok cmd = 48 | eof >> return cmd 49 | in 50 | do flag <- many1 notSpace 51 | spaces 52 | case flag of 53 | "exit" -> ok Env.Exit 54 | "reset" -> ok Env.Reset 55 | "help" -> ok (Env.Help Nothing) 56 | "flags" -> ok (Env.InfoFlags Nothing) <|> flags 57 | _ -> return $ Env.Help (Just flag) 58 | 59 | 60 | flags :: Parser Env.Config 61 | flags = 62 | do flag <- many1 notSpace 63 | case flag of 64 | "add" -> srcDirFlag Env.AddFlag 65 | "remove" -> srcDirFlag Env.RemoveFlag 66 | "list" -> return Env.ListFlags 67 | "clear" -> return Env.ClearFlags 68 | _ -> return (Env.InfoFlags (Just flag)) 69 | where 70 | srcDirFlag ctor = 71 | do many1 space 72 | ctor <$> srcDir 73 | 74 | 75 | notSpace :: Parser Char 76 | notSpace = 77 | satisfy (not . Char.isSpace) 78 | 79 | 80 | srcDir :: Parser String 81 | srcDir = 82 | do string "--src-dir=" 83 | dir <- manyTill anyChar (choice [ space >> return (), eof ]) 84 | return ("--src-dir=" ++ dir) 85 | 86 | 87 | -- PARSE CODE 88 | 89 | extractCode :: String -> (Maybe Env.DefName, String) 90 | extractCode rawInput = 91 | (extractDefName rawInput, rawInput) 92 | 93 | 94 | extractDefName :: String -> Maybe Env.DefName 95 | extractDefName src 96 | | List.isPrefixOf "import " src = 97 | let 98 | getFirstCap tokens = 99 | case tokens of 100 | token@(c:_) : rest -> 101 | if Char.isUpper c then token else getFirstCap rest 102 | _ -> src 103 | in 104 | Just (Env.Import (getFirstCap (words src))) 105 | 106 | | List.isPrefixOf "type alias " src = 107 | let 108 | name = takeWhile (/=' ') (drop 11 src) 109 | in 110 | Just (Env.DataDef name) 111 | 112 | | List.isPrefixOf "type " src = 113 | let 114 | name = takeWhile (/=' ') (drop 5 src) 115 | in 116 | Just (Env.DataDef name) 117 | 118 | | otherwise = 119 | do names <- Utils.isDeclaration (Text.pack src) 120 | return $ Env.VarDef (Text.unpack (Text.intercalate "$" names)) 121 | -------------------------------------------------------------------------------- /tests/Main.hs: -------------------------------------------------------------------------------- 1 | module Main where 2 | 3 | import qualified Data.Char as Char 4 | import qualified Data.List as List 5 | import Data.Maybe (isJust) 6 | import Test.Framework (Test, defaultMain, testGroup) 7 | import Test.Framework.Providers.HUnit (testCase) 8 | import Test.Framework.Providers.QuickCheck2 (testProperty) 9 | import Test.HUnit ((@=?)) 10 | import qualified Test.HUnit.Base as HUnit 11 | import Test.QuickCheck 12 | 13 | import qualified Input as I 14 | import qualified Parse 15 | 16 | main :: IO () 17 | main = defaultMain tests 18 | 19 | tests :: [Test] 20 | tests = 21 | [ testGroup "Parse tests" 22 | [ testGroup "Command parse tests" cmdParseTests 23 | , testGroup "Code parse tests" codeParseTests 24 | , testGroup "Whitespace parse tests" skipTests 25 | ] 26 | ] 27 | 28 | cmdParseTests :: [Test] 29 | cmdParseTests = 30 | [ testGroup "Good commands tests" 31 | [ testCase ":help parses" $ cmdParses (I.Help Nothing) ":help" 32 | , testCase ":reset parses after whitespace" $ cmdParses I.Reset " :reset" 33 | , testCase ":exit parses before whitespace" $ cmdParses I.Exit ":exit " 34 | ] 35 | , testGroup ":flags parse tests" 36 | [ testCase ":flags parses with Info" $ cmdParses (I.InfoFlags Nothing) ":flags" 37 | , testCase ":flags + space parses with Info" $ cmdParses (I.InfoFlags Nothing) ":flags " 38 | , testCase ":flags list parses" $ cmdParses I.ListFlags ":flags list" 39 | , testCase ":flags clear parses w/ whitespace between" $ 40 | cmdParses I.ClearFlags ":flags clear" 41 | , testCase ":flags add source parses" $ 42 | cmdParses (I.AddFlag "--src-dir=\"\"") ":flags add --src-dir=\"\"" 43 | , testCase ":flags remove source parses" $ 44 | cmdParses (I.RemoveFlag "--src-dir=bleh") ":flags remove --src-dir=bleh" 45 | ] 46 | , testGroup "Bad commands tests" 47 | [ testCase ":flagsgrbl triggers help" $ helpErr ":flagsg" 48 | , testProperty "bad :commands trigger help" badCommandHelp 49 | ] 50 | ] 51 | where 52 | cmdParses cmd = actionParses (I.Meta cmd) 53 | helpErr cmd = 54 | case Parse.rawInput cmd of 55 | I.Meta (I.Help message) -> 56 | HUnit.assert (isJust message) 57 | action -> 58 | HUnit.assertFailure (errorMessage action) 59 | 60 | errorMessage action = 61 | "Should display help with an error message, instead got: " ++ show action 62 | 63 | codeParseTests :: [Test] 64 | codeParseTests = 65 | [ testCase "number parses" $ codeParses Nothing "3" 66 | , testCase "number parses after newlines" $ codeParses Nothing "\n\n3" 67 | , testCase "data def parses" $ codeParses (Just $ I.DataDef "Baz") "type Baz = B { }" 68 | , testCase "var def parses" $ codeParses (Just $ I.VarDef "x") "x = 3" 69 | , testCase "var fun def parses" $ codeParses (Just $ I.VarDef "f") "f x = x" 70 | ] 71 | 72 | skipTests :: [Test] 73 | skipTests = 74 | [ testCase "empty is skipped" (skipped "") 75 | , testCase "newlines are skipped" (skipped "\n\n\n") 76 | , testProperty "skip all whitespace" skipAllSpace 77 | , testProperty "never skip non-whitespace" dontSkipNonSpace 78 | ] 79 | where 80 | skipped = actionParses I.Skip 81 | 82 | -- | Test Helpers 83 | codeParses :: Maybe I.DefName -> String -> HUnit.Assertion 84 | codeParses name src = 85 | actionParses (I.Code (name, trimSpace src)) src 86 | where 87 | trimSpace = dropWhile Char.isSpace 88 | 89 | actionParses :: I.Input -> String -> HUnit.Assertion 90 | actionParses input rawString = 91 | input @=? Parse.rawInput rawString 92 | 93 | badCommandHelp :: Property 94 | badCommandHelp = 95 | forAll nonFlags helpParses 96 | where 97 | nonFlags = 98 | oneof 99 | [ arbitrary `suchThat` notFlag 100 | , badFlag 101 | ] 102 | 103 | helpParses s = 104 | case Parse.rawInput (':':s) of 105 | I.Meta (I.Help (Just _)) -> True 106 | _ -> False 107 | 108 | -- | TODO: things like help3 109 | notFlag s = 110 | not $ any (s `List.isPrefixOf`) flags 111 | 112 | badFlag = 113 | do flag <- elements flags 114 | c <- arbitrary `suchThat` (not . Char.isSpace) 115 | return $ flag ++ [c] 116 | 117 | flags = 118 | [ "help", "reset", "flags", "exit" ] 119 | 120 | skipAllSpace :: Property 121 | skipAllSpace = 122 | forAll spaces $ (==I.Skip) . Parse.rawInput 123 | where 124 | spaces = 125 | listOf . elements $ filter Char.isSpace [toEnum 0..] 126 | 127 | dontSkipNonSpace :: Property 128 | dontSkipNonSpace = 129 | forAll notAllSpace $ (/= I.Skip) . Parse.rawInput 130 | where 131 | notAllSpace = 132 | arbitrary `suchThat` (not . all Char.isSpace) 133 | --------------------------------------------------------------------------------