Fix siphon indexed decode to not reverse indices

siphon/siphon.cabal

@@ -36,20 +36,21 @@ test-suite test
   main-is: Test.hs
   build-depends:
       base
-    , either
-    , siphon
+    , HUnit
+    , QuickCheck
+    , bytestring
     , colonnade
     , contravariant
-    , test-framework
-    , test-framework-quickcheck2
-    , QuickCheck
-    , text
-    , bytestring
+    , either
     , pipes
-    , HUnit
-    , test-framework-hunit
     , profunctors
+    , siphon
     , streaming
+    , test-framework
+    , test-framework-hunit
+    , test-framework-quickcheck2
+    , text
+    , vector
   default-language: Haskell2010
 
 source-repository head

siphon/src/Siphon.hs

@@ -28,8 +28,12 @@ module Siphon
   , Siphon
   , SiphonError(..)
   , Indexed(..)
+    -- * For Testing
+  , headedToIndexed
     -- * Utility
   , humanizeSiphonError
+  , eqSiphonHeaders
+  , showSiphonHeaders
     -- * Imports
     -- $setup
   ) where
@@ -38,6 +42,7 @@ import Siphon.Types
 import Data.Monoid
 import Control.Applicative
 import Control.Monad
+import Data.Functor.Classes (Eq1,Show1,liftEq,showsPrec1)
 
 import qualified Data.ByteString.Char8 as BC8
 import qualified Data.Attoparsec.ByteString as A
@@ -263,7 +268,7 @@ headedToIndexed toStr v =
         ixs = V.elemIndices h v
         ixsLen = V.length ixs
         rcurrent
-          | ixsLen == 1 = Right (ixs V.! 0) -- (V.unsafeIndex ixs 0)
+          | ixsLen == 1 = Right (ixs V.! 0)
           | ixsLen == 0 = Left (HeaderErrors V.empty (V.singleton (toStr h)) V.empty)
           | otherwise =
               let dups = V.singleton (V.map (\ix -> CellError ix (toStr (v V.! ix) {- (V.unsafeIndex v ix) -} )) ixs)
@@ -679,13 +684,13 @@ reverseVectorStrictList len sl0 = V.create $ do
   return mv
   where
   go1 :: forall s. MVector s c -> ST s ()
-  go1 !mv = go2 0 sl0
+  go1 !mv = go2 (len - 1) sl0
     where
     go2 :: Int -> StrictList c -> ST s ()
     go2 _ StrictListNil = return ()
     go2 !ix (StrictListCons c slNext) = do
       MV.write mv ix c
-      go2 (ix + 1) slNext
+      go2 (ix - 1) slNext
 
 
 skipWhile :: forall m a r. Monad m
@@ -704,6 +709,8 @@ skipWhile f = go where
         else return e
 
 -- | Strict in the spine and in the values
+-- This is built in reverse and then reversed by reverseVectorStrictList
+-- when converting to a vector.
 data StrictList a = StrictListNil | StrictListCons !a !(StrictList a)
 
 -- | This function uses 'unsafeIndex' to access
@@ -755,6 +762,16 @@ headed h f = SiphonAp (CE.Headed h) f (SiphonPure id)
 indexed :: Int -> (c -> Maybe a) -> Siphon Indexed c a
 indexed ix f = SiphonAp (Indexed ix) f (SiphonPure id)
 
+eqSiphonHeaders :: (Eq1 f, Eq c) => Siphon f c a -> Siphon f c b -> Bool
+eqSiphonHeaders (SiphonPure _) (SiphonPure _) = True
+eqSiphonHeaders (SiphonAp h0 _ s0) (SiphonAp h1 _ s1) =
+  liftEq (==) h0 h1 && eqSiphonHeaders s0 s1
+eqSiphonHeaders _ _ = False
+
+showSiphonHeaders :: (Show1 f, Show c) => Siphon f c a -> String
+showSiphonHeaders (SiphonPure _) = ""
+showSiphonHeaders (SiphonAp h0 _ s0) = showsPrec1 10 h0 (" :> " ++ showSiphonHeaders s0)
+
 -- $setup
 --
 -- This code is copied from the head section. It has to be

siphon/src/Siphon/Types.hs

@@ -15,6 +15,7 @@ module Siphon.Types
 import Data.Vector (Vector)
 import Control.Exception (Exception)
 import Data.Text (Text)
