aboutsummaryrefslogtreecommitdiffstats
diff options
context:
space:
mode:
authordan <[email protected]>2021-04-11 15:49:47 +0200
committerdan <[email protected]>2021-04-11 15:49:47 +0200
commit638e8ff79ab25db779fa272d61767ab49ac8d751 (patch)
tree334c260bfe31ad412fed1a96ac5cc5637877de90
parent90dd6dfdb47edc09f25fbb9b83dbe7f89b179492 (diff)
downloadbizexp-638e8ff79ab25db779fa272d61767ab49ac8d751.tar.gz
bizexp-638e8ff79ab25db779fa272d61767ab49ac8d751.tar.bz2
bizexp-638e8ff79ab25db779fa272d61767ab49ac8d751.zip
create generalised eFold function, use this to reimplement eSum and eAny
-rw-r--r--src/MyLib.hs86
1 files changed, 40 insertions, 46 deletions
diff --git a/src/MyLib.hs b/src/MyLib.hs
index 5e5a617..6539412 100644
--- a/src/MyLib.hs
+++ b/src/MyLib.hs
@@ -11,29 +11,32 @@ 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
-
+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
-coerceToInt :: Value -> Maybe Integer
-coerceToInt (IntVal n) = Just n
-coerceToInt (StrVal s) = readMaybe s
-coerceToInt (BoolVal True) = Just 1
-coerceToInt (BoolVal False) = Just 0
+ coerceFrom = IntVal
-coerceToBool :: Value -> Maybe Bool
-coerceToBool (IntVal v) = Just $ v /= 0
-coerceToBool (StrVal "True") = Just True
-coerceToBool (StrVal "true") = Just True
-coerceToBool (BoolVal v) = Just v
-coerceToBool _ = Just False
+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
@@ -46,29 +49,23 @@ 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
+ 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) "" =
+ 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 l (x : xs) =
go (prev ++ [x]) l xs
evalAst :: Ast -> Maybe Value
@@ -78,27 +75,24 @@ 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 [] = Just $ IntVal 0
-eSum (x:xs) =
- let
- a1 = coerceToInt =<< eSum xs
- a0 = coerceToInt x
- in
- IntVal <$> ((+) <$> a1 <*> a0)
+eSum = eFold (+) (0 :: Integer)
eAny :: [Value] -> Maybe Value
-eAny [] = Just $ BoolVal False
-eAny (x:xs) =
- let
- a1 = coerceToBool =<< eAny xs
- a0 = coerceToBool x
- in
- BoolVal <$> ((||) <$> a1 <*> a0)
+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)