diff options
| -rw-r--r-- | Day11/Day11.cabal | 11 | ||||
| -rw-r--r-- | Day11/app/MonkeyBrain.hs | 63 | ||||
| -rw-r--r-- | Day11/tests/MonkeyBrain-Tests.hs | 15 |
3 files changed, 66 insertions, 23 deletions
diff --git a/Day11/Day11.cabal b/Day11/Day11.cabal index da1d855..c31d975 100644 --- a/Day11/Day11.cabal +++ b/Day11/Day11.cabal @@ -32,3 +32,14 @@ executable Day11 build-depends: base ^>=4.16.3.0 hs-source-dirs: app default-language: Haskell2010 + +Test-Suite MonkeyBrainTests + type: exitcode-stdio-1.0 + hs-source-dirs: app, tests + main-is: MonkeyBrain-Tests.hs + other-modules: MonkeyBrain + build-depends: base, + test-framework, + test-framework-hunit, + HUnit + default-language: Haskell2010
\ No newline at end of file diff --git a/Day11/app/MonkeyBrain.hs b/Day11/app/MonkeyBrain.hs index 1eefda1..aaa63a9 100644 --- a/Day11/app/MonkeyBrain.hs +++ b/Day11/app/MonkeyBrain.hs @@ -1,10 +1,26 @@ -module MonkeyBrain (evaluateIntExpression, evaluateFracExpression, tryParseExpression, Expression, VariableNameValidator (..), VariableValues (..), Variable (..), ExpressionParseError(..)) where +module MonkeyBrain ( + evaluateIntExpression, + evaluateFracExpression, + evaluateExpression, + tryParseExpression, + Expression, + VariableNameValidator (..), + VariableValues (..), + Variable (..), + ExpressionParseError(..), + AddFn (..), + SubFn (..), + MulFn (..), + DivFn (..), + NegFn (..) +) where import Control.Exception (assert) import Data.Either (isRight) import Control.Applicative ((<|>)) import Control.Monad ((<=<)) import Text.Read (readMaybe) +import Control.Monad.Zip (MonadZip(mzip)) newtype VariableNameValidator = VariableNameValidator (String -> Bool) @@ -19,18 +35,33 @@ data Expression a = Add (Expression a) (Expression a) newtype Variable = Variable String deriving (Eq, Show) -newtype VariableValues = VariableValues [(Variable, Int)] -- List, because, let's be honest: AOC Day11 just has one variable. +newtype VariableValues a = VariableValues [(Variable, a)] -- List, because, let's be honest: AOC Day11 just has one variable. -- Evaluates the given expression with the supplied set of variables. Returns Nothing if not all required variables have a value. -evaluateIntExpression :: (Integral a) => Expression a -> VariableValues -> Maybe Int -evaluateIntExpression = undefined - -evaluateFracExpression :: (Fractional a) => Expression a -> VariableValues -> Maybe Int -evaluateFracExpression = undefined +evaluateIntExpression :: (Integral a) => Expression a -> VariableValues a -> Maybe a +evaluateIntExpression = evaluateExpression (AddFn (+)) (SubFn (-)) (MulFn (*)) (DivFn quot) (NegFn negate) + +evaluateFracExpression :: (Fractional a) => Expression a -> VariableValues a -> Maybe a +evaluateFracExpression = evaluateExpression (AddFn (+)) (SubFn (-)) (MulFn (*)) (DivFn (/)) (NegFn negate) + +newtype AddFn a = AddFn (a -> a -> a) +newtype SubFn a = SubFn (a -> a -> a) +newtype MulFn a = MulFn (a -> a -> a) +newtype DivFn a = DivFn (a -> a -> a) +newtype NegFn a = NegFn (a -> a) + +evaluateExpression :: AddFn a -> SubFn a -> MulFn a -> DivFn a -> NegFn a -> Expression a -> VariableValues a -> Maybe a +evaluateExpression (AddFn add) s m d n (Add e1 e2) v = uncurry add <$> mzip (evaluateExpression (AddFn add) s m d n e1 v) (evaluateExpression (AddFn add) s m d n e2 v) +evaluateExpression a (SubFn sub) m d n (Sub e1 e2) v = uncurry sub <$> mzip (evaluateExpression a (SubFn sub) m d n e1 v) (evaluateExpression a (SubFn sub) m d n e2 v) +evaluateExpression a s (MulFn mul) d n (Mul e1 e2) v = uncurry mul <$> mzip (evaluateExpression a s (MulFn mul) d n e1 v) (evaluateExpression a s (MulFn mul) d n e2 v) +evaluateExpression a s m (DivFn div) n (Div e1 e2) v = uncurry div <$> mzip (evaluateExpression a s m (DivFn div) n e1 v) (evaluateExpression a s m (DivFn div) n e2 v) +evaluateExpression a s m d (NegFn neg) (Neg e) v = neg <$> evaluateExpression a s m d (NegFn neg) e v +evaluateExpression a s m d n (Value val) v = Just val +evaluateExpression a s m d n (Var var) (VariableValues vals) = lookup var vals data ExpressionParseError = MismatchedBrackets | VariableFailedValidation String - deriving (Show) + deriving (Show, Eq) -- Tries to parse the input string as a maths expression. Returns Left in case of parse errors. tryParseExpression :: (Read a) => VariableNameValidator -> String -> Either ExpressionParseError (Expression a) @@ -70,21 +101,7 @@ internalValidator st = not (null st) && all (\s -> not (s == '(' || s== ')' || s tryParse :: (Read a) => VariableNameValidator -> StringWithMatchingBrackets -> Either ExpressionParseError (Expression a) tryParse v (StringWithMatchingBrackets s) | assert (isRight $ validateBracketPairing s) False = undefined -- for debugging. Checks invariant of StringWithMatchingBrackets tryParse v sr = tryMakeBinaryExpression v s - >>= (\x -> fmap (x <|>) (tryMakeUnaryExpression v s) ) - - - - - - `fmap` (<|> tryReadValue s) -- todo: this is wrong!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! Should try make Unary first! - - - - - - - - + >>= (\x -> (<|> tryReadValue s) <$> fmap (x <|>) (tryMakeUnaryExpression v s) ) >>= maybe (tryReadVariable v s) Right where s = removeEnclosingBrackets sr diff --git a/Day11/tests/MonkeyBrain-Tests.hs b/Day11/tests/MonkeyBrain-Tests.hs new file mode 100644 index 0000000..9049aeb --- /dev/null +++ b/Day11/tests/MonkeyBrain-Tests.hs @@ -0,0 +1,15 @@ +module Main where +import Test.Framework +import Test.Framework.Providers.HUnit +import Test.HUnit + +import MonkeyBrain + +main = defaultMain tests + +test1 = TestCase $ assertEqual "(2+7*3+2-1-3+17/4*2)*(3+4*-1+20)/(17-3*4)" + (Right (Just (((2+7*3+2-1-3+17 `quot` 4*2)*(3+4*(-1)+20) `quot` (17-3*4)) :: Int))) + $ fmap (\x -> evaluateIntExpression x (VariableValues [])) (tryParseExpression (VariableNameValidator (const True)) "(2+7*3+2-1-3+17/4*2)*(3+4*-1+20)/(17-3*4)") + +-- hUnitTestToTests: Adapt an existing HUnit test into a list of test-framework tests +tests = hUnitTestToTests $ TestList [TestLabel "Test1" test1]
\ No newline at end of file |