init

5 files changed, 207 insertions, 0 deletions

diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..48a004c
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1 @@
+dist-newstyle
diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..540b173
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,5 @@
+# Revision history for hs
+
+## 0.1.0.0 -- YYYY-mm-dd
+
+* First version. Released on an unsuspecting world.
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..60d904e
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,8 @@
+module Main where
+
+import qualified MyLib (someFunc)
+
+main :: IO ()
+main = do
+  putStrLn "Hello, Haskell!"
+  MyLib.someFunc
diff --git a/hs.cabal b/hs.cabal
new file mode 100644
index 0000000..6e67e59
--- /dev/null
+++ b/hs.cabal
@@ -0,0 +1,49 @@
+cabal-version:      2.4
+name:               hs
+version:            0.1.0.0
+
+-- A short (one-line) description of the package.
+-- synopsis:
+
+-- A longer description of the package.
+-- description:
+
+-- A URL where users can report bugs.
+-- bug-reports:
+
+-- The license under which the package is released.
+-- license:
+author:             dan
+maintainer:         [email protected]
+
+-- A copyright notice.
+-- copyright:
+-- category:
+extra-source-files: CHANGELOG.md
+
+library
+    exposed-modules:  MyLib
+
+    -- Modules included in this library but not exported.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:    base ^>=4.14.1.0
+    hs-source-dirs:   src
+    default-language: Haskell2010
+
+executable hs
+    main-is:          Main.hs
+
+    -- Modules included in this executable, other than Main.
+    -- other-modules:
+
+    -- LANGUAGE extensions used by modules in this package.
+    -- other-extensions:
+    build-depends:
+        base ^>=4.14.1.0,
+        hs
+
+    hs-source-dirs:   app
+    default-language: Haskell2010
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)
+