Fixed mixfix matching

2 files changed, 31 insertions, 9 deletions

diff --git a/src/Eval.hs b/src/Eval.hs
index c457889..f6974de 100644
--- a/src/Eval.hs
+++ b/src/Eval.hs
@@ -90,18 +90,31 @@ evalApp f g sub = evalExp f sub >>= \case
   Left  e  -> pure $ Left e
   Right f' -> fmap (Application f') <$> evalExp g sub
 
+-- TODO: This could be nicer and more performant (current is redundantly recursive)
 evalMixfix :: [Mixfix] -> Environment -> EvalState (Failable Expression)
 evalMixfix m sub = resolve (mixfixKind m) mixfixArgs
  where
-  -- longestMatching [] _  = error "invalid"
-  -- longestMatching x  xs = evalFun (MixfixFunction x) sub >>= \case
-  --   Left  _ -> longestMatching (init x) ((last x) : xs)
-  --   Right f -> (f, Function $ MixfixFunction xs)
+  longestMatching [] = pure $ Left $ UnmatchedMixfix (mixfixKind m) m
+  longestMatching x  = evalFun (MixfixFunction x) sub >>= \case
+    Left  _ -> longestMatching $ init x
+    Right _ -> pure $ Right $ Function $ MixfixFunction x
+  holeCount f = length [ h | h@(MixfixNone) <- f ]
   resolve f args
     | null [ s | s@(MixfixSome _) <- f ] = evalExp (foldl1 Application args) sub
-    | otherwise = evalExp
-      (foldl1 Application ((Function $ MixfixFunction f) : args))
-      sub
+    | otherwise = longestMatching f >>= \case
+      e@(Left _) -> pure e
+      Right l@(Function (MixfixFunction l')) ->
+        let splitted = take (holeCount l') args
+            chainRst = drop (length l') m
+        in  case chainRst of
+              [] -> evalExp (foldl1 Application $ l : splitted) sub
+              _  -> evalExp
+                ( MixfixChain
+                $ (MixfixExpression $ foldl1 Application $ l : splitted)
+                : chainRst
+                )
+                sub
+      _ -> invalidProgramState
   mixfixArgs = [ a | (MixfixExpression a) <- m ]
   mixfixKind = map $ \case
     MixfixOperator i -> MixfixSome $ functionName i
diff --git a/src/Helper.hs b/src/Helper.hs
index b0dea79..87ae8fc 100644
--- a/src/Helper.hs
+++ b/src/Helper.hs
@@ -14,6 +14,9 @@ import           Data.List
 import qualified Data.Map                      as M
 import           Text.Megaparsec
 
+invalidProgramState :: a
+invalidProgramState = error "invalid program state"
+
 data Context = Context
   { _ctxInput :: String
   , _ctxPath  :: String
@@ -36,7 +39,7 @@ printContext (Context inp path) = p $ lines inp
 
 errPrefix :: String
 errPrefix = "\ESC[101m\ESC[30mERROR\ESC[0m "
-data Error = SyntaxError String | UndefinedIdentifier Identifier | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error Context | SuggestSolution Error String | ImportError String
+data Error = SyntaxError String | UndefinedIdentifier Identifier | UnmatchedMixfix [MixfixIdentifierKind] [Mixfix] | InvalidIndex Int | FailedTest Expression Expression Expression Expression | ContextualError Error Context | SuggestSolution Error String | ImportError String
 instance Show Error where
   show (ContextualError err ctx) = show err <> "\n" <> (printContext ctx)
   show (SuggestSolution err sol) =
@@ -47,6 +50,12 @@ instance Show Error where
     errPrefix <> "invalid syntax\n\ESC[105m\ESC[30mnear\ESC[0m " <> err
   show (UndefinedIdentifier ident) =
     errPrefix <> "undefined identifier " <> show ident
+  show (UnmatchedMixfix ks ms) =
+    errPrefix
+      <> "couldn't find matching mixfix for "
+      <> (intercalate "" (map show ks))
+      <> "\n\ESC[105m\ESC[30mnear\ESC[0m "
+      <> (intercalate " " (map show ms))
   show (InvalidIndex err) = errPrefix <> "invalid index " <> show err
   show (FailedTest exp1 exp2 red1 red2) =
     errPrefix
@@ -97,7 +106,7 @@ printBundle ParseErrorBundle {..} =
 
 data MixfixIdentifierKind = MixfixSome String | MixfixNone
   deriving (Ord, Eq)
-instance Show MixfixIdentifierKind where
+instance Show MixfixIdentifierKind where -- don't colorize (due to map)
   show (MixfixSome e) = e
   show _              = "…"
 data Identifier = NormalFunction String | MixfixFunction [MixfixIdentifierKind] | PrefixFunction String | NamespacedFunction String Identifier