HasKalc/src/Main.hs at master · ldamia/HasKalc · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
module Main where

import           Interpreter.Interpreter (eval)
import           Lexer.Lexer             (tokens)
import           Parser.Checker          (checkIllegal, checkParens)
import           Parser.Parser           (postify, treeify)
import           System.IO               (hFlush, hSetEncoding, stdout, utf8)

main :: IO ()
main = do
    hSetEncoding stdout utf8

    putStrLn "HasKalc - A Calculator Written in Haskell - Avery R.\n\
             \Enter an arithmetic expression for evaluation.\n\
             \Use the command `expose` to expose the intermediate\n\
             \steps of evaluation.\n\
             \Use the command `hide` to hide the intermediate steps.\n\
             \Use the command `quit` to exit the program.\n\
             \Note that all operators (i.e. `+`, `-`, `*`, `/`, `^`)\n\
             \must be surrounded by whitespace on both sides.\n\
             \Some error checking systems are in place, but no\n\
             \guarantees are made regarding the evaluation of malformed\n\
             \inputs."

    hideLoop

hideLoop :: IO ()
hideLoop = do
    printPrompt

    line <- getLine

    if line == "quit" then
        putStrLn "Exiting HasKalc..."
    else if line == "expose" then
        exposeLoop
    else if line == "hide" then do
        putStrLn "You are already in hidden mode."
        hideLoop
    else if words line == [] then do
        putStrLn "Cannot evaluate an empty expression."
        hideLoop
    else do
        let toks = tokens line

        let illegals = checkIllegal toks
        let parens = checkParens toks

        case illegals of
            Just illegals -> do
                putStrLn "Illegal tokens found. Aborting evaluation."
                mapM_ (putStrLn . (<> " is an illegal token.")) illegals
            Nothing -> do
                if parens then
                    print $ interpret line
                else
                    putStrLn "Parentheses are malformed. Aborting evaluation."

        hideLoop


exposeLoop :: IO ()
exposeLoop = do
    printPrompt

    line <- getLine

    if line == "quit" then
        putStrLn "Exiting HasKalc..."
    else if line == "expose" then do
        putStrLn "You are already in exposed mode."
        exposeLoop
    else if line == "hide" then
        hideLoop
    else if words line == [] then do
        putStrLn "Cannot evaluate an empty expression."
        exposeLoop
    else do
        let toks = tokens line

        putStr "Original string:\n  "
        putStrLn line

        putStr "Tokens:\n  "
        print toks

        let illegals = checkIllegal toks

        putStrLn "Checking for illegal tokens..."
        case illegals of
            Just illegals -> do
                putStrLn "Illegal tokens found. Aborting evaluation."
                mapM_ (putStrLn . (<> " is an illegal token.")) illegals
            Nothing -> do
                putStrLn "No illegal tokens were found."
                putStrLn "Checking for matching parentheses..."
                if checkParens toks then do
                    putStrLn "Parentheses are well-formed."

                    putStr "Tokens (in postfix form):\n  "
                    print $ postify toks

                    putStr "AST:\n  "
                    print $ treeify $ postify toks

                    putStr "Final answer:\n  "
                    print $ interpret line
                else
                    putStrLn "Parentheses are malformed. Aborting evaluation."

        exposeLoop


printPrompt :: IO ()
printPrompt = do
    putStr ">> "
    hFlush stdout

interpret :: String -> Double
interpret = eval . treeify . postify . tokens