WeberLogic-0.1.2: WeberLogic.lhs

> import System.Environment
> import System.IO (hFlush, stdout)
> import Text.Parsec (parse)

> import WeberLogic.Parser
> import WeberLogic.Actions

> data Command = TruthTable LogicExp
>             | TruthTree [LogicExp]
>             | IsArgConsistent [LogicExp]
>             | ToNand LogicExp
>             | ToNor LogicExp
>             | Error String

> main :: IO()
> main = do
>   args <- getArgs
>   reader

> reader :: IO ()
> reader = do
>   putStrLn "Enter Command"
>   putStr "> "
>   hFlush stdout
>   line <- getLine                              
>   runCommand $ readCommand line
>   reader

> readCommand :: String -> Command
> readCommand input = case words input of 
>   ("truthTable:":arguments) -> 
>       case readExp $ unwords arguments of 
>               Right val -> TruthTable val
>               Left val -> Error val
>   ("truthTree:":arguments) ->
>       case readArg $ unwords arguments of 
>               Right val -> TruthTree val
>               Left val -> Error val
>   ("toNand:":arguments) ->
>       case readExp $ unwords arguments of 
>               Right val -> ToNand val
>               Left val -> Error val
>   ("toNor:":arguments) ->
>       case readExp $ unwords arguments of 
>               Right val -> ToNor val
>               Left val -> Error val
>   ("isArgConsistent:":arguments) ->
>       case readArg $ unwords arguments of 
>               Right val -> IsArgConsistent val
>               Left val -> Error val
>   _ -> Error input

> runCommand :: Command -> IO()
> runCommand cmd = 
>   case cmd of
>     TruthTable exp -> mapM_ putStrLn $ truthTableStrs exp
>     TruthTree exps -> truthTree exps'
>       where exps' = (take (length exps - 1) exps) ++ [Not (last exps)]
>     IsArgConsistent exps -> putStrLn $ show $ not $ isConsistent exps'
>       where exps' = (take (length exps - 1) exps) ++ [Not (last exps)]
>     ToNand exp     -> putStrLn $ show $ toNand exp
>     ToNor exp      -> putStrLn $ show $ toNor exp
>     Error err      -> putStrLn err