+import Data.Functor.Classes (Eq1,Show1,liftEq,liftShowsPrec)
 
 data CellError = CellError
   { cellErrorColumn :: !Int
@@ -25,6 +26,12 @@ newtype Indexed a = Indexed
   { indexedIndex :: Int
   } deriving (Eq,Ord,Functor,Show,Read)
 
+instance Show1 Indexed where
+  liftShowsPrec _ _ p (Indexed i) s = showsPrec p i s
+
+instance Eq1 Indexed where
+  liftEq _ (Indexed i) (Indexed j) = i == j
+
 data SiphonError = SiphonError
   { siphonErrorRow :: !Int
   , siphonErrorCause :: !RowError

siphon/test/Test.hs

@@ -4,33 +4,35 @@
 
 module Main (main) where
 
-import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)
-import Test.QuickCheck.Property (Result, succeeded, exception)
-import Test.HUnit (Assertion,(@?=))
-import Test.Framework (defaultMain, testGroup, Test)
-import Test.Framework.Providers.QuickCheck2 (testProperty)
-import Test.Framework.Providers.HUnit (testCase)
+import Colonnade (headed,headless,Colonnade,Headed,Headless)
+import Control.Exception
 import Data.ByteString (ByteString)
-import Data.Text (Text)
-import GHC.Generics (Generic)
+import Data.Char (ord)
 import Data.Either.Combinators
-import Siphon.Types
-import Data.Functor.Identity
 import Data.Functor.Contravariant           (contramap)
 import Data.Functor.Contravariant.Divisible (divided,conquered)
-import Colonnade (headed,headless,Colonnade,Headed,Headless)
+import Data.Functor.Identity
 import Data.Profunctor (lmap)
-import Streaming (Stream,Of(..))
-import Control.Exception
-import Debug.Trace
+import Data.Text (Text)
 import Data.Word (Word8)
-import Data.Char (ord)
+import Debug.Trace
+import GHC.Generics (Generic)
+import Siphon.Types
+import Streaming (Stream,Of(..))
+import Test.Framework (defaultMain, testGroup, Test)
+import Test.Framework.Providers.HUnit (testCase)
+import Test.Framework.Providers.QuickCheck2 (testProperty)
+import Test.HUnit (Assertion,(@?=))
+import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)
+import Test.QuickCheck.Property (Result, succeeded, exception)
+
 import qualified Data.Text as Text
 import qualified Data.ByteString.Builder as Builder
 import qualified Data.ByteString.Lazy as LByteString
 import qualified Data.ByteString as ByteString
 import qualified Data.ByteString.Char8 as BC8
 import qualified Data.ByteString as B
+import qualified Data.Vector as Vector
 import qualified Colonnade as Colonnade
 import qualified Siphon as S
 import qualified Streaming.Prelude as SMP
@@ -118,6 +120,30 @@ tests =
                 ]
               )
             ) @?= (["drew","martin, drew"] :> Nothing)
+    , testCase "headedToIndexed" $
+        let actual = S.headedToIndexed id (Vector.fromList ["letter","boolean","number"]) decodingG
+         in case actual of
+              Left e -> fail "headedToIndexed failed"
+              Right actualInner -> 
+                let expected = SiphonAp (Indexed 2 :: Indexed Text) (\_ -> Nothing)
+                             $ SiphonAp (Indexed 0 :: Indexed Text) (\_ -> Nothing)
+                             $ SiphonAp (Indexed 1 :: Indexed Text) (\_ -> Nothing)
+                             $ SiphonPure (\_ _ _ -> ())
+                 in case S.eqSiphonHeaders actualInner expected of
+                      True -> pure ()
+                      False -> fail $
+                        "Expected " ++
+                        S.showSiphonHeaders expected ++
+                        " but got " ++
+                        S.showSiphonHeaders actualInner
+    , testCase "Indexed Decoding (int,char,bool)"
+        $ ( runIdentity . SMP.toList )
+            ( S.decodeIndexedCsvUtf8 3 indexedDecodingB
+              ( mapM_ (SMP.yield . BC8.singleton) $ concat
+                [ "244,z,true\n"
+                ]
+              )
+            ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)
     , testProperty "Headed Isomorphism (int,char,bool)"
         $ propIsoStream BC8.unpack
           (S.decodeCsvUtf8 decodingB)
@@ -165,6 +191,18 @@ decodingB = (,,)
   <*> S.headed "letter" dbWord8
   <*> S.headed "boolean" dbBool
 
+indexedDecodingB :: Siphon Indexed ByteString (Int,Word8,Bool)
+indexedDecodingB = (,,)
+  <$> S.indexed 0 dbInt
+  <*> S.indexed 1 dbWord8
+  <*> S.indexed 2 dbBool
+
+decodingG :: Siphon Headed Text ()
+decodingG =
+  S.headed "number" (\_ -> Nothing)
+  <* S.headed "letter" (\_ -> Nothing)
+  <* S.headed "boolean" (\_ -> Nothing)
+
 decodingF :: Siphon Headed ByteString ByteString
 decodingF = S.headed "name" Just