fixed merge conflicts

colonnade/colonnade.cabal

@@ -18,6 +18,7 @@ library
     Colonnade.Types
     Colonnade.Encoding
     Colonnade.Decoding
+    Colonnade.Internal
     Colonnade.Internal.Ap
   build-depends:
       base >= 4.7 && < 5

colonnade/src/Colonnade/Decoding.hs

@@ -2,6 +2,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module Colonnade.Decoding where
 
+import Colonnade.Internal (EitherWrap(..))
 import Colonnade.Types
 import Data.Functor.Contravariant
 import Data.Vector (Vector)
@@ -23,18 +24,34 @@ 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.
+                Vector content
+             -> Decoding Indexed content a
+             -> Either (DecodingErrors Indexed content) a
+uncheckedRun v = getEitherWrap . go
+  where
+  go :: forall b. 
+        Decoding Indexed content b
+     -> EitherWrap (DecodingErrors Indexed content) b
+  go (DecodingPure b) = EitherWrap (Right b)
+  go (DecodingAp (Indexed ix) decode apNext) =
+    let rnext = go apNext
+        content = Vector.unsafeIndex v ix
+        rcurrent = mapLeft (DecodingErrors . Vector.singleton . DecodingError content (Indexed ix)) (decode content)
+    in rnext <*> (EitherWrap rcurrent)
+
 -- | Maps over a 'Decoding' that expects headers, converting these
 --   expected headers into the indices of the columns that they
 --   correspond to.
 headedToIndexed :: forall content a. Eq content
                 => Vector content -- ^ Headers in the source document
                 -> Decoding Headed content a -- ^ Decoding that contains expected headers
-                -> Either (HeadingError content) (Decoding Indexed content a)
+                -> Either (HeadingErrors content) (Decoding Indexed content a)
 headedToIndexed v = go
   where
   go :: forall b. Eq content
      => Decoding Headed content b
-     -> Either (HeadingError content) (Decoding Indexed content b)
+     -> Either (HeadingErrors content) (Decoding Indexed content b)
   go (DecodingPure b) = Right (DecodingPure b)
   go (DecodingAp (Headed h) decode apNext) =
     let rnext = go apNext
@@ -42,8 +59,8 @@ headedToIndexed v = go
         ixsLen = Vector.length ixs
         rcurrent
           | ixsLen == 1 = Right (Vector.unsafeIndex ixs 0)
-          | ixsLen == 0 = Left (HeadingError (Vector.singleton h) Vector.empty)
-          | otherwise   = Left (HeadingError Vector.empty (Vector.singleton (h,ixsLen)))
+          | 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)
@@ -52,4 +69,14 @@ headedToIndexed v = go
            Right _ -> Left err
            Left errNext -> Left (mappend err errNext)
 
+eitherMonoidAp :: Monoid a => Either a (b -> c) -> Either a b -> Either a c
+eitherMonoidAp = go where
+  go (Left a1) (Left a2) = Left (mappend a1 a2)
+  go (Left a1) (Right _) = Left a1
+  go (Right _) (Left a2) = Left a2
+  go (Right f) (Right b) = Right (f b)
+
+mapLeft :: (a -> b) -> Either a c -> Either b c
+mapLeft _ (Right a) = Right a
+mapLeft f (Left a) = Left (f a)
 

colonnade/src/Colonnade/Internal.hs

@@ -0,0 +1,14 @@
+{-# LANGUAGE DeriveFunctor #-}
+module Colonnade.Internal where
+
+newtype EitherWrap a b = EitherWrap
+  { getEitherWrap :: Either a b
+  } deriving (Functor)
+
+instance Monoid a => Applicative (EitherWrap a) where
+  pure = EitherWrap . Right
+  EitherWrap (Left a1) <*> EitherWrap (Left a2) = EitherWrap (Left (mappend a1 a2))
+  EitherWrap (Left a1) <*> EitherWrap (Right _) = EitherWrap (Left a1)
+  EitherWrap (Right _) <*> EitherWrap (Left a2) = EitherWrap (Left a2)
+  EitherWrap (Right f) <*> EitherWrap (Right b) = EitherWrap (Right (f b))
+

colonnade/src/Colonnade/Types.hs

@@ -8,7 +8,9 @@ module Colonnade.Types
   , Headed(..)
   , Headless(..)
   , Indexed(..)
-  , HeadingError(..)
+  , HeadingErrors(..)
+  , DecodingError(..)
+  , DecodingErrors(..)
   ) where
 
 import Data.Vector (Vector)
@@ -30,18 +32,33 @@ data Headless a = Headless
 newtype Indexed a = Indexed { getIndexed :: Int }
   deriving (Eq,Ord,Functor,Show,Read)
 
-data HeadingError content = HeadingError
-  { headingErrorMissing   :: Vector content       -- ^ headers that were missing
-  , headingErrorDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once
+data HeadingErrors content = HeadingErrors
+  { headingErrorsMissing   :: Vector content       -- ^ headers that were missing
+  , headingErrorsDuplicate :: Vector (content,Int) -- ^ headers that occurred more than once
   } deriving (Show,Read)
 
-instance (Show content, Typeable content) => Exception (HeadingError content)
+instance (Show content, Typeable content) => Exception (HeadingErrors content)
 
-instance Monoid (HeadingError content) where
-  mempty = HeadingError Vector.empty Vector.empty
-  mappend (HeadingError a1 b1) (HeadingError a2 b2) = HeadingError
+instance Monoid (HeadingErrors content) where
+  mempty = HeadingErrors Vector.empty Vector.empty
+  mappend (HeadingErrors a1 b1) (HeadingErrors a2 b2) = HeadingErrors
     (a1 Vector.++ a2) (b1 Vector.++ b2)
 
+
+data DecodingError f content = DecodingError
+  { decodingErrorContent :: content
+  , decodingErrorHeader  :: f content
+  , decodingErrorMessage :: String
+  } -- deriving (Show,Read)
+
+-- instance (Show content, Typeable content) => Exception (DecodingError f content)
+
+newtype DecodingErrors f content = DecodingErrors
+  { getDecodingErrors :: Vector (DecodingError f content)
+  } deriving (Monoid)
+
+-- instance (Show content, Typeable content) => Exception (DecodingErrors f content)
+
 instance Contravariant Headless where
   contramap _ Headless = Headless