Use ansi-terminal library instead

app/Main.hs

@@ -15,16 +15,21 @@ import System.IO (IOMode (WriteMode), hClose, hFlush, hPutStrLn, openFile, stdou
 version = "2.2.1"
 
 heading =
-  "\x1b[1;36m\
-  \         _\n\
-  \        | |\n\
-  \    ____| |   ___  __  __\n\
-  \    | _ \\ |__| _ \\|  \\/  |\n\
-  \    |  _/____|____\\_\\__/_| \x1b[32mv"
-    ++ version
-    ++ "\n\
-       \    \x1b[1;36m|_| \x1b[0mpure λ-calculus interpreter\n\
-       \   \x1b[1;36m=================================\n"
+  boldCyan
+    "         _\n\
+    \        | |\n\
+    \    ____| |   ___  __  __\n\
+    \    | _ \\ |__| _ \\|  \\/  |\n\
+    \    |  _/____|____\\_\\__/_| "
+    ++ boldGreen
+      ( "v"
+          ++ version
+          ++ "\n    "
+      )
+    ++ boldCyan "|_| "
+    ++ "pure λ-calculus interpreter\n\
+       \   "
+    ++ boldCyan "=================================\n"
 
 -------------------------------------------------------------------------------------
 
@@ -149,12 +154,12 @@ isplam (c : cs)
 -- MAIN with Read-Evaluate-Print Loop --
 -------------------------------------------------------------------------------------
 repl env = do
-  mline <- getInputLine "\x1b[1;36mpLam>\x1b[0m "
+  mline <- getInputLine $ boldCyan "pLam>" ++ " "
   case mline of
     Nothing -> return ()
     Just line
       | line == ":quit" || line == ":q" -> do
-        outputStrLn "\x1b[1;32mGoodbye!\x1b[0m"
+        outputStrLn $ boldCyan "Goodbye!"
         return ()
       | otherwise -> do
         env' <- execute line env
@@ -171,9 +176,9 @@ decideRun args
     content <- readFile (head args)
     let exprs = lines content
     execJustProg exprs []
-    putStrLn "\x1b[1;32mDone.\x1b[0m"
+    putStrLn $ boldGreen "Done."
   | otherwise = do
-    putStrLn "\x1b[31mignoring argument(s)...\x1b[0m"
+    putStrLn $ red "ignoring argument(s)..."
     putStrLn heading
     runInput
   where

pLam.cabal

@@ -4,7 +4,7 @@ cabal-version: 1.12
 --
 -- see: https://github.com/sol/hpack
 --
--- hash: fc07851370788f9c5f9f5faf9c2d5074270149a1d58276931a72843581b59b39
+-- hash: 0b070e72be3e599b16c2401f36ad3944de31b8e51d08981537561a0513c8aa49
 
 name:           pLam
 version:        2.2.1
@@ -34,7 +34,8 @@ library
       src
   default-extensions: ImportQualifiedPost LambdaCase
   build-depends:
-      base >=4.7 && <5
+      ansi-terminal
+    , base >=4.7 && <5
     , containers
     , haskeline
     , mtl
@@ -50,7 +51,8 @@ executable plam
   default-extensions: ImportQualifiedPost LambdaCase
   ghc-options: -threaded -rtsopts -with-rtsopts=-N
   build-depends:
-      base >=4.7 && <5
+      ansi-terminal
+    , base >=4.7 && <5
     , containers
     , directory
     , haskeline

package.yaml

@@ -14,6 +14,7 @@ dependencies:
 - containers
 - haskeline
 - parsec
+- ansi-terminal
 
 library:
   source-dirs: src

src/Helper.hs

@@ -6,9 +6,38 @@ import Evaluator
 import Parser
 import Reducer
 import Syntax
+import System.Console.ANSI.Codes (setSGRCode)
+import System.Console.ANSI.Types (Color (..), ColorIntensity (..), ConsoleIntensity (..), ConsoleLayer (..), SGR (..))
 import System.Console.Haskeline
 import System.IO (Handle, hFlush, hPutStrLn, stdout)
 
+red :: String -> String
+red s = setSGRCode [SetConsoleIntensity NormalIntensity, SetColor Foreground Dull Red] <> s <> setSGRCode [Reset]
+
+magenta :: String -> String
+magenta s = setSGRCode [SetConsoleIntensity NormalIntensity, SetColor Foreground Dull Magenta] <> s <> setSGRCode [Reset]
+
+cyan :: String -> String
+cyan s = setSGRCode [SetConsoleIntensity NormalIntensity, SetColor Foreground Dull Cyan] <> s <> setSGRCode [Reset]
+
+yellow :: String -> String
+yellow s = setSGRCode [SetConsoleIntensity NormalIntensity, SetColor Foreground Dull Yellow] <> s <> setSGRCode [Reset]
+
+boldCyan :: String -> String
+boldCyan s = setSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Cyan] <> s <> setSGRCode [Reset]
+
+boldMagenta :: String -> String
+boldMagenta s = setSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Magenta] <> s <> setSGRCode [Reset]
+
+boldRed :: String -> String
+boldRed s = setSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Red] <> s <> setSGRCode [Reset]
+
+boldGreen :: String -> String
+boldGreen s = setSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Green] <> s <> setSGRCode [Reset]
+
+boldYellow :: String -> String
+boldYellow s = setSGRCode [SetConsoleIntensity BoldIntensity, SetColor Foreground Dull Yellow] <> s <> setSGRCode [Reset]
+
 -------------------------------------------------------------------------------------
 showGlobal :: (String, Expression) -> InputT IO ()
 showGlobal (n, e) = outputStrLn ("--- " ++ show n ++ " = " ++ show e)
