blob: cc84930c0775195470d789cbf1df17f0de954ef8 (
plain)
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
|
module MyLib (someFunc) where
import Data.Maybe (fromMaybe)
import Text.Read (readMaybe)
--import Data.Text as T
someFunc :: IO ()
someFunc = putStrLn "someFunc"
repl :: IO ()
repl = getLine >>= putStrLn . maybe "Failed to evaluate expression" show . eval >> repl
eval :: String -> Maybe Integer
eval x = coerceToInt =<< evalAst.head.fst =<< parseLevel x
data Value = IntVal Integer | StrVal String
deriving (Show)
coerceToInt :: Value -> Maybe Integer
coerceToInt (IntVal n) = Just n
coerceToInt (StrVal s) = readMaybe s
type Name = String
data Ast
= Expr Name [Ast]
| Val Value
deriving (Show)
parseLevel :: String -> Maybe ([Ast], String)
parseLevel = go "" (Just [])
where
go :: String -> Maybe [Ast] -> String -> Maybe ([Ast], String)
go prev (Just l) ('(':next) = case parseLevel next of
Nothing ->
Nothing
Just (arg, remnant) ->
let
r = if remnant /= "" && head remnant == ',' then tail remnant else remnant
in
go "" (Just (l ++ [Expr prev arg])) r
go prev (Just l) (')':remnant) =
let
l0 = [Val $ StrVal prev | prev /= ""]
in
Just (l ++ l0, remnant)
go prev (Just l) (',':next) =
let
l0 = [Val $ StrVal prev]
in
go "" (Just (l ++ l0)) next
go "" (Just l) "" =
Just (l, "")
go prev (Just l) "" =
Just (l ++ [Val $ StrVal prev], "")
go prev l (x:xs) =
go (prev ++ [x]) l xs
evalAst :: Ast -> Maybe Value
evalAst (Expr name ast) = fromMaybe Nothing (getFunc name <*> evalLevel ast)
evalAst (Val val) = Just val
evalLevel :: [Ast] -> Maybe [Value]
evalLevel = mapM evalAst
getFunc :: String -> Maybe ([Value] -> Maybe Value)
getFunc _ = Just eSum
-- (name, (func, minParams))
funcs0 = [("sum",(eSum, 0))]
eSum :: [Value] -> Maybe Value
eSum [] = Just $ IntVal 0
eSum (x:xs) =
let
a1 = coerceToInt =<< eSum xs
a0 = coerceToInt x
in
IntVal <$> ((+) <$> a1 <*> a0)
|
