diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -40,8 +40,51 @@ Using the `hatt` command-line program ------------------------------------- -The `--evaluate` flag lets you pass an expression to be evaluated directly. -Here's an example session doing just that. +The default mode is interactive: you start the program, enter expressions at +the prompt, and their truth tables are printed. Here's an example session. + + $ hatt + Entering interactive mode. Type `help` if you don't know what to do! + > help + Hatt's interactive mode has a couple of commands. + + help + Print this help text. + + exit + Quit the program. + + If you don't type in a command, the program will assume you're writing a + logical expression to be evaluated and attempt to parse it. + + For example, if you enter "(A -> B)" at the prompt, Hatt will print the + truth table for that expression. Here's an example console session. + + > (A | B) + A B | (A ∨ B) + ------------- + T T | T + T F | T + F T | T + F F | F + > foobar + Error: parse error at (line 1, column 1): + unexpected "f" + expecting white space, "(" or "~" + > exit + + If none of this makes any sense, try reading the README file. + > (A -> B) + A B | (A -> B) + -------------- + T T | F + T F | F + F T | F + F F | T + > exit + +The `--evaluate` flag lets you pass a single expression to be evaluated +directly. $ hatt --evaluate="(P -> (Q | ~R))" P Q R | (P -> (Q | ~R)) diff --git a/hatt.cabal b/hatt.cabal --- a/hatt.cabal +++ b/hatt.cabal @@ -1,5 +1,5 @@ Name: hatt -Version: 0.2 +Version: 0.3 Stability: experimental Synopsis: A truth table generator for classical propositional logic. diff --git a/src/Data/Logic/Propositional/Tables.hs b/src/Data/Logic/Propositional/Tables.hs --- a/src/Data/Logic/Propositional/Tables.hs +++ b/src/Data/Logic/Propositional/Tables.hs @@ -20,7 +20,7 @@ truthTableP printer expr = unlines [header, separator, body] where header = unwords vs ++ " | " ++ printer expr - body = unlines $ map (showAssignment expr) as + body = init . unlines $ map (showAssignment expr) as separator = concat $ replicate sepLength "-" sepLength = length vs * 2 + length (printer expr) + 2 as = assignments expr diff --git a/src/hatt.hs b/src/hatt.hs --- a/src/hatt.hs +++ b/src/hatt.hs @@ -6,28 +6,112 @@ import Data.Logic.Propositional +import Data.Char (isSpace, toLower) import System.Console.CmdArgs +import System.IO data HattOpts = HattOpts - { evaluate :: String - , pretty :: Bool + { evaluate :: String + , interactive :: Bool + , pretty :: Bool } deriving (Show, Data, Typeable) +data Command = Exit + | Help + | Eval Expr + | Error String + hattOpts :: HattOpts hattOpts = HattOpts - { evaluate = "" &= typ "EXPRESSION" + { evaluate = "" &= typ "EXPRESSION" &= help "Print the truth table for the given expression" - , pretty = False &= help "Use Unicode logic symbols when printing expressions" - } &= summary "Hatt 0.1, (c) Benedict Eastaugh 2011" + , interactive = False &= help "Enter interactive mode" + , pretty = False &= help "Use Unicode logic symbols" + } &= summary "Hatt 0.3, (c) Benedict Eastaugh 2011" &= program "hatt" main :: IO () main = do opts <- cmdArgs hattOpts - case evaluate opts of - "" -> putStrLn "Try using the --evaluate[=EXPRESSION] flag" - expr -> putStr (eval (if pretty opts then show else showAscii) expr) + let expStr = evaluate opts + interMode = interactive opts + evalMode = (not . null) expStr + printer = if pretty opts then show else showAscii + + -- If the --evaluate flag is passed with an expression, print the + -- truth table for that expression. + if evalMode + then putStr $ eval printer expStr + else return () + + -- If the --evaluate flag is passed with an expression and + -- interactive mode is NOT explicitly requested, terminate the + -- program; otherwise, enter interactive mode. + if evalMode && not interMode + then return () + else putStrLn replIntroText >> repl printer +repl :: (Expr -> String) -> IO () +repl p = do putStr "> " + hFlush stdout + cmd <- getLine + case parseCommand cmd of + Exit -> return () + Help -> putStr replHelpText >> repl p + (Eval expr) -> putStr (truthTableP p expr) >> repl p + (Error err) -> putStrLn ("Error: " ++ err) >> repl p + eval :: (Expr -> String) -> String -> String eval p str = case parseExpr "" str of - Left err -> "parse error at " ++ show err ++ "\n" - Right expr -> truthTableP p expr + Left err -> "Parse error at " ++ show err ++ "\n" + Right expr -> truthTableP p expr + +parseCommand :: String -> Command +parseCommand input = case cmd . words . dropWhile isSpace $ input of + "" -> Error "you must enter an expression or a command." + "exit" -> Exit + "help" -> Help + _ -> eval_ input + where + cmd [] = "" + cmd ws = map toLower . head $ ws + eval_ str = case parseExpr "" str of + Left err -> Error $ "parse error at " ++ show err + Right expr -> Eval expr + +replIntroText :: String +replIntroText = unwords + [ "Entering interactive mode." + , "Type `help` if you don't know what to do!" + ] + +replHelpText :: String +replHelpText = unlines + [ "Hatt's interactive mode has a couple of commands." + , "" + , "help" + , " Print this help text." + , "" + , "exit" + , " Quit the program." + , "" + , "If you don't type in a command, the program will assume you're writing a" + , "logical expression to be evaluated and attempt to parse it." + , "" + , "For example, if you enter \"(A -> B)\" at the prompt, Hatt will print the" + , "truth table for that expression. Here's an example console session." + , "" + , " > (A | B)" + , " A B | (A ∨ B)" + , " -------------" + , " T T | T" + , " T F | T" + , " F T | T" + , " F F | F" + , " > foobar" + , " Error: parse error at (line 1, column 1):" + , " unexpected \"f\"" + , " expecting white space, \"(\" or \"~\"" + , " > exit" + , "" + , "If none of this makes any sense, try reading the README file." + ]