diff options
| -rw-r--r-- | app/Main.hs | 1 | ||||
| -rw-r--r-- | src/Eval.hs | 4 | ||||
| -rw-r--r-- | src/Helper.hs | 23 | ||||
| -rwxr-xr-x | std/test_all.sh | 2 |
4 files changed, 24 insertions, 6 deletions
diff --git a/app/Main.hs b/app/Main.hs index 1e22a4b..7e8d6ec 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -23,6 +23,7 @@ args = Args <$> (mode <|> pure ArgEval) <*> switch (long "yolo" <> short 'y' <> help "Don't run tests") + <*> switch (long "verbose" <> short 'v' <> help "Increase verbosity") <*> strOption (long "target" <> short 't' <> metavar "TARGET" <> value "" <> help "Optimize to target using BLoC and BLoCade" diff --git a/src/Eval.hs b/src/Eval.hs index cc7fdfa..2e9746d 100644 --- a/src/Eval.hs +++ b/src/Eval.hs @@ -279,7 +279,9 @@ evalCommand inp s@(EnvState env@(Environment envDefs) conf cache) = \case Right (Test e1' e2') -> do lhs <- reduce conf e1' rhs <- reduce conf e2' - when (lhs /= rhs) (print $ FailedTest e1 e2 lhs rhs) >> pure s + when (lhs /= rhs) (print $ FailedTest e1 e2 lhs rhs) + when (lhs == rhs && _isVerbose conf) (print $ PassedTest e1 e2) + pure s _ -> pure s | otherwise -> pure s diff --git a/src/Helper.hs b/src/Helper.hs index fbb7dd8..a90ce94 100644 --- a/src/Helper.hs +++ b/src/Helper.hs @@ -45,7 +45,10 @@ printContext (Context inp path) = p $ lines inp errPrefix :: String errPrefix = "\ESC[101m\ESC[30mERROR\ESC[0m " -data Error = SyntaxError String | UndefinedIdentifier Identifier | UnmatchedMixfix [MixfixIdentifierKind] [Mixfix] | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error Context | SuggestSolution Error String | ImportError String | OptimizerError String +okPrefix :: String +okPrefix = "\ESC[102m\ESC[30m OK \ESC[0m " + +data Error = SyntaxError String | UndefinedIdentifier Identifier | UnmatchedMixfix [MixfixIdentifierKind] [Mixfix] | InvalidIndex Int | FailedTest Expression Expression Expression Expression | PassedTest Expression Expression | ContextualError Error Context | SuggestSolution Error String | ImportError String | OptimizerError String instance Show Error where show (ContextualError err ctx) = show err <> "\n" <> printContext ctx @@ -62,6 +65,8 @@ instance Show Error where <> "\n\ESC[105m\ESC[30mnear\ESC[0m " <> unwords (map show ms) show (InvalidIndex err) = errPrefix <> "invalid index " <> show err + show (PassedTest exp1 exp2) = + okPrefix <> "test passed: " <> show exp1 <> " = " <> show exp2 show (FailedTest exp1 exp2 red1 red2) = errPrefix <> "test failed: " @@ -155,13 +160,20 @@ instance Show Expression where . showString " " . shows exp2 . showString "\ESC[33m)\ESC[0m" + showsPrec _ (MixfixChain [m]) = + showString "\ESC[33m\ESC[0m" . shows m . showString "\ESC[33m\ESC[0m" showsPrec _ (MixfixChain ms) = showString "\ESC[33m(\ESC[0m" . foldr1 (\x y -> x . showString " " . y) (map shows ms) . showString "\ESC[33m)\ESC[0m" - showsPrec _ (Prefix p e) = shows p . showString " " . shows e - showsPrec _ (Quote e ) = showString "\ESC[36m`\ESC[0m" . shows e - showsPrec _ (Unquote e ) = showString "\ESC[36m,\ESC[0m" . shows e + showsPrec _ (Prefix p e) = + showString "\ESC[33m(\ESC[0m" + . shows p + . showString " " + . shows e + . showString "\ESC[33m)\ESC[0m" + showsPrec _ (Quote e) = showString "\ESC[36m`\ESC[0m" . shows e + showsPrec _ (Unquote e) = showString "\ESC[36m,\ESC[0m" . shows e data Command = Input String | Watch String | Import String String | Test Expression Expression | ClearState | Time Expression | Length Expression | Blc Expression | Jot String deriving (Show) @@ -174,6 +186,7 @@ data ArgMode = ArgEval | ArgEvalBblc | ArgEvalBlc | ArgDumpBblc | ArgDumpBlc data Args = Args { _argMode :: ArgMode , _argNoTests :: Bool + , _argVerbose :: Bool , _argOptimizeTarget :: String , _argReducer :: String , _argPath :: Maybe String @@ -181,6 +194,7 @@ data Args = Args data EvalConf = EvalConf { _isRepl :: Bool + , _isVerbose :: Bool , _evalTests :: Bool , _nicePath :: String , _path :: String @@ -212,6 +226,7 @@ type EvalState = S.State Environment argsToConf :: Args -> EvalConf argsToConf args = EvalConf { _isRepl = isNothing $ _argPath args + , _isVerbose = _argVerbose args , _evalTests = not $ _argNoTests args , _path = path , _nicePath = path diff --git a/std/test_all.sh b/std/test_all.sh index a5a5c63..c6085df 100755 --- a/std/test_all.sh +++ b/std/test_all.sh @@ -13,7 +13,7 @@ done echo >>All.bruijn echo "main [[0]]" >>All.bruijn -if bruijn All.bruijn | grep "ERROR"; then +if bruijn -v All.bruijn | tee /dev/fd/2 | grep -q "ERROR"; then exit 1 fi |