elm-repl 0.2.2.1 → 0.3
raw patch · 19 files changed
+789/−567 lines, 19 filesdep −containersdep −transformersdep ~Elmdep ~bytestringdep ~bytestring-trie
Dependencies removed: containers, transformers
Dependency ranges changed: Elm, bytestring, bytestring-trie, cmdargs, directory, filepath, haskeline, mtl, parsec, process
Files
- LICENSE +1/−1
- elm-repl.cabal +29/−33
- src/Action.hs +0/−24
- src/Command.hs +0/−87
- src/Completion.hs +47/−26
- src/Environment.hs +60/−26
- src/Eval/Code.hs +155/−0
- src/Eval/Command.hs +22/−0
- src/Eval/Input.hs +27/−0
- src/Eval/Meta.hs +92/−0
- src/Evaluator.hs +0/−104
- src/Flags.hs +24/−9
- src/Input.hs +25/−0
- src/Loop.hs +51/−0
- src/Main.hs +53/−44
- src/Monad.hs +0/−16
- src/Parse.hs +104/−70
- src/Repl.hs +0/−56
- tests/Main.hs +99/−71
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2013, Evan Czaplicki+Copyright (c) 2013-2014, Evan Czaplicki All rights reserved.
elm-repl.cabal view
@@ -1,5 +1,5 @@ Name: elm-repl-Version: 0.2.2.1+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@@ -29,30 +29,28 @@ ghc-options: -W Hs-Source-Dirs: src Main-is: Main.hs- other-modules: Action,- Command,- Completion,+ other-modules: Completion, Environment,- Evaluator,+ Eval.Code,+ Eval.Command,+ Eval.Input,+ Eval.Meta, Flags,- Monad,- Parse,- Repl+ Input,+ Loop,+ Parse Build-depends: base >=4.2 && <5,- bytestring,- bytestring-trie,- cmdargs,- containers >= 0.3,- directory,- Elm >= 0.12,- filepath,- haskeline,- mtl >= 2,- parsec >= 3.0,- process,- transformers >= 0.2-+ 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 Test-Suite test Type: exitcode-stdio-1.0@@ -65,15 +63,13 @@ HUnit, QuickCheck, base >=4.2 && <5,- bytestring,- bytestring-trie,- cmdargs,- containers >= 0.3,- directory,- Elm >= 0.10.1,- filepath,- haskeline,- mtl >= 2,- parsec >= 3.0,- process,- transformers >= 0.2+ 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
− src/Action.hs
@@ -1,24 +0,0 @@-module Action where--data Action = Command Command- | Code Term- | Skip- deriving (Show, Eq)--data Command = AddFlag String- | RemoveFlag String- | ListFlags- | ClearFlags- -- Just if this was triggered by an error- | InfoFlags (Maybe String)- | Help (Maybe String)- | Exit- | Reset- deriving (Show, Eq)--type Term = (String, Maybe Def)--data Def = VarDef String- | DataDef String- | Import String- deriving (Show, Eq)
− src/Command.hs
@@ -1,87 +0,0 @@-module Command where--import Control.Monad.Trans (liftIO)-import Control.Monad.State (get, modify)-import System.Exit (ExitCode(ExitSuccess))--import qualified Data.List as List--import Action (Command(..))-import qualified Environment as Env-import Monad (ReplM)--run :: Command -> ReplM (Maybe ExitCode)-run cmd =- case cmd of- Exit -> return (Just ExitSuccess)-- Help m ->- do displayErr "Bad command\n" m- display helpInfo-- InfoFlags m ->- do displayErr "Bad flag\n" m- display flagsInfo-- ListFlags ->- display . unlines . Env.flags =<< get-- 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 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-xor False = id--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/elm-lang/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"
src/Completion.hs view
@@ -1,35 +1,56 @@-module Completion (complete)- where+{-# LANGUAGE OverloadedStrings #-}+module Completion (complete) where -import Data.Functor ((<$>))-import Data.Trie (Trie) import Control.Monad.State (get)-import System.Console.Haskeline.Completion- import qualified Data.ByteString.Char8 as BS-import qualified Data.Trie as Trie--import Monad (ReplM)+import qualified Data.Trie as Trie+import System.Console.Haskeline.Completion (Completion(Completion), CompletionFunc, completeWord) import qualified Environment as Env+import qualified Eval.Command as Eval -complete, completeIdentifier :: CompletionFunc ReplM-complete = completeQuotedWord Nothing "\"\'" (const $ return [] ) completeIdentifier-completeIdentifier = completeWord Nothing " \t" lookupCompletions -lookupCompletions :: String -> ReplM [Completion]-lookupCompletions s = completions s . removeReserveds . Env.defs <$> get- where removeReserveds = Trie.delete Env.firstVar . Trie.delete Env.lastVar+complete :: CompletionFunc Eval.Command+complete =+ completeWord Nothing " \t" lookupCompletions -completions :: String -> Trie a -> [Completion]-completions s = Trie.lookupBy go (BS.pack s)- where go :: Maybe a -> Trie a -> [Completion]- go isElem suffixesTrie = maybeCurrent ++ suffixCompletions- where maybeCurrent = case isElem of- Nothing -> []- Just _ -> [current]- current = Completion s s True - suffixCompletions = map (suffixCompletion . BS.unpack) . Trie.keys $ suffixesTrie- suffixCompletion suf = Completion full full False- where full = s ++ suf+lookupCompletions :: String -> Eval.Command [Completion]+lookupCompletions string =+ do env <- get+ let defs = adjustDefs (Env.defs env)+ return (completions string defs)+ where+ adjustDefs defs =+ Trie.unionL cmds $+ Trie.delete Env.firstVar $+ Trie.delete Env.lastVar defs++ cmds =+ Trie.fromList+ [ (":exit", "")+ , (":reset", "")+ , (":help", "")+ , (":flags", "")+ ]+++completions :: String -> Trie.Trie a -> [Completion]+completions string =+ Trie.lookupBy go (BS.pack string)+ where+ go :: Maybe a -> Trie.Trie a -> [Completion]+ go isElem suffixesTrie =+ maybeCurrent ++ suffixCompletions+ where+ maybeCurrent =+ case isElem of+ Nothing -> []+ Just _ -> [ Completion string string True ]++ suffixCompletions =+ map (suffixCompletion . BS.unpack) (Trie.keys suffixesTrie)++ suffixCompletion suffix =+ let full = string ++ suffix in+ Completion full full False
src/Environment.hs view
@@ -2,49 +2,83 @@ module Environment where import Data.ByteString (ByteString)-import Data.Monoid ((<>)) import qualified Data.ByteString.Char8 as BS--- | TODO: Switch to a Char-based trie.-import Data.Trie (Trie)-import qualified Data.Trie as Trie+import Data.Monoid ((<>))+import Data.Trie (Trie) -- TODO: Switch to a Char-based trie.+import qualified Data.Trie as Trie -import Action (Term, Def(..))+import qualified Input -data Repl = Repl- { compilerPath :: FilePath++data Env = Env+ { compilerPath :: FilePath+ , interpreterPath :: FilePath , flags :: [String] , imports :: Trie String , adts :: Trie String , defs :: Trie String } deriving Show -empty :: FilePath -> Repl-empty compilerPath =- Repl compilerPath [] Trie.empty Trie.empty (Trie.singleton firstVar (BS.unpack firstVar <> " = ()")) +empty :: FilePath -> FilePath -> Env+empty compiler interpreter =+ Env compiler+ interpreter+ []+ Trie.empty+ Trie.empty+ (Trie.singleton firstVar (BS.unpack firstVar <> " = ()"))++ firstVar :: ByteString firstVar = "tsol" + lastVar :: ByteString lastVar = "deltron3030" -toElm :: Repl -> String-toElm env = unlines $ "module Repl where" : decls- where decls = concatMap Trie.elems [ imports env, adts env, defs env ] -insert :: Term -> Repl -> Repl-insert (src, def) env = case def of- Nothing -> display src env- Just (Import mport) -> noDisplay $ env { imports = Trie.insert (BS.pack mport) src (imports env) }- Just (DataDef def) -> noDisplay $ env { adts = Trie.insert (BS.pack def) src (adts env) }- Just (VarDef var) -> define (BS.pack var) src . display var $ env+toElmCode :: Env -> String+toElmCode env =+ unlines $ "module Repl where" : decls+ where+ decls =+ concatMap Trie.elems [ imports env, adts env, defs env ] -define :: ByteString -> String -> Repl -> Repl-define name body env = env { defs = Trie.insert name body (defs env) } -display :: String -> Repl -> Repl-display = define lastVar . format- where format body = (BS.unpack lastVar) ++ " =" ++ concatMap ("\n "++) (lines body)+insert :: (Maybe Input.DefName, String) -> Env -> Env+insert (maybeName, src) env =+ case maybeName of+ Nothing ->+ display src env -noDisplay :: Repl -> Repl-noDisplay env = env { defs = Trie.delete lastVar (defs env) }+ Just (Input.Import name) ->+ noDisplay $ env+ { imports = Trie.insert (BS.pack name) src (imports env)+ }++ Just (Input.DataDef name) ->+ noDisplay $ env+ { adts = Trie.insert (BS.pack name) src (adts env)+ }++ Just (Input.VarDef name) ->+ define (BS.pack name) src (display name env)+++define :: ByteString -> String -> Env -> Env+define name body env =+ env { defs = Trie.insert name body (defs env) }+++display :: String -> Env -> Env+display body env =+ define lastVar (format body) env+ where+ format body =+ BS.unpack lastVar ++ " =" ++ concatMap ("\n "++) (lines body)+++noDisplay :: Env -> Env+noDisplay env =+ env { defs = Trie.delete lastVar (defs env) }
+ src/Eval/Code.hs view
@@ -0,0 +1,155 @@+{-# LANGUAGE OverloadedStrings #-}+module Eval.Code (eval) where++import Control.Monad.Cont (ContT(ContT, runContT))+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 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 qualified Environment as Env+import qualified Eval.Command as Eval+import qualified Input+++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+ value <- runCmd (Env.interpreterPath env) [tempJsPath]+ liftIO $ printIfNeeded value (scrapeOutputType types)+ liftIO $ removeIfExists tempElmPath+ return ()+ where+ runConts m = runContT m (\_ -> return ())+ + tempElmPath =+ "repl-temp-000" <.> "elm"++ tempJsPath =+ "build" </> replaceExtension tempElmPath "js"+ + elmArgs =+ [ "--make"+ , "--only-js"+ , "--print-types"+ , tempElmPath+ ]++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++ isTooLong =+ BSC.isInfixOf "\n" value+ || BSC.isInfixOf "\n" tipe+ || BSC.length value + BSC.length tipe > 80++ message =+ BS.concat+ [ if isTooLong then rawValue else value+ , tipe+ ]+++runCmd :: FilePath -> [String] -> ContT () IO BS.ByteString+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++ 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 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, "));"+ ]+++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)++ 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++ 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)++ errorMessage =+ "Internal error in elm-repl function scrapeOutputType\n\+ \Please report this bug to <https://github.com/elm-lang/elm-repl/issues>"+++removeIfExists :: FilePath -> IO ()+removeIfExists fileName =+ do exists <- doesFileExist fileName+ if exists+ then removeFile fileName+ else return ()
+ src/Eval/Command.hs view
@@ -0,0 +1,22 @@+module Eval.Command (Command, run) where++import Control.Monad.RWS (RWST, runRWST)+import qualified Environment as Env+import qualified Flags++{-| The evaluation Command handles the details of running the REPL. It uses+the Reader/Writer/State monad to keep track of some important details:++ * Reader: initial configuration+ * Writer: nothing+ * State: current environment++-}+type Command =+ RWST Flags.Flags () Env.Env IO+++run :: Flags.Flags -> Env.Env -> Command a -> IO a+run flags env command =+ do (x,_,_) <- runRWST command flags env+ return x
+ src/Eval/Input.hs view
@@ -0,0 +1,27 @@+module Eval.Input (eval) where++import Control.Monad.Trans (liftIO)+import System.Console.Haskeline (handleInterrupt)+import qualified System.Exit as Exit++import qualified Eval.Code as Code+import qualified Eval.Command as Eval+import qualified Eval.Meta as Meta+import qualified Input+++eval :: Input.Input -> Eval.Command (Maybe Exit.ExitCode)+eval action =+ case action of+ Input.Meta cmd ->+ Meta.eval cmd++ Input.Skip ->+ return Nothing++ Input.Code code ->+ do handleInterrupt interruptedMsg (Code.eval code)+ return Nothing+ where+ interruptedMsg =+ liftIO $ putStrLn " Computation interrupted, any definitions were not completed."
+ src/Eval/Meta.hs view
@@ -0,0 +1,92 @@+module Eval.Meta (eval) where++import Control.Monad.State (get, modify)+import Control.Monad.Trans (liftIO)+import qualified Data.List as List+import System.Exit (ExitCode(ExitSuccess))++import qualified Environment as Env+import qualified Eval.Command as Eval+import qualified Input as Cmd++eval :: Cmd.Command -> Eval.Command (Maybe ExitCode)+eval cmd =+ case cmd of+ Cmd.Exit ->+ return (Just ExitSuccess)++ Cmd.Help m ->+ do displayErr "Bad command\n" m+ display helpInfo++ Cmd.InfoFlags m ->+ do displayErr "Bad flag\n" m+ display flagsInfo++ Cmd.ListFlags ->+ display . unlines . Env.flags =<< get++ Cmd.AddFlag flag ->+ modifyIfPresent True flag "Added " "Flag already added!" $ \env ->+ env { Env.flags = Env.flags env ++ [flag] }++ Cmd.RemoveFlag flag ->+ modifyIfPresent False flag "Removed flag " "No such flag." $ \env ->+ env {Env.flags = List.delete flag $ Env.flags env}++ Cmd.Reset ->+ modifyAlways "Environment Reset" $ \env ->+ Env.empty (Env.compilerPath env) (Env.interpreterPath env)++ Cmd.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 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 boolean boolean' =+ boolean /= boolean'+++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/elm-lang/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"
− src/Evaluator.hs
@@ -1,104 +0,0 @@-{-# 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 Elm.Internal.Paths as Elm-import qualified Environment as Env--import Control.Applicative ((<$>), (<*>))-import Control.Monad (unless)-import Control.Monad.RWS (get, modify, MonadState)-import Control.Monad.Trans (liftIO)-import System.Directory (doesFileExist, removeFile)-import System.Exit (ExitCode(..))-import System.FilePath ((</>), replaceExtension)-import System.IO-import System.Process--import Monad-import Action--evalPrint :: Term -> ReplM ()-evalPrint term =- do modify $ Env.insert term - env <- get- liftIO $ writeFile tempElm $ Env.toElm env- let elmArgs = Env.flags env ++ ["--make", "--only-js", "--print-types", tempElm]- liftIO . runCmdWithCallback (Env.compilerPath env) elmArgs $ \types -> do- reformatJS tempJS- runCmdWithCallback "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.hPutStrLn stdout message- liftIO $ removeIfExists tempElm- return ()- where-- tempElm = "repl-temp-000.elm"- tempJS = "build" </> replaceExtension tempElm "js"- - nodeArgs = [tempJS]--runCmdWithCallback :: FilePath -> [String] -> (BS.ByteString -> IO ()) -> IO ()-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 =- 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.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"- , "if ('", Env.lastVar, "' in repl)\n"- , " console.log(context.Native.Show.values.show(repl.", Env.lastVar, "));" ]--scrapeOutputType :: BS.ByteString -> BS.ByteString-scrapeOutputType = dropName . squashSpace . takeType . dropWhile (not . isOut) . BSC.lines- where isOut = (||) <$> (BS.isPrefixOf Env.lastVar) <*> (BS.isPrefixOf (BS.append "Repl." Env.lastVar))- dropName = BSC.cons ' ' . BSC.dropWhile (/= ':')- takeType (n:rest) = n : takeWhile isMoreType rest- takeType [] = error "Internal error in elm-repl (takeType): Please report this bug to https://github.com/elm-lang/elm-repl/issues/"- isMoreType = (&&) <$> not . BS.null <*> (Char.isSpace . BSC.head)- squashSpace = BSC.unwords . BSC.words . BSC.unwords--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 = do- exists <- doesFileExist fileName- if exists- then removeFile fileName- else return ()
src/Flags.hs view
@@ -1,22 +1,37 @@ {-# LANGUAGE DeriveDataTypeable #-} module Flags where -import System.Console.CmdArgs import Data.Version (showVersion) import qualified Paths_elm_repl as This+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" &= 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/elm-lang/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")+ { compiler = "elm"+ &= typFile+ &= help "Provide a path to a specific Elm compiler."+ , interpreter = "node" + &= typFile+ &= help "Provide a path to a specific JavaScript interpreter (e.g. node, nodejs, ...)."+ }+ &= help helpMessage++ &= helpArg [explicit, name "help", name "h"]++ &= versionArg [explicit, name "version", name "v", summary version]++ &= summary ("Elm REPL " ++ version ++ ", (c) Evan Czaplicki 2011-2014")++helpMessage :: String+helpMessage =+ "Read-eval-print-loop (REPL) for digging deep into Elm projects.\n\+ \More info at <https://github.com/elm-lang/elm-repl#elm-repl>"
+ src/Input.hs view
@@ -0,0 +1,25 @@+module Input where++data Input+ = Meta Command+ | Code (Maybe DefName, String)+ | Skip+ deriving (Show, Eq)++data Command+ = AddFlag String+ | RemoveFlag String+ | ListFlags+ | ClearFlags+ -- Just if this was triggered by an error+ | InfoFlags (Maybe String)+ | Help (Maybe String)+ | Exit+ | Reset+ deriving (Show, Eq)++data DefName+ = VarDef String+ | DataDef String+ | Import String+ deriving (Show, Eq)
+ src/Loop.hs view
@@ -0,0 +1,51 @@+module Loop (loop) where++import Control.Monad.Trans (lift)+import System.Console.Haskeline (InputT, MonadException, Settings, getInputLine,+ handleInterrupt, runInputT, withInterrupt)+import System.Exit (ExitCode(ExitSuccess))++import qualified Environment as Env+import qualified Eval.Input as Input+import qualified Eval.Command as Command+import qualified Flags+import qualified Parse+++loop :: Flags.Flags -> Settings Command.Command -> IO ExitCode+loop flags settings =+ Command.run flags initialEnv $ runInputT settings (withInterrupt acceptInput)+ where+ initialEnv =+ Env.empty (Flags.compiler flags) (Flags.interpreter flags)+++acceptInput :: InputT Command.Command ExitCode+acceptInput =+ do rawInput <- handleInterrupt (return (Just "")) getInput+ case rawInput of+ Nothing ->+ return ExitSuccess++ Just userInput ->+ do let input = Parse.rawInput userInput+ result <- lift (Input.eval input)+ case result of+ Just exit -> return exit+ Nothing -> acceptInput+++getInput :: (MonadException m) => InputT m (Maybe String)+getInput =+ go "> " ""+ where+ go lineStart inputSoFar =+ do input <- getInputLine lineStart+ case input of+ Nothing -> return Nothing+ Just new -> continueWith (inputSoFar ++ new)++ continueWith inputSoFar =+ if null inputSoFar || last inputSoFar /= '\\'+ then return (Just inputSoFar)+ else go "| " (init inputSoFar ++ "\n")
src/Main.hs view
@@ -1,67 +1,76 @@ module Main where -import Control.Monad-import System.Console.Haskeline hiding (handle)-import System.Directory+import Control.Monad (unless, when)+import qualified System.Console.CmdArgs as CmdArgs+import System.Console.Haskeline (Settings(Settings, autoAddHistory, complete,+ historyFile))+import qualified System.Directory as Dir 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 Eval.Command as Eval import qualified Flags+import qualified Loop + 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+main =+ do flags <- CmdArgs.cmdArgs Flags.flags+ buildExisted <- Dir.doesDirectoryExist "build"+ cacheExisted <- Dir.doesDirectoryExist "cache"+ settings <- mkSettings+ putStrLn welcomeMessage+ exitCode <- ifJsInterpExists flags (Loop.loop 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\+ "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- }+getDataDir :: IO FilePath+getDataDir =+ do root <- Dir.getAppUserDataDirectory "elm"+ let dir = root </> "repl"+ Dir.createDirectoryIfMissing True dir+ return dir -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)++mkSettings :: IO (Settings Eval.Command)+mkSettings =+ do dataDir <- getDataDir+ return $ Settings+ { historyFile = Just (dataDir </> "history")+ , autoAddHistory = True+ , complete = Completion.complete+ }+++ifJsInterpExists :: Flags.Flags -> IO Exit.ExitCode -> IO Exit.ExitCode+ifJsInterpExists flags doSomeStuff =+ do maybePath <- Dir.findExecutable jsInterp+ case maybePath of+ Just _ -> doSomeStuff+ Nothing ->+ do putStrLn interpNotInstalledMessage+ return (Exit.ExitFailure 1) where- nodeNotInstalledMessage =+ jsInterp = Flags.interpreter flags++ interpNotInstalledMessage = "\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."+ \ You can install node.js from <http://nodejs.org/>. If it is already\n\+ \ installed but has a different name, use the --interpreter flag."+ removeDirectoryRecursiveIfExists :: FilePath -> IO () removeDirectoryRecursiveIfExists path =- do exists <- doesDirectoryExist path- when exists (removeDirectoryRecursive path)+ do exists <- Dir.doesDirectoryExist path+ when exists (Dir.removeDirectoryRecursive path)
− src/Monad.hs
@@ -1,16 +0,0 @@-module Monad (ReplM, runReplM)- where--import Data.Functor ((<$>))-import Control.Monad.RWS--import Flags (Flags)-import qualified Environment as Env---- Reader: Build Flags--- State: Current Environment-type ReplT = RWST Flags () Env.Repl-type ReplM = ReplT IO--runReplM :: Flags -> Env.Repl -> ReplM a -> IO a-runReplM fs repl m = (\(x,_,_) -> x) <$> runRWST m fs repl
src/Parse.hs view
@@ -1,96 +1,130 @@-module Parse where--import Data.Functor ((<$), (<$>))-import Text.Parsec+module Parse (rawInput) where import qualified Data.Char as Char+import Data.Functor ((<$>)) import qualified Data.List as List+import Text.Parsec (Parsec, (<|>), anyChar, char, choice, eof, many, many1,+ manyTill, parse, satisfy, space, spaces, string) -import Action+import qualified Input + type Parser = Parsec String () -input :: String -> Action-input inp = case parse result "" inp of- Left err -> Command . Help . Just . show $ err- Right act -> act -result :: Parser Action-result = do- spaces- skip <|> cmd <|> term+rawInput :: String -> Input.Input+rawInput input =+ case parse result "" input of+ Right action -> action+ Left errorMessage ->+ Input.Meta . Input.Help $ Just (show errorMessage)+++result :: Parser Input.Input+result =+ do spaces+ skip <|> cmd <|> term where- skip = Skip <$ eof- cmd = char ':' >> Command <$> command- term = Code . mkTerm <$> many anyChar+ skip = eof >> return Input.Skip+ cmd = char ':' >> Input.Meta <$> command+ term = Input.Code . extractCode <$> many anyChar -command :: Parser Command-command = do- flag <- many1 notSpace- spaces- case flag of- "exit" -> basicCommand Exit- "reset" -> basicCommand Reset- "help" -> basicCommand $ Help Nothing- "flags" -> basicCommand (InfoFlags Nothing) <|> flags- _ -> return $ Help . Just $ flag- where basicCommand cmd = cmd <$ eof -flags :: Parser Command-flags = do- flag <- many1 notSpace- case flag of- "add" -> srcDirFlag AddFlag- "remove" -> srcDirFlag RemoveFlag- "list" -> return ListFlags- "clear" -> return ClearFlags- _ -> return $ InfoFlags . Just $ flag- where srcDirFlag ctor = do- many1 space+command :: Parser Input.Command+command =+ do flag <- many1 notSpace+ spaces+ case flag of+ "exit" -> basicCommand Input.Exit+ "reset" -> basicCommand Input.Reset+ "help" -> basicCommand (Input.Help Nothing)+ "flags" -> basicCommand (Input.InfoFlags Nothing) <|> flags+ _ -> return $ Input.Help (Just flag)+ where+ basicCommand cmd =+ eof >> return cmd+++flags :: Parser Input.Command+flags =+ do flag <- many1 notSpace+ case flag of+ "add" -> srcDirFlag Input.AddFlag+ "remove" -> srcDirFlag Input.RemoveFlag+ "list" -> return Input.ListFlags+ "clear" -> return Input.ClearFlags+ _ -> return $ Input.InfoFlags . Just $ flag+ where+ srcDirFlag ctor =+ do many1 space ctor <$> srcDir + notSpace :: Parser Char-notSpace = satisfy $ not . Char.isSpace+notSpace =+ satisfy (not . Char.isSpace) + srcDir :: Parser String-srcDir = do- string "--src-dir="- dir <- manyTill anyChar (choice [ space >> return (), eof ])- return $ "--src-dir=" ++ dir+srcDir =+ do string "--src-dir="+ dir <- manyTill anyChar (choice [ space >> return (), eof ])+ return ("--src-dir=" ++ dir) -mkTerm :: String -> Term-mkTerm src = (src, mkCode src) -mkCode :: String -> Maybe Def-mkCode src- | List.isPrefixOf "import " src = - let name = getFirstCap . words $ src- getFirstCap (tok@(c:_):rest) = if Char.isUpper c- then tok- else getFirstCap rest- getFirstCap _ = src- in Just $ Import name+extractCode :: String -> (Maybe Input.DefName, String)+extractCode rawInput =+ (extractDefName rawInput, rawInput) - | List.isPrefixOf "data " src =- let name = takeWhile (/=' ') . drop 5 $ src- in Just $ DataDef name - | otherwise = case break (=='=') src of- (_,"") -> Nothing- (beforeEquals, _:c:_)- | Char.isSymbol c || hasLet beforeEquals || hasBrace beforeEquals ->- Nothing- | otherwise -> Just . VarDef $ declName beforeEquals- _ -> error "Parse.hs: Case error. Please submit bug report to https://github.com/elm-lang/elm-repl/issues."+extractDefName :: String -> Maybe Input.DefName+extractDefName src+ | List.isPrefixOf "import " src =+ let getFirstCap tokens =+ case tokens of+ token@(c:_) : rest ->+ if Char.isUpper c then token else getFirstCap rest+ _ -> src+ in+ Just $ Input.Import (getFirstCap (words src))++ | List.isPrefixOf "data " src =+ let name = takeWhile (/=' ') . drop 5 $ src+ in Just $ Input.DataDef name++ | otherwise =+ case break (=='=') src of+ (_,"") -> Nothing++ (beforeEquals, _:c:_) ->+ if Char.isSymbol c || hasLet beforeEquals || hasBrace beforeEquals+ then Nothing+ else Just $ Input.VarDef (declName beforeEquals)++ _ -> error errorMessage+ where+ errorMessage =+ "Internal error in elm-repl function Parse.mkCode\n\+ \Please submit bug report to <https://github.com/elm-lang/elm-repl/issues>"+ declName pattern =- case takeWhile Char.isSymbol . dropWhile (not . Char.isSymbol) $ pattern of+ case takeWhile Char.isSymbol $ dropWhile (not . Char.isSymbol) pattern of "" -> takeWhile (/=' ') pattern op -> op - hasLet = elem "let" . map token . words- where- isVarChar c = Char.isAlpha c || Char.isDigit c || elem c "_'"- token = takeWhile isVarChar . dropWhile (not . Char.isAlpha) - hasBrace = elem '{'+hasLet :: String -> Bool+hasLet body =+ elem "let" $ map token (words body)+ where+ isVarChar c =+ Char.isAlpha c || Char.isDigit c || elem c "_'"++ token word =+ takeWhile isVarChar $ dropWhile (not . Char.isAlpha) word+++hasBrace :: String -> Bool+hasBrace body =+ elem '{' body
− src/Repl.hs
@@ -1,56 +0,0 @@-module Repl (run) where--import Control.Monad.Trans-import System.Console.Haskeline hiding (handle)-import System.Exit--import Monad--import qualified Action as Act-import qualified Command as Cmd-import qualified Evaluator as Eval-import qualified Environment as Env-import qualified Flags-import qualified Parse--run :: Flags.Flags -> Settings ReplM -> IO ExitCode-run flags settings =- runReplM flags initialEnv . runInputT settings $ withInterrupt repl- where- initialEnv = Env.empty (Flags.compiler flags)--repl :: InputT ReplM ExitCode-repl = do- str' <- handleInterrupt (return $ Just "") getInput- case str' of- Nothing -> return ExitSuccess- Just str -> do- let action = Parse.input str- result <- lift $ handle action- case result of- Just exit -> return exit- Nothing -> repl--handle :: Act.Action -> ReplM (Maybe ExitCode)-handle action =- case action of- Act.Command cmd -> Cmd.run cmd-- Act.Skip -> return Nothing-- Act.Code src ->- do Eval.evalPrint src- 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")
tests/Main.hs view
@@ -3,102 +3,130 @@ import qualified Data.Char as Char import qualified Data.List as List import Data.Maybe (isJust)-import Test.Framework+import Test.Framework (Test, defaultMain, testGroup) import Test.Framework.Providers.HUnit (testCase) import Test.Framework.Providers.QuickCheck2 (testProperty) import Test.HUnit ((@=?)) import qualified Test.HUnit.Base as HUnit import Test.QuickCheck -import Action+import qualified Input as I import qualified Parse main :: IO () main = defaultMain tests tests :: [Test]-tests = [ testGroup "Parse tests" [- testGroup "Command parse tests" cmdParseTests- , testGroup "Code parse tests" codeParseTests- , testGroup "Whitespace parse tests" skipTests- ]+tests =+ [ testGroup "Parse tests"+ [ testGroup "Command parse tests" cmdParseTests+ , testGroup "Code parse tests" codeParseTests+ , testGroup "Whitespace parse tests" skipTests ]+ ] -cmdParseTests = [- testGroup "Good commands tests" [- testCase ":help parses" $ cmdParses (Help Nothing) ":help"- , testCase ":reset parses after whitespace" $ cmdParses Reset " :reset"- , testCase ":exit parses before whitespace" $ cmdParses Exit ":exit "- ]- , testGroup ":flags parse tests" [- testCase ":flags parses with Info" $ cmdParses (InfoFlags Nothing) ":flags"- , testCase ":flags + space parses with Info" $ cmdParses (InfoFlags Nothing) ":flags "- , testCase ":flags list parses" $ cmdParses ListFlags ":flags list"- , testCase ":flags clear parses w/ whitespace between" $- cmdParses ClearFlags ":flags clear"- , testCase ":flags add source parses" $- cmdParses (AddFlag "--src-dir=\"\"") ":flags add --src-dir=\"\""- , testCase ":flags remove source parses" $- cmdParses (RemoveFlag "--src-dir=bleh") ":flags remove --src-dir=bleh"- ]+cmdParseTests :: [Test]+cmdParseTests =+ [ testGroup "Good commands tests"+ [ testCase ":help parses" $ cmdParses (I.Help Nothing) ":help"+ , testCase ":reset parses after whitespace" $ cmdParses I.Reset " :reset"+ , testCase ":exit parses before whitespace" $ cmdParses I.Exit ":exit "+ ]+ , testGroup ":flags parse tests"+ [ testCase ":flags parses with Info" $ cmdParses (I.InfoFlags Nothing) ":flags"+ , testCase ":flags + space parses with Info" $ cmdParses (I.InfoFlags Nothing) ":flags "+ , testCase ":flags list parses" $ cmdParses I.ListFlags ":flags list"+ , testCase ":flags clear parses w/ whitespace between" $+ cmdParses I.ClearFlags ":flags clear"+ , testCase ":flags add source parses" $+ cmdParses (I.AddFlag "--src-dir=\"\"") ":flags add --src-dir=\"\""+ , testCase ":flags remove source parses" $+ cmdParses (I.RemoveFlag "--src-dir=bleh") ":flags remove --src-dir=bleh"+ ]+ , testGroup "Bad commands tests"+ [ testCase ":flagsgrbl triggers help" $ helpErr ":flagsg"+ , testProperty "bad :commands trigger help" badCommandHelp+ ]+ ]+ where+ cmdParses cmd = actionParses (I.Meta cmd)+ helpErr cmd =+ case Parse.rawInput cmd of+ I.Meta (I.Help message) ->+ HUnit.assert (isJust message)+ action ->+ HUnit.assertFailure (errorMessage action) - , testGroup "Bad commands tests" [- testCase ":flagsgrbl triggers help" $ helpErr ":flagsg"- , testProperty "bad :commands trigger help" badCommandHelp- ]- ]- where cmdParses cmd = actionParses (Action.Command cmd)- helpErr cmd = case Parse.input cmd of- Action.Command (Help m) -> HUnit.assert $ isJust m- res ->- HUnit.assertFailure- ("Should display help with an error message, instead got: "- ++ show res)+ errorMessage action =+ "Should display help with an error message, instead got: " ++ show action -codeParseTests = [- testCase "number parses" $ codeParses Nothing "3"- , testCase "number parses after newlines" $ codeParses Nothing "\n\n3"- , testCase "data def parses" $ codeParses (Just $ DataDef "Baz") "data Baz = B { }"- , testCase "var def parses" $ codeParses (Just $ VarDef "x") "x = 3"- , testCase "var fun def parses" $ codeParses (Just $ VarDef "f") "f x = x"- ]+codeParseTests :: [Test]+codeParseTests =+ [ testCase "number parses" $ codeParses Nothing "3"+ , testCase "number parses after newlines" $ codeParses Nothing "\n\n3"+ , testCase "data def parses" $ codeParses (Just $ I.DataDef "Baz") "data Baz = B { }"+ , testCase "var def parses" $ codeParses (Just $ I.VarDef "x") "x = 3"+ , testCase "var fun def parses" $ codeParses (Just $ I.VarDef "f") "f x = x"+ ] -skipTests = [- testCase "empty is skipped" $ skipped ""- , testCase "newlines are skipped" $ skipped "\n\n\n"- , testProperty "skip all whitespace" skipAllSpace- , testProperty "never skip non-whitespace" dontSkipNonSpace- ]- where skipped = actionParses Action.Skip+skipTests :: [Test]+skipTests =+ [ testCase "empty is skipped" (skipped "")+ , testCase "newlines are skipped" (skipped "\n\n\n")+ , testProperty "skip all whitespace" skipAllSpace+ , testProperty "never skip non-whitespace" dontSkipNonSpace+ ]+ where+ skipped = actionParses I.Skip -- | Test Helpers-codeParses :: Maybe Def -> String -> HUnit.Assertion-codeParses code src = actionParses (Action.Code (trimSpace src, code)) src- where trimSpace = dropWhile Char.isSpace+codeParses :: Maybe I.DefName -> String -> HUnit.Assertion+codeParses name src =+ actionParses (I.Code (name, trimSpace src)) src+ where+ trimSpace = dropWhile Char.isSpace -actionParses :: Action.Action -> String -> HUnit.Assertion-actionParses v s = v @=? Parse.input s+actionParses :: I.Input -> String -> HUnit.Assertion+actionParses input rawString =+ input @=? Parse.rawInput rawString badCommandHelp :: Property-badCommandHelp = forAll nonFlags helpParses- where nonFlags = oneof [ arbitrary `suchThat` notFlag- , badFlag- ]- helpParses s = case Parse.input (':':s) of- Command (Help (Just _)) -> True- _ -> False- -- | TODO: things like help3- notFlag s = not . any (s `List.isPrefixOf`) $ flags- badFlag = do- flag <- elements flags+badCommandHelp =+ forAll nonFlags helpParses+ where+ nonFlags =+ oneof+ [ arbitrary `suchThat` notFlag+ , badFlag+ ]++ helpParses s =+ case Parse.rawInput (':':s) of+ I.Meta (I.Help (Just _)) -> True+ _ -> False++ -- | TODO: things like help3+ notFlag s =+ not $ any (s `List.isPrefixOf`) flags++ badFlag =+ do flag <- elements flags c <- arbitrary `suchThat` (not . Char.isSpace) return $ flag ++ [c]- flags = ["help", "reset", "flags", "exit"] + flags =+ [ "help", "reset", "flags", "exit" ]+ skipAllSpace :: Property-skipAllSpace = forAll spaces $ (==Action.Skip) . Parse.input- where spaces = listOf . elements . filter Char.isSpace $ [toEnum 0..]+skipAllSpace =+ forAll spaces $ (==I.Skip) . Parse.rawInput+ where+ spaces =+ listOf . elements $ filter Char.isSpace [toEnum 0..] dontSkipNonSpace :: Property-dontSkipNonSpace = forAll notAllSpace $ (/= Action.Skip) . Parse.input- where notAllSpace = arbitrary `suchThat` (not . all Char.isSpace)+dontSkipNonSpace =+ forAll notAllSpace $ (/= I.Skip) . Parse.rawInput+ where+ notAllSpace =+ arbitrary `suchThat` (not . all Char.isSpace)