From 4d64d3418bba5a9fd530210ddbe1bba9015bcca2 Mon Sep 17 00:00:00 2001
From: Alan Lawrence <alan.lawrence@cambridgequantum.com>
Date: Mon, 21 Oct 2024 17:28:37 +0100
Subject: [PATCH] Make TypeErr outside extractSuffixes using 'first' from
 Data.Bifunctor

---
 brat/Brat/Checker.hs | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs
index b2037762..d0fd81b3 100644
--- a/brat/Brat/Checker.hs
+++ b/brat/Brat/Checker.hs
@@ -7,10 +7,9 @@ module Brat.Checker (checkBody
                     ,tensor
                     ) where
 
-import Control.Arrow (first)
 import Control.Monad (foldM, forM)
 import Control.Monad.Freer
-import Data.Bifunctor (second)
+import Data.Bifunctor (first, second)
 import Data.Functor (($>), (<&>))
 import Data.List ((\\))
 import Data.List.NonEmpty (NonEmpty(..))
@@ -134,14 +133,15 @@ checkIO tm@(WC fc _) exps acts wireFn errMsg = do
   let (rows, rest) = extractSuffixes exps acts
   localFC fc $ forM rows $ \(e:|exps, a:|acts) ->
       wrapError (addRowContext (showRow $ e:exps) (showRow $ a:acts)) $ wireFn e a
-  throwLeft rest
+  throwLeft $ first (\bs -> TypeErr $ errMsg ++ showRow bs ++ " for " ++ show tm) rest
  where
   addRowContext :: String -> String -> Error -> Error
   addRowContext exp act = \case
     (Err fc (TypeMismatch tm _ _)) -> Err fc $ TypeMismatch tm exp act
     e -> e
+  extractSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either [b] [a])
   extractSuffixes as [] = ([], Right as)
-  extractSuffixes [] bs = ([], Left $ TypeErr $ errMsg ++ showRow bs ++ " for " ++ show tm)
+  extractSuffixes [] bs = ([], Left bs) -- indicates error
   extractSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ extractSuffixes as bs
 
 checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m)