init

1 files changed, 144 insertions, 0 deletions

diff --git a/src/MyLib.hs b/src/MyLib.hs
new file mode 100644
index 0000000..140e1fc
--- /dev/null
+++ b/src/MyLib.hs
@@ -0,0 +1,144 @@
+module MyLib (someFunc) where
+
+import Data.Maybe (fromMaybe)
+import Text.Read (readMaybe)
+
+--import Data.Text as T
+
+someFunc :: IO ()
+someFunc = putStrLn "someFunc"
+
+data FType = FList [FType] | FInt Int | FStr String | FNothing
+
+type Func = FType -> FType
+
+parseFunc :: String -> Maybe Func
+parseFunc s =
+  let pref = takeWhile (/= '(') s
+      maybeFn = lookup pref funcs
+   in fromMaybe Nothing maybeFn
+
+--funcs = [("SUM", fSum)]
+funcs = []
+
+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
+  | Pair Ast Ast
+  | Level [Ast]
+  deriving (Show)
+
+exprFuncs = ["sum", "any"]
+
+--parseAst :: String -> Maybe Ast
+--parseAst s
+--  | validExpr = case parseAst suf of
+--      Nothing -> Nothing
+--      Just arg -> Just $ Expr pref arg
+--  | validPair = case (parseAst pairL, parseAst pairR) of
+--      (Nothing,_) -> Nothing
+--      (_,Nothing) -> Nothing
+--      (Just l, Just r) -> Just $ Pair l r
+--  | validVal = Just $ Val $ StrVal val
+--  | otherwise = Nothing
+--  where
+--    spl x = let
+--              tl0 = dropWhile (/= x) s
+--              tl1 = if tl0 == "" || tl0 == ')'
+--            in
+--            (takeWhile (/= x) s,  )
+--    (pref, suf) = spl '('
+--    exprExists = pref `elem` exprFuncs
+--    sufNotEmpty = suf /= ""
+--    validExpr = exprExists && sufNotEmpty
+--    (pairL, pairR) = spl ','
+--    validPair = pairL /= "" && pairR /= ""
+--    val = if last s == ')' then init s else s
+--    validVal = val /= ""
+
+parseAst :: String -> Maybe Ast
+parseAst = go ""
+  where
+    go prev ('(' : next) = case parseAst next of
+      Nothing -> Nothing
+      Just arg -> Just $ Expr prev arg
+    go prev (',' : next) = parsePair prev next
+    go prev (')':_) = Just $ Val $ StrVal prev 
+    go prev [] = Just $ Val $ StrVal prev
+    go prev (x:xs) = go (prev++[x]) xs
+    parsePair l r = case (parseAst l, parseAst r) of
+      (Nothing, _) -> Nothing
+      (_, Nothing) -> Nothing
+      (Just l, Just r) -> Just $ Pair l r
+
+parseLevel :: String -> Maybe (Ast, String)
+parseLevel = go "" (Just $ Level [])
+  where
+    go :: String -> Maybe Ast -> String -> Maybe (Ast, String)
+    go prev (Just (Level 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 $ Level (l ++ [Expr prev arg])) r
+    go prev (Just (Level l)) (')':remnant) =
+      let
+        l0 = [Val $ StrVal prev | prev /= ""]
+      in
+        Just (Level (l ++ l0), remnant)
+    go prev (Just (Level l)) (',':next) =
+      let
+        l0 = [Val $ StrVal prev]
+      in
+        go "" (Just $ Level (l ++ l0)) next
+    go "" (Just l) "" = 
+      Just (l, "")
+    go prev (Just (Level l)) "" =
+      Just (Level (l ++ [Val $ StrVal prev]), "")
+    go prev l (x:xs) =
+      go (prev ++ [x]) l xs
+
+evalAst :: Ast -> Maybe Value
+evalAst (Expr name ast) = 
+  let
+    Level args = ast
+  in
+  case evalLevel args of
+    Nothing -> Nothing
+    Just values -> getFunc name values
+evalAst (Val val) = Just val
+evalAst (Level level) = head $ sequence $ evalLevel level
+    
+
+evalLevel :: [Ast] -> Maybe [Value]
+evalLevel = mapM evalAst
+
+
+getFunc :: String -> ([Value] -> Maybe Value)
+getFunc _ = eSum
+
+
+-- (name, (func, minParams))
+funcs0 = [("sum",(eSum, 0))]
+
+eSum :: [Value] -> Maybe Value
+eSum [] = Just $ IntVal 0
+eSum (x:xs) = case coerceToInt x of
+  Nothing -> Nothing
+  Just a0 ->
+    let
+      Just (IntVal a1) = eSum xs
+    in
+      Just $ IntVal (a0 + a1)
+