@@ -36,7 +65,7 @@ convertToName ((v, e) : rest) ex
 convertToNames :: Bool -> Bool -> Expression -> Environment -> Expression -> String
 convertToNames redexFound redexVarFind redexVar env (Variable v) =
   if redexVarFind && (Variable v == redexVar)
-    then "\x1b[0;31m" ++ show v ++ "\x1b[0m"
+    then red $ show v
     else show v
 convertToNames redexFound redexVarFind redexVar env redex@(Application (Abstraction v e) n) =
   if redexFound
@@ -45,7 +74,7 @@ convertToNames redexFound redexVarFind redexVar env redex@(Application (Abstract
        in if redex1 == "none"
             then "(" ++ convertToNames True False redexVar env (Abstraction v e) ++ " " ++ convertToNames True False redexVar env n ++ ")"
             else redex1
-    else "\x1b[0;35m(\x1b[1;36m(λ\x1b[1;31m" ++ show v ++ "\x1b[1;36m.\x1b[0;36m " ++ convertToNames True True (Variable v) env e ++ "\x1b[1;36m) \x1b[1;32m" ++ convertToNames True False redexVar env n ++ "\x1b[0;35m)\x1b[0m"
+    else magenta "(" ++ boldCyan "λ" ++ boldRed (show v) ++ boldCyan "." ++ cyan (" " ++ convertToNames True True (Variable v) env e) ++ boldCyan ") " ++ boldGreen (convertToNames True False redexVar env n) ++ magenta ")"
 convertToNames redexFound redexVarFind redexVar env app@(Application m n) =
   let app1 = convertToName env app
    in if app1 == "none"
@@ -62,7 +91,7 @@ convertToNames redexFound redexVarFind redexVar env abs@(Abstraction v e) =
 convertToNamesResult :: Bool -> Bool -> Expression -> Environment -> Expression -> String
 convertToNamesResult redexFound redexVarFind redexVar env (Variable v) =
   if redexVarFind && (Variable v == redexVar)
-    then "\x1b[0;31m" ++ show v ++ "\x1b[0m"
+    then red $ show v
     else show v
 convertToNamesResult redexFound redexVarFind redexVar env redex@(Application (Abstraction v e) n) =
   if redexFound
@@ -71,17 +100,17 @@ convertToNamesResult redexFound redexVarFind redexVar env redex@(Application (Ab
        in if redex1 == "none"
             then "(" ++ convertToNamesResult True False redexVar env (Abstraction v e) ++ " " ++ convertToNamesResult True False redexVar env n ++ ")"
             else redex1
-    else "\x1b[0;35m(\x1b[1;36m(λ\x1b[1;31m" ++ show v ++ "\x1b[1;36m.\x1b[0;36m " ++ convertToNamesResult True True (Variable v) env e ++ "\x1b[1;36m) \x1b[1;32m" ++ convertToNamesResult True False redexVar env n ++ "\x1b[0;35m)\x1b[0m"
+    else magenta "(" ++ boldCyan "(λ" ++ boldRed (show v) ++ boldCyan "." ++ cyan (" " ++ convertToNamesResult True True (Variable v) env e) ++ boldCyan ") " ++ boldGreen (convertToNamesResult True False redexVar env n) ++ magenta ")"
 convertToNamesResult redexFound redexVarFind redexVar env app@(Application m n) =
   let app1 = convertToName env app
    in if app1 == "none"
-        then "\x1b[0;35m(\x1b[0m" ++ convertToNamesResult redexFound redexVarFind redexVar env m ++ " " ++ convertToNamesResult redexFound redexVarFind redexVar env n ++ "\x1b[0;35m)\x1b[0m"
-        else "\x1b[1;32m" ++ app1 ++ "\x1b[0m"
+        then magenta "(" ++ convertToNamesResult redexFound redexVarFind redexVar env m ++ " " ++ convertToNamesResult redexFound redexVarFind redexVar env n ++ magenta ")"
+        else boldGreen app1
 convertToNamesResult redexFound redexVarFind redexVar env abs@(Abstraction v e) =
   let abs1 = convertToName env abs
    in if abs1 == "none"
-        then "\x1b[0;36m(\x1b[1;36mλ\x1b[0m" ++ show v ++ "\x1b[1;36m.\x1b[0m " ++ convertToNamesResult redexFound redexVarFind redexVar env e ++ "\x1b[0;36m)\x1b[0m"
-        else "\x1b[1;32m" ++ abs1 ++ "\x1b[0m"
+        then cyan "(" ++ boldCyan "λ" ++ show v ++ boldCyan "." ++ " " ++ convertToNamesResult redexFound redexVarFind redexVar env e ++ cyan ")"
+        else boldGreen abs1
 
 -----------------------------------------------------------------------------------------------------------
 isDefined :: Environment -> String -> Bool
@@ -142,17 +171,23 @@ showProgResult env evop exp num =
 
 showSummary :: Environment -> Expression -> Int -> String
 showSummary env exp count =
-  "\x1b[1;32m|> \x1b[0;33mreductions count               : \x1b[1;31m" ++ show count ++ "\n"
-    ++ "\x1b[1;32m|> \x1b[0;33muncurried \x1b[1;33mβ-normal\x1b[0;33m form        : \x1b[0m"
+  boldGreen "|> " ++ yellow "reductions count               : " ++ boldRed (show count ++ "\n")
+    ++ boldGreen "|> "
+    ++ yellow "uncurried "
+    ++ boldYellow "β-normal"
+    ++ yellow " form        : "
     ++ show exp
     ++ "\n"
-    ++ "\x1b[1;32m|> \x1b[0;33mcurried (partial) \x1b[1;33mα-equivalent\x1b[0;33m : \x1b[0m"
+    ++ boldGreen "|> "
+    ++ yellow "curried (partial) "
+    ++ boldYellow "α-equivalent"
+    ++ yellow " : "
     ++ convertToNamesResult False False (Variable (LambdaVar '.' 0)) env exp
 
 manualReduce :: Environment -> EvaluateOption -> Expression -> Int -> InputT IO ()
 manualReduce env evop exp num = do
-  outputStrLn ("\x1b[1;35m#" ++ show num ++ ":\x1b[0m" ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
-  line <- getInputLine "\x1b[1;33mNext step?\x1b[0m [Y/n/f] (f: finish all remaining steps): "
+  outputStrLn (boldMagenta ("#" ++ show num ++ ":") ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
+  line <- getInputLine $ boldYellow "Next step?" ++ " [Y/n/f] (f: finish all remaining steps): "
   case line of
     Just "n" ->
       outputStrLn $ showSummary env exp num
@@ -164,14 +199,14 @@ manualReduce env evop exp num = do
 
 autoReduce :: Environment -> EvaluateOption -> Expression -> Int -> InputT IO ()
 autoReduce env evop exp num = do
-  outputStrLn ("\x1b[1;35m#" ++ show num ++ ":\x1b[0m " ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
+  outputStrLn (boldMagenta ("#" ++ show num ++ ":") ++ " " ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
   if hasBetaRedex exp
     then uncurry (autoReduce env evop) (betaReduction evop num exp)
     else outputStrLn $ showResult env evop exp num
 
 autoProgReduce :: Environment -> EvaluateOption -> Expression -> Int -> IO ()
 autoProgReduce env evop exp num = do
-  putStrLn ("#\x1b[1;35m" ++ show num ++ ":\x1b[0m " ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
+  putStrLn ("#" ++ boldMagenta (show num ++ ":") ++ " " ++ convertToNames False False (Variable (LambdaVar '.' 0)) env exp)
   if hasBetaRedex exp
     then uncurry (autoProgReduce env evop) (betaReduction evop num exp)
     else putStrLn $ showProgResult env evop exp num
@@ -190,7 +225,7 @@ decideEvaluate env Detailed None e = do
   case res of
     Left err -> outputStrLn $ show err
     Right exp -> do
-      op <- getInputLine "\x1b[1;33mChoose stepping option\x1b[0m ([default] a: auto all, m: manual step-by-step): "
+      op <- getInputLine $ boldYellow "Choose stepping option" ++ " ([default] a: auto all, m: manual step-by-step): "
       case op of
         Just "a" -> autoReduce env None exp 0
         Just "m" -> manualReduce env None exp 0
@@ -207,7 +242,7 @@ decideEvaluate env Detailed CallByValue e = do
   case res of
     Left err -> outputStrLn $ show err
     Right exp -> do
-      op <- getInputLine "\x1b[1;33mChoose stepping option\x1b[0m ([default] a: auto all, m: manual step-by-step): "
+      op <- getInputLine $ boldYellow "Choose stepping option" ++ " ([default] a: auto all, m: manual step-by-step): "
       case op of
         Just "a" -> autoReduce env CallByValue exp 0
         Just "m" -> manualReduce env CallByValue exp 0