Day11, MonkeyBrain, kinda finished.

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