mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
Fix siphon indexed decode to not reverse indices
This commit is contained in:
parent
7f664c7dfe
commit
142b373289
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
@ -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
|
||||
|
||||
|
Loading…
Reference in New Issue
Block a user