From af6e520b36581f41818f98d31fbb9ffb423f3b28 Mon Sep 17 00:00:00 2001
From: Andrew Martin <amartin@layer3com.com>
Date: Fri, 24 Jun 2016 08:25:52 -0400
Subject: [PATCH] change Indexed to preserve header information for better
 error messages

---
 colonnade/src/Colonnade/Decoding.hs | 36 +++++++++++++----------------
 colonnade/src/Colonnade/Types.hs    |  8 ++++---
 2 files changed, 21 insertions(+), 23 deletions(-)

diff --git a/colonnade/src/Colonnade/Decoding.hs b/colonnade/src/Colonnade/Decoding.hs
index e4bac59..21dbc75 100644
--- a/colonnade/src/Colonnade/Decoding.hs
+++ b/colonnade/src/Colonnade/Decoding.hs
@@ -24,20 +24,20 @@ headless f = DecodingAp Headless f (DecodingPure id)
 headed :: content -> (content -> Either String a) -> Decoding Headed content a
 headed h f = DecodingAp (Headed h) f (DecodingPure id)
 
-uncheckedRun :: forall content a.
+uncheckedRun :: forall content a f.
                 Vector content
-             -> Decoding Indexed content a
-             -> Either (DecodingErrors Indexed content) a
+             -> Decoding (Indexed f) content a
+             -> Either (DecodingErrors f content) a
 uncheckedRun v = getEitherWrap . go
   where
-  go :: forall b. 
-        Decoding Indexed content b
-     -> EitherWrap (DecodingErrors Indexed content) b
+  go :: forall b.
+        Decoding (Indexed f) content b
+     -> EitherWrap (DecodingErrors f content) b
   go (DecodingPure b) = EitherWrap (Right b)
-  go (DecodingAp (Indexed ix) decode apNext) =
+  go (DecodingAp ixed@(Indexed ix h) decode apNext) =
     let rnext = go apNext
         content = Vector.unsafeIndex v ix
-        rcurrent = mapLeft (DecodingErrors . Vector.singleton . DecodingError content (Indexed ix)) (decode content)
+        rcurrent = mapLeft (DecodingErrors . Vector.singleton . DecodingError content ixed) (decode content)
     in rnext <*> (EitherWrap rcurrent)
 
 -- | Maps over a 'Decoding' that expects headers, converting these
@@ -46,14 +46,14 @@ uncheckedRun v = getEitherWrap . go
 headedToIndexed :: forall content a. Eq content
                 => Vector content -- ^ Headers in the source document
                 -> Decoding Headed content a -- ^ Decoding that contains expected headers
-                -> Either (HeadingErrors content) (Decoding Indexed content a)
-headedToIndexed v = go
+                -> Either (HeadingErrors content) (Decoding (Indexed Headed) content a)
+headedToIndexed v = getEitherWrap . go
   where
   go :: forall b. Eq content
      => Decoding Headed content b
-     -> Either (HeadingErrors content) (Decoding Indexed content b)
-  go (DecodingPure b) = Right (DecodingPure b)
-  go (DecodingAp (Headed h) decode apNext) =
+     -> EitherWrap (HeadingErrors content) (Decoding (Indexed Headed) content b)
+  go (DecodingPure b) = EitherWrap (Right (DecodingPure b))
+  go (DecodingAp hd@(Headed h) decode apNext) =
     let rnext = go apNext
         ixs = Vector.elemIndices h v
         ixsLen = Vector.length ixs
@@ -61,13 +61,9 @@ headedToIndexed v = go
           | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0)
           | ixsLen == 0 = Left (HeadingErrors (Vector.singleton h) Vector.empty)
           | otherwise   = Left (HeadingErrors Vector.empty (Vector.singleton (h,ixsLen)))
-    in case rcurrent of
-         Right ix -> case rnext of
-           Right apIx -> Right (DecodingAp (Indexed ix) decode apIx)
-           Left errNext -> Left errNext
-         Left err -> case rnext of
-           Right _ -> Left err
-           Left errNext -> Left (mappend err errNext)
+    in (\ix ap -> DecodingAp (Indexed ix hd) decode ap)
+       <$> EitherWrap rcurrent
+       <*> rnext
 
 eitherMonoidAp :: Monoid a => Either a (b -> c) -> Either a b -> Either a c
 eitherMonoidAp = go where
diff --git a/colonnade/src/Colonnade/Types.hs b/colonnade/src/Colonnade/Types.hs
index f815688..48aea23 100644
--- a/colonnade/src/Colonnade/Types.hs
+++ b/colonnade/src/Colonnade/Types.hs
@@ -29,8 +29,10 @@ data Headless a = Headless
   deriving (Eq,Ord,Functor,Show,Read)
 
 -- | Isomorphic to @'Const' 'Int'@
-newtype Indexed a = Indexed { getIndexed :: Int }
-  deriving (Eq,Ord,Functor,Show,Read)
+data Indexed f a = Indexed
+  { indexedIndex :: Int
+  , indexedHeading :: f a
+  } deriving (Eq,Ord,Functor,Show,Read)
 
 data HeadingErrors content = HeadingErrors
   { headingErrorsMissing   :: Vector content       -- ^ headers that were missing
@@ -47,7 +49,7 @@ instance Monoid (HeadingErrors content) where
 
 data DecodingError f content = DecodingError
   { decodingErrorContent :: content
-  , decodingErrorHeader  :: f content
+  , decodingErrorHeader  :: Indexed f content
   , decodingErrorMessage :: String
   } -- deriving (Show,Read)