From 2ac5324ec23f2194df922bf9e27b5bf93e54c8ca Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 11:49:14 +0100 Subject: [PATCH 01/10] Refactor both addRowContext - remove Modey, constraints and polymorphism --- brat/Brat/Checker.hs | 24 ++++++++++-------------- 1 file changed, 10 insertions(+), 14 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index dcab2a97..c3105e34 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -122,44 +122,40 @@ checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ do else typeEq (show tm) (Dollar []) ut ot wire (dangling, ot, hungry) -checkInputs :: (CheckConstraints m KVerb, ?my :: Modey m) +checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m) => WC (Term d KVerb) -> [(Src, BinderType m)] -- Expected -> [(Tgt, BinderType m)] -- Actual -> Checking [(Src, BinderType m)] checkInputs _ overs [] = pure overs checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do - wrapError (addRowContext ?my (o:overs) (u:unders)) $ checkWire ?my tm False o u + wrapError (addRowContext (o:overs) (u:unders)) $ checkWire ?my tm False o u checkInputs tm overs unders where - addRowContext :: Show (BinderType m) - => Modey m - -> [(Src, BinderType m)] -- Expected + addRowContext :: [(Src, BinderType m)] -- Expected -> [(Tgt, BinderType m)] -- Actual -> Error -> Error - addRowContext _ as bs (Err fc (TypeMismatch tm _ _)) + addRowContext as bs (Err fc (TypeMismatch tm _ _)) = Err fc $ TypeMismatch tm (showRow as) (showRow bs) - addRowContext _ _ _ e = e + addRowContext _ _ e = e checkInputs tm [] unders = typeErr $ "No overs but unders: " ++ showRow unders ++ " for " ++ show tm -checkOutputs :: (CheckConstraints m k, ?my :: Modey m) +checkOutputs :: forall m k . (CheckConstraints m k, ?my :: Modey m) => WC (Term Syn k) -> [(Tgt, BinderType m)] -- Expected -> [(Src, BinderType m)] -- Actual -> Checking [(Tgt, BinderType m)] checkOutputs _ unders [] = pure unders checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ do - wrapError (addRowContext ?my (u:unders) (o:overs)) $ checkWire ?my tm True o u + wrapError (addRowContext (u:unders) (o:overs)) $ checkWire ?my tm True o u checkOutputs tm unders overs where - addRowContext :: Show (BinderType m) - => Modey m - -> [(Tgt, BinderType m)] -- Expected + addRowContext :: [(Tgt, BinderType m)] -- Expected -> [(Src, BinderType m)] -- Actual -> Error -> Error - addRowContext _ as bs (Err fc (TypeMismatch tm _ _)) + addRowContext as bs (Err fc (TypeMismatch tm _ _)) = Err fc $ TypeMismatch tm (showRow as) (showRow bs) - addRowContext _ _ _ e = e + addRowContext _ _ e = e checkOutputs tm [] overs = typeErr $ "No unders but overs: " ++ showRow overs ++ " for " ++ show tm checkThunk :: (CheckConstraints m UVerb, EvMode m) From da96cd8df9d80b67adb6db283b37da7d61090fd8 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 12:27:02 +0100 Subject: [PATCH 02/10] Refactor via extractSuffixes but much longer --- brat/Brat/Checker.hs | 17 +++++++++++------ 1 file changed, 11 insertions(+), 6 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index c3105e34..d1b0df0d 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -8,7 +8,7 @@ module Brat.Checker (checkBody ) where import Control.Arrow (first) -import Control.Monad (foldM) +import Control.Monad (foldM, forM) import Control.Monad.Freer import Data.Bifunctor (second) import Data.Functor (($>), (<&>)) @@ -127,10 +127,12 @@ checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m) -> [(Src, BinderType m)] -- Expected -> [(Tgt, BinderType m)] -- Actual -> Checking [(Src, BinderType m)] -checkInputs _ overs [] = pure overs -checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do - wrapError (addRowContext (o:overs) (u:unders)) $ checkWire ?my tm False o u - checkInputs tm overs unders +checkInputs tm@(WC fc _) overs unders = let (pairs, rest) = extractSuffixes overs unders in do + localFC fc $ forM pairs $ \(o:|overs, u:|unders) -> + wrapError (addRowContext (o:overs) (u:unders)) $ checkWire ?my tm False o u + case rest of + Left overs -> pure overs + Right (u:|unders) -> typeErr $ "No more overs but unders: " ++ showRow (u:unders) ++ " for " ++ show tm where addRowContext :: [(Src, BinderType m)] -- Expected -> [(Tgt, BinderType m)] -- Actual @@ -138,7 +140,10 @@ checkInputs tm@(WC fc _) (o:overs) (u:unders) = localFC fc $ do addRowContext as bs (Err fc (TypeMismatch tm _ _)) = Err fc $ TypeMismatch tm (showRow as) (showRow bs) addRowContext _ _ e = e -checkInputs tm [] unders = typeErr $ "No overs but unders: " ++ showRow unders ++ " for " ++ show tm + extractSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either [a] (NonEmpty b)) + extractSuffixes as [] = ([], Left as) + extractSuffixes [] (b:bs) = ([], Right (b:|bs)) + extractSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ extractSuffixes as bs checkOutputs :: forall m k . (CheckConstraints m k, ?my :: Modey m) => WC (Term Syn k) From d517050d815440577b0d8dbbe9eb10063fb4c310 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 13:42:26 +0100 Subject: [PATCH 03/10] Common up checkInputs/Outputs - a lot of type signatures --- brat/Brat/Checker.hs | 49 ++++++++++++++++++++++---------------------- 1 file changed, 24 insertions(+), 25 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index d1b0df0d..e5305de3 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -122,46 +122,45 @@ checkWire Kerny (WC fc tm) outputs (dangling, ot) (hungry, ut) = localFC fc $ do else typeEq (show tm) (Dollar []) ut ot wire (dangling, ot, hungry) -checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m) - => WC (Term d KVerb) - -> [(Src, BinderType m)] -- Expected - -> [(Tgt, BinderType m)] -- Actual - -> Checking [(Src, BinderType m)] -checkInputs tm@(WC fc _) overs unders = let (pairs, rest) = extractSuffixes overs unders in do +checkIO :: forall m d k exp act . (CheckConstraints m k, ?my :: Modey m) + => WC (Term d k) + -> [(NamedPort exp, BinderType m)] + -> [(NamedPort act, BinderType m)] + -> ((NamedPort exp, BinderType m) -> (NamedPort act, BinderType m) -> Checking ()) + -> String + -> Checking [(NamedPort exp, BinderType m)] -- left(overs/unders) +checkIO tm@(WC fc _) overs unders wireFn errMsg = do + let _ = ?my -- otherwise ?my is "redundant" but typechecking fails without it + let (pairs, rest) = extractSuffixes overs unders localFC fc $ forM pairs $ \(o:|overs, u:|unders) -> - wrapError (addRowContext (o:overs) (u:unders)) $ checkWire ?my tm False o u + wrapError (addRowContext (o:overs) (u:unders)) $ wireFn o u case rest of Left overs -> pure overs - Right (u:|unders) -> typeErr $ "No more overs but unders: " ++ showRow (u:unders) ++ " for " ++ show tm + Right (u:|unders) -> typeErr $ errMsg ++ showRow (u:unders) ++ " for " ++ show tm where - addRowContext :: [(Src, BinderType m)] -- Expected - -> [(Tgt, BinderType m)] -- Actual + addRowContext :: [(NamedPort exp, BinderType m)] -> [(NamedPort act, BinderType m)] -> Error -> Error - addRowContext as bs (Err fc (TypeMismatch tm _ _)) - = Err fc $ TypeMismatch tm (showRow as) (showRow bs) - addRowContext _ _ e = e + addRowContext as bs = \case + (Err fc (TypeMismatch tm _ _)) -> Err fc $ TypeMismatch tm (showRow as) (showRow bs) + e -> e extractSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either [a] (NonEmpty b)) extractSuffixes as [] = ([], Left as) extractSuffixes [] (b:bs) = ([], Right (b:|bs)) extractSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ extractSuffixes as bs +checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m) + => WC (Term d KVerb) + -> [(Src, BinderType m)] -- Expected + -> [(Tgt, BinderType m)] -- Actual + -> Checking [(Src, BinderType m)] +checkInputs tm overs unders = checkIO tm overs unders (checkWire ?my tm False) "No overs but unders: " + checkOutputs :: forall m k . (CheckConstraints m k, ?my :: Modey m) => WC (Term Syn k) -> [(Tgt, BinderType m)] -- Expected -> [(Src, BinderType m)] -- Actual -> Checking [(Tgt, BinderType m)] -checkOutputs _ unders [] = pure unders -checkOutputs tm@(WC fc _) (u:unders) (o:overs) = localFC fc $ do - wrapError (addRowContext (u:unders) (o:overs)) $ checkWire ?my tm True o u - checkOutputs tm unders overs - where - addRowContext :: [(Tgt, BinderType m)] -- Expected - -> [(Src, BinderType m)] -- Actual - -> Error -> Error - addRowContext as bs (Err fc (TypeMismatch tm _ _)) - = Err fc $ TypeMismatch tm (showRow as) (showRow bs) - addRowContext _ _ e = e -checkOutputs tm [] overs = typeErr $ "No unders but overs: " ++ showRow overs ++ " for " ++ show tm +checkOutputs tm unders overs = checkIO tm unders overs (flip $ checkWire ?my tm True) "No unders but overs: " checkThunk :: (CheckConstraints m UVerb, EvMode m) => Modey m From 744e714925d186c6b4131d65a38ca381784202ba Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 13:44:08 +0100 Subject: [PATCH 04/10] renaming --- brat/Brat/Checker.hs | 16 ++++++++-------- 1 file changed, 8 insertions(+), 8 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index e5305de3..5951ddaf 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -129,19 +129,19 @@ checkIO :: forall m d k exp act . (CheckConstraints m k, ?my :: Modey m) -> ((NamedPort exp, BinderType m) -> (NamedPort act, BinderType m) -> Checking ()) -> String -> Checking [(NamedPort exp, BinderType m)] -- left(overs/unders) -checkIO tm@(WC fc _) overs unders wireFn errMsg = do +checkIO tm@(WC fc _) exps acts wireFn errMsg = do let _ = ?my -- otherwise ?my is "redundant" but typechecking fails without it - let (pairs, rest) = extractSuffixes overs unders - localFC fc $ forM pairs $ \(o:|overs, u:|unders) -> - wrapError (addRowContext (o:overs) (u:unders)) $ wireFn o u + let (rows, rest) = extractSuffixes exps acts + localFC fc $ forM rows $ \(e:|exps, a:|acts) -> + wrapError (addRowContext (e:exps) (a:acts)) $ wireFn e a case rest of - Left overs -> pure overs - Right (u:|unders) -> typeErr $ errMsg ++ showRow (u:unders) ++ " for " ++ show tm + Left rest -> pure rest + Right (u:|unfilled) -> typeErr $ errMsg ++ showRow (u:unfilled) ++ " for " ++ show tm where addRowContext :: [(NamedPort exp, BinderType m)] -> [(NamedPort act, BinderType m)] -> Error -> Error - addRowContext as bs = \case - (Err fc (TypeMismatch tm _ _)) -> Err fc $ TypeMismatch tm (showRow as) (showRow bs) + addRowContext exps acts = \case + (Err fc (TypeMismatch tm _ _)) -> Err fc $ TypeMismatch tm (showRow exps) (showRow acts) e -> e extractSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either [a] (NonEmpty b)) extractSuffixes as [] = ([], Left as) From 400918ceddd313ca3f2b3af5d8ba03a5e91db21c Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 13:47:27 +0100 Subject: [PATCH 05/10] Move showRow outside addRowContext --- brat/Brat/Checker.hs | 9 ++++----- 1 file changed, 4 insertions(+), 5 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index 5951ddaf..c8b31d77 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -133,15 +133,14 @@ checkIO tm@(WC fc _) exps acts wireFn errMsg = do let _ = ?my -- otherwise ?my is "redundant" but typechecking fails without it let (rows, rest) = extractSuffixes exps acts localFC fc $ forM rows $ \(e:|exps, a:|acts) -> - wrapError (addRowContext (e:exps) (a:acts)) $ wireFn e a + wrapError (addRowContext (showRow $ e:exps) (showRow $ a:acts)) $ wireFn e a case rest of Left rest -> pure rest Right (u:|unfilled) -> typeErr $ errMsg ++ showRow (u:unfilled) ++ " for " ++ show tm where - addRowContext :: [(NamedPort exp, BinderType m)] -> [(NamedPort act, BinderType m)] - -> Error -> Error - addRowContext exps acts = \case - (Err fc (TypeMismatch tm _ _)) -> Err fc $ TypeMismatch tm (showRow exps) (showRow acts) + 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 [a] (NonEmpty b)) extractSuffixes as [] = ([], Left as) From 125355a2dec39e68f85d336126729bdf9513d7b2 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 13:54:56 +0100 Subject: [PATCH 06/10] Move error msg into extractSuffixes and drop typeSig; use throwLeft --- brat/Brat/Checker.hs | 9 +++------ 1 file changed, 3 insertions(+), 6 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index c8b31d77..b2037762 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -134,17 +134,14 @@ 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 - case rest of - Left rest -> pure rest - Right (u:|unfilled) -> typeErr $ errMsg ++ showRow (u:unfilled) ++ " for " ++ show tm + throwLeft 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 [a] (NonEmpty b)) - extractSuffixes as [] = ([], Left as) - extractSuffixes [] (b:bs) = ([], Right (b:|bs)) + extractSuffixes as [] = ([], Right as) + extractSuffixes [] bs = ([], Left $ TypeErr $ errMsg ++ showRow bs ++ " for " ++ show tm) extractSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ extractSuffixes as bs checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m) From 4d64d3418bba5a9fd530210ddbe1bba9015bcca2 Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Mon, 21 Oct 2024 17:28:37 +0100 Subject: [PATCH 07/10] 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) From fe02c553e0a469e9cc4a9fb08ec84c4055465f2d Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 Nov 2024 11:11:56 +0000 Subject: [PATCH 08/10] Use modily --- brat/Brat/Checker.hs | 3 +-- 1 file changed, 1 insertion(+), 2 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index d0fd81b3..1e87cf3d 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -128,8 +128,7 @@ checkIO :: forall m d k exp act . (CheckConstraints m k, ?my :: Modey m) -> ((NamedPort exp, BinderType m) -> (NamedPort act, BinderType m) -> Checking ()) -> String -> Checking [(NamedPort exp, BinderType m)] -- left(overs/unders) -checkIO tm@(WC fc _) exps acts wireFn errMsg = do - let _ = ?my -- otherwise ?my is "redundant" but typechecking fails without it +checkIO tm@(WC fc _) exps acts wireFn errMsg = modily ?my $ 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 From d3e662a08f8dbec44e05b3eecf5d0c757ce8499e Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 Nov 2024 11:12:50 +0000 Subject: [PATCH 09/10] Rename extractSuffixes to zipSuffixes --- brat/Brat/Checker.hs | 10 +++++----- 1 file changed, 5 insertions(+), 5 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index 1e87cf3d..c69918b6 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -129,7 +129,7 @@ checkIO :: forall m d k exp act . (CheckConstraints m k, ?my :: Modey m) -> String -> Checking [(NamedPort exp, BinderType m)] -- left(overs/unders) checkIO tm@(WC fc _) exps acts wireFn errMsg = modily ?my $ do - let (rows, rest) = extractSuffixes exps acts + let (rows, rest) = zipSuffixes exps acts localFC fc $ forM rows $ \(e:|exps, a:|acts) -> wrapError (addRowContext (showRow $ e:exps) (showRow $ a:acts)) $ wireFn e a throwLeft $ first (\bs -> TypeErr $ errMsg ++ showRow bs ++ " for " ++ show tm) rest @@ -138,10 +138,10 @@ checkIO tm@(WC fc _) exps acts wireFn errMsg = modily ?my $ do 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 bs) -- indicates error - extractSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ extractSuffixes as bs + zipSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either [b] [a]) + zipSuffixes as [] = ([], Right as) + zipSuffixes [] bs = ([], Left bs) -- indicates error + zipSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ zipSuffixes as bs checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m) => WC (Term d KVerb) From e2f7c5b3356ba110686991ce99ef784d7f69d90c Mon Sep 17 00:00:00 2001 From: Alan Lawrence Date: Fri, 1 Nov 2024 11:14:50 +0000 Subject: [PATCH 10/10] Use NonEmpty in Left --- brat/Brat/Checker.hs | 6 +++--- 1 file changed, 3 insertions(+), 3 deletions(-) diff --git a/brat/Brat/Checker.hs b/brat/Brat/Checker.hs index c69918b6..d71be8c2 100644 --- a/brat/Brat/Checker.hs +++ b/brat/Brat/Checker.hs @@ -132,15 +132,15 @@ checkIO tm@(WC fc _) exps acts wireFn errMsg = modily ?my $ do let (rows, rest) = zipSuffixes exps acts localFC fc $ forM rows $ \(e:|exps, a:|acts) -> wrapError (addRowContext (showRow $ e:exps) (showRow $ a:acts)) $ wireFn e a - throwLeft $ first (\bs -> TypeErr $ errMsg ++ showRow bs ++ " for " ++ show tm) rest + throwLeft $ first (\(b:|bs) -> TypeErr $ errMsg ++ showRow (b: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 - zipSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either [b] [a]) + zipSuffixes :: [a] -> [b] -> ([(NonEmpty a, NonEmpty b)], Either (NonEmpty b) [a]) zipSuffixes as [] = ([], Right as) - zipSuffixes [] bs = ([], Left bs) -- indicates error + zipSuffixes [] (b:bs) = ([], Left (b:|bs)) -- indicates error zipSuffixes (a:as) (b:bs) = first ((a:|as,b:|bs):) $ zipSuffixes as bs checkInputs :: forall m d . (CheckConstraints m KVerb, ?my :: Modey m)