diff options
author | dan <[email protected]> | 2021-04-11 15:49:47 +0200 |
---|---|---|
committer | dan <[email protected]> | 2021-04-11 15:49:47 +0200 |
commit | 638e8ff79ab25db779fa272d61767ab49ac8d751 (patch) | |
tree | 334c260bfe31ad412fed1a96ac5cc5637877de90 | |
parent | 90dd6dfdb47edc09f25fbb9b83dbe7f89b179492 (diff) | |
download | bizexp-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.hs | 86 |
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) |