Let sh*FromList functions print proper error messages

1 files changed, 20 insertions, 14 deletions

diff --git a/src/Data/Array/Nested/Mixed/Shape.hs b/src/Data/Array/Nested/Mixed/Shape.hs
index 5a45a09..900d045 100644
--- a/src/Data/Array/Nested/Mixed/Shape.hs
+++ b/src/Data/Array/Nested/Mixed/Shape.hs
@@ -133,11 +133,14 @@ listxShow f l = showString "[" . go "" l . showString "]"
     go prefix (x ::% xs) = showString prefix . f x . go "," xs
 
 listxFromList :: StaticShX sh -> [i] -> ListX sh (Const i)
-listxFromList ZKX [] = ZX
-listxFromList (_ :!% sh) (i : is) = Const i ::% listxFromList sh is
-listxFromList sh l = error $ "listxFromList: Mismatched list length (type says "
-                             ++ show (ssxLength sh) ++ ", list has length "
-                             ++ show (length l) ++ ")"
+listxFromList topssh topl = go topssh topl
+  where
+    go :: StaticShX sh' -> [i] -> ListX sh' (Const i)
+    go ZKX [] = ZX
+    go (_ :!% sh) (i : is) = Const i ::% go sh is
+    go _ _ = error $ "listxFromList: Mismatched list length (type says "
+                       ++ show (ssxLength topssh) ++ ", list has length "
+                       ++ show (length topl) ++ ")"
 
 {-# INLINEABLE listxToList #-}
 listxToList :: ListX sh' (Const i) -> [i]
@@ -406,15 +409,18 @@ shxSize ZSX = 1
 shxSize (n :$% sh) = fromSMayNat' n * shxSize sh
 
 shxFromList :: StaticShX sh -> [Int] -> IShX sh
-shxFromList ZKX [] = ZSX
-shxFromList (SKnown sn :!% sh) (i : is)
-  | i == fromSNat' sn = SKnown sn :$% shxFromList sh is
-  | otherwise = error $ "shxFromList: Value does not match typing (type says "
-                        ++ show (fromSNat' sn) ++ ", list contains " ++ show i ++ ")"
-shxFromList (SUnknown () :!% sh) (i : is) = SUnknown i :$% shxFromList sh is
-shxFromList sh l = error $ "shxFromList: Mismatched list length (type says "
-                           ++ show (ssxLength sh) ++ ", list has length "
-                           ++ show (length l) ++ ")"
+shxFromList topssh topl = go topssh topl
+  where
+    go :: StaticShX sh' -> [Int] -> IShX sh'
+    go ZKX [] = ZSX
+    go (SKnown sn :!% sh) (i : is)
+      | i == fromSNat' sn = SKnown sn :$% go sh is
+      | otherwise = error $ "shxFromList: Value does not match typing (type says "
+                              ++ show (fromSNat' sn) ++ ", list contains " ++ show i ++ ")"
+    go (SUnknown () :!% sh) (i : is) = SUnknown i :$% go sh is
+    go _ _ = error $ "shxFromList: Mismatched list length (type says "
+                       ++ show (ssxLength topssh) ++ ", list has length "
+                       ++ show (length topl) ++ ")"
 
 {-# INLINEABLE shxToList #-}
 shxToList :: IShX sh -> [Int]