elm-repl (empty) → 0.1
raw patch · 6 files changed
+269/−0 lines, 6 filesdep +Elmdep +basedep +bytestringsetup-changed
Dependencies added: Elm, base, bytestring, containers, directory, filepath, haskeline, mtl, process, transformers
Files
- Environment.hs +68/−0
- Evaluator.hs +88/−0
- LICENSE +30/−0
- Repl.hs +39/−0
- Setup.hs +2/−0
- elm-repl.cabal +42/−0
+ Environment.hs view
@@ -0,0 +1,68 @@+{-# LANGUAGE OverloadedStrings #-}+module Environment where++import qualified Data.ByteString.Char8 as BS+import Data.Char+import Data.List+import qualified Data.Map as Map++data Repl = Repl+ { 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++output :: BS.ByteString+output = "deltron3030"++toElm :: Repl -> String+toElm env = unlines $ "module Repl where" : decls+ where decls = concatMap Map.elems [ imports env, adts env, defs env ]++insert :: String -> Repl -> Repl+insert str env+ | "import " `isPrefixOf` 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 =+ let name = takeWhile (/=' ') (drop 5 str)+ in noDisplay $ env { adts = Map.insert name str (adts env) }+ + | otherwise =+ case break (=='=') str of+ (_,"") -> display str env+ (beforeEquals, _:c:_)+ | isSymbol c || hasLet beforeEquals -> display str env+ | otherwise -> let name = declName beforeEquals+ in define name str (display name env)+ _ -> error "Environment.hs: Case error. Submit bug report."+ where+ declName pattern =+ case takeWhile isSymbol . dropWhile (not . isSymbol) $ pattern of+ "" -> takeWhile (/=' ') pattern+ op -> op++ hasLet = elem "let" . map token . words+ where+ isVarChar c = isAlpha c || isDigit c || elem c "_'"+ token = takeWhile isVarChar . dropWhile (not . isAlpha)++define :: String -> String -> Repl -> Repl+define name body env = env { defs = Map.insert name body (defs env) }++display :: String -> Repl -> Repl+display = define output' . format+ where format body = output' ++ " =" ++ concatMap ("\n "++) (lines body)+ output' = BS.unpack output++noDisplay :: Repl -> Repl+noDisplay env = env { defs = Map.delete output' (defs env) }+ where output' = BS.unpack output
+ Evaluator.hs view
@@ -0,0 +1,88 @@+{-# LANGUAGE OverloadedStrings #-}+module Evaluator where++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 System.IO.Error (isDoesNotExistError)+import System.Directory (removeFile)+import System.Exit (ExitCode(..))+import System.FilePath ((</>), replaceExtension)+import System.Process+import Control.Exception+import Control.Monad (unless)++runRepl :: Env.Repl -> IO Bool+runRepl environment =+ do writeFile tempElm (Env.toElm environment)+ result <- run "elm" elmArgs $ \types -> do+ reformatJS tempJS+ run "node" nodeArgs $ \value' ->+ let value = BSC.init value'+ tipe = scrapeOutputType types+ isTooLong = BSC.isInfixOf "\n" value ||+ BSC.isInfixOf "\n" tipe ||+ BSC.length value + BSC.length tipe > 80 + message = BS.concat [ if isTooLong then value' else value, tipe ]+ in unless (BSC.null value') $ BSC.putStrLn message+ removeIfExists tempElm+ return result+ where+ tempElm = "repl-temp-000.elm"+ tempJS = "build" </> replaceExtension tempElm "js"+ + nodeArgs = [tempJS]+ elmArgs = ["--make", "--only-js", "--print-types", tempElm]++ run name args nextComputation =+ let failure message = BSC.putStrLn message >> return False+ 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?" ]+ in+ do (_, stdout, _, handle') <- createProcess (proc name args) { std_out = CreatePipe }+ exitCode <- waitForProcess handle'+ case (exitCode, stdout) of+ (ExitFailure 127, _) -> failure $ BSC.pack missingExe+ (_, Nothing) -> failure "Unknown error!"+ (ExitFailure _, Just out) -> failure =<< BSC.hGetContents out+ (ExitSuccess , Just out) ->+ do nextComputation =<< BS.hGetContents out+ return True++reformatJS :: String -> IO ()+reformatJS tempJS =+ 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+ [ "var context = { inputs:[] };\n"+ , "var repl = Elm.Repl.make(context);\n"+ , "if ('", Env.output, "' in repl)\n"+ , " 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++ 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'++removeIfExists :: FilePath -> IO ()+removeIfExists fileName = removeFile fileName `Control.Exception.catch` handleExists+ where handleExists e+ | isDoesNotExistError e = return ()+ | otherwise = throwIO e
+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Evan Czaplicki++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright+ notice, this list of conditions and the following disclaimer.++ * Redistributions in binary form must reproduce the above+ copyright notice, this list of conditions and the following+ disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of Evan Czaplicki nor the names of other+ contributors may be used to endorse or promote products derived+ from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Repl.hs view
@@ -0,0 +1,39 @@+{-# LANGUAGE OverloadedStrings #-}+module Main where++import Control.Monad.Trans+import System.Console.Haskeline+import qualified Evaluator as Eval+import qualified Environment as Env+import System.Exit++main :: IO ()+main = runInputT defaultSettings $ withInterrupt $ loop Env.empty++loop :: Env.Repl -> InputT IO ()+loop environment@(Env.Repl _ _ _ wasCtrlC) = do+ str' <- handleInterrupt (return Nothing) getInput+ let env = environment {Env.ctrlc = False}+ case str' of+ Nothing -> if wasCtrlC then lift $ exitWith (ExitFailure 130)+ else do + lift $ putStrLn "(Ctrl-C again to exit)"+ loop $ environment {Env.ctrlc = True}+ Just "" -> loop env+ Just str -> do+ let env' = Env.insert str env+ success <- liftIO $ Eval.runRepl env'+ loop (if success then env' else env)++getInput :: InputT IO (Maybe String)+getInput = get "> " ""+ where+ get str old = do+ input <- getInputLine str+ case input of+ Nothing -> return $ Just old+ Just new -> continueWith (old ++ new)++ continueWith str+ | null str || last str /= '\\' = return $ Just str+ | otherwise = get "| " (init str ++ "\n")
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ elm-repl.cabal view
@@ -0,0 +1,42 @@+Name: elm-repl+Version: 0.1+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/evancz/elm-repl#elm-repl++License: BSD3+License-file: LICENSE++Author: Evan Czaplicki+Maintainer: info@elm-lang.org+Copyright: Copyright: (c) 2011-2013 Evan Czaplicki++Category: Tool++Build-type: Simple++Cabal-version: >=1.8++source-repository head+ type: git+ location: git://github.com/evancz/elm-repl.git++Executable elm-repl+ Main-is: Repl.hs+ other-modules: Environment,+ Evaluator++ Build-depends: base >=4.2 && <5,+ bytestring,+ containers >= 0.3,+ directory,+ Elm >= 0.10,+ filepath,+ haskeline,+ transformers >= 0.2,+ mtl >= 2,+ process