aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
-rw-r--r--app/Main.hs6
-rw-r--r--hs.cabal2
-rw-r--r--src/BizExpr.hs95
-rw-r--r--src/MyLib.hs15
4 files changed, 107 insertions, 11 deletions
diff --git a/app/Main.hs b/app/Main.hs
index 60d904e..971bed7 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,8 +1,6 @@
module Main where
-import qualified MyLib (someFunc)
+import qualified BizExpr (eval, repl)
main :: IO ()
-main = do
- putStrLn "Hello, Haskell!"
- MyLib.someFunc
+main = BizExpr.repl
diff --git a/hs.cabal b/hs.cabal
index 6e67e59..aec9be4 100644
--- a/hs.cabal
+++ b/hs.cabal
@@ -22,7 +22,7 @@ maintainer: [email protected]
extra-source-files: CHANGELOG.md
library
- exposed-modules: MyLib
+ exposed-modules: BizExpr
-- Modules included in this library but not exported.
-- other-modules:
diff --git a/src/BizExpr.hs b/src/BizExpr.hs
new file mode 100644
index 0000000..c297da6
--- /dev/null
+++ b/src/BizExpr.hs
@@ -0,0 +1,95 @@
+module BizExpr (repl, eval) where
+
+import Data.Maybe (fromMaybe)
+import Text.Read (readMaybe)
+
+--import Data.Text as T
+
+repl :: IO ()
+repl = getLine >>= putStrLn . maybe "Failed to evaluate expression" show . eval >> repl
+
+eval :: String -> Maybe Integer
+eval x = coerceTo =<< evalAst . head . fst =<< parseLevel x
+
+data Value = IntVal Integer | StrVal String | BoolVal Bool
+ deriving (Show)
+
+class CoerceTo a where
+ coerceTo :: Value -> Maybe a
+ coerceFrom :: a -> Value
+
+instance CoerceTo Integer where
+ coerceTo (IntVal n) = Just n
+ coerceTo (StrVal s) = readMaybe s
+ coerceTo (BoolVal True) = Just 1
+ coerceTo (BoolVal False) = Just 0
+
+ coerceFrom = IntVal
+
+instance CoerceTo Bool where
+ coerceTo (IntVal v) = Just $ v /= 0
+ coerceTo (StrVal "True") = Just True
+ coerceTo (StrVal "true") = Just True
+ coerceTo (BoolVal v) = Just v
+ coerceTo _ = Just False
+
+ coerceFrom = BoolVal
+
+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 "sum" = Just eSum
+getFunc "any" = Just eAny
+getFunc "all" = Just eAll
+getFunc _ = Nothing
+
+eSum :: [Value] -> Maybe Value
+eSum = eFold (+) (0 :: Integer)
+
+eAny :: [Value] -> Maybe Value
+eAny = eFold (||) False
+
+eAll :: [Value] -> Maybe Value
+eAll = eFold (&&) True
+
+eFold :: (CoerceTo a, CoerceTo b) => (b -> a -> b) -> b -> [Value] -> Maybe Value
+eFold fn init [] = Just $ coerceFrom init
+eFold fn init (x : xs) =
+ let b = coerceTo =<< eFold fn init xs
+ a = coerceTo x
+ in coerceFrom <$> (fn <$> b <*> a)
diff --git a/src/MyLib.hs b/src/MyLib.hs
index 6539412..864f99e 100644
--- a/src/MyLib.hs
+++ b/src/MyLib.hs
@@ -1,13 +1,10 @@
-module MyLib (someFunc) where
+module BizExpr (repl, eval) 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
@@ -30,11 +27,17 @@ instance CoerceTo Integer where
coerceFrom = IntVal
instance CoerceTo Bool where
+ coerceTo (BoolVal v) = Just v
coerceTo (IntVal v) = Just $ v /= 0
coerceTo (StrVal "True") = Just True
coerceTo (StrVal "true") = Just True
- coerceTo (BoolVal v) = Just v
- coerceTo _ = Just False
+ --coerceTo v@(StrVal _) = coerceTo . IntVal =<< (coerceTo v :: Maybe Integer) :: Maybe Bool
+ coerceTo v@(StrVal x) = case (readMaybe x :: Maybe Integer) of
+ Nothing -> Just False
+ Just n -> Just $ True--n /= 0
+-- case coerceTo v :: Maybe Integer of
+-- Nothing -> Just False
+-- Just n -> coerceTo (IntVal n)
coerceFrom = BoolVal