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
|
main-is: Test.hs
|
||||||
build-depends:
|
build-depends:
|
||||||
base
|
base
|
||||||
, either
|
, HUnit
|
||||||
, siphon
|
, QuickCheck
|
||||||
|
, bytestring
|
||||||
, colonnade
|
, colonnade
|
||||||
, contravariant
|
, contravariant
|
||||||
, test-framework
|
, either
|
||||||
, test-framework-quickcheck2
|
|
||||||
, QuickCheck
|
|
||||||
, text
|
|
||||||
, bytestring
|
|
||||||
, pipes
|
, pipes
|
||||||
, HUnit
|
|
||||||
, test-framework-hunit
|
|
||||||
, profunctors
|
, profunctors
|
||||||
|
, siphon
|
||||||
, streaming
|
, streaming
|
||||||
|
, test-framework
|
||||||
|
, test-framework-hunit
|
||||||
|
, test-framework-quickcheck2
|
||||||
|
, text
|
||||||
|
, vector
|
||||||
default-language: Haskell2010
|
default-language: Haskell2010
|
||||||
|
|
||||||
source-repository head
|
source-repository head
|
||||||
|
@ -28,8 +28,12 @@ module Siphon
|
|||||||
, Siphon
|
, Siphon
|
||||||
, SiphonError(..)
|
, SiphonError(..)
|
||||||
, Indexed(..)
|
, Indexed(..)
|
||||||
|
-- * For Testing
|
||||||
|
, headedToIndexed
|
||||||
-- * Utility
|
-- * Utility
|
||||||
, humanizeSiphonError
|
, humanizeSiphonError
|
||||||
|
, eqSiphonHeaders
|
||||||
|
, showSiphonHeaders
|
||||||
-- * Imports
|
-- * Imports
|
||||||
-- $setup
|
-- $setup
|
||||||
) where
|
) where
|
||||||
@ -38,6 +42,7 @@ import Siphon.Types
|
|||||||
import Data.Monoid
|
import Data.Monoid
|
||||||
import Control.Applicative
|
import Control.Applicative
|
||||||
import Control.Monad
|
import Control.Monad
|
||||||
|
import Data.Functor.Classes (Eq1,Show1,liftEq,showsPrec1)
|
||||||
|
|
||||||
import qualified Data.ByteString.Char8 as BC8
|
import qualified Data.ByteString.Char8 as BC8
|
||||||
import qualified Data.Attoparsec.ByteString as A
|
import qualified Data.Attoparsec.ByteString as A
|
||||||
@ -263,7 +268,7 @@ headedToIndexed toStr v =
|
|||||||
ixs = V.elemIndices h v
|
ixs = V.elemIndices h v
|
||||||
ixsLen = V.length ixs
|
ixsLen = V.length ixs
|
||||||
rcurrent
|
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)
|
| ixsLen == 0 = Left (HeaderErrors V.empty (V.singleton (toStr h)) V.empty)
|
||||||
| otherwise =
|
| otherwise =
|
||||||
let dups = V.singleton (V.map (\ix -> CellError ix (toStr (v V.! ix) {- (V.unsafeIndex v ix) -} )) ixs)
|
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
|
return mv
|
||||||
where
|
where
|
||||||
go1 :: forall s. MVector s c -> ST s ()
|
go1 :: forall s. MVector s c -> ST s ()
|
||||||
go1 !mv = go2 0 sl0
|
go1 !mv = go2 (len - 1) sl0
|
||||||
where
|
where
|
||||||
go2 :: Int -> StrictList c -> ST s ()
|
go2 :: Int -> StrictList c -> ST s ()
|
||||||
go2 _ StrictListNil = return ()
|
go2 _ StrictListNil = return ()
|
||||||
go2 !ix (StrictListCons c slNext) = do
|
go2 !ix (StrictListCons c slNext) = do
|
||||||
MV.write mv ix c
|
MV.write mv ix c
|
||||||
go2 (ix + 1) slNext
|
go2 (ix - 1) slNext
|
||||||
|
|
||||||
|
|
||||||
skipWhile :: forall m a r. Monad m
|
skipWhile :: forall m a r. Monad m
|
||||||
@ -704,6 +709,8 @@ skipWhile f = go where
|
|||||||
else return e
|
else return e
|
||||||
|
|
||||||
-- | Strict in the spine and in the values
|
-- | 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)
|
data StrictList a = StrictListNil | StrictListCons !a !(StrictList a)
|
||||||
|
|
||||||
-- | This function uses 'unsafeIndex' to access
|
-- | 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 :: Int -> (c -> Maybe a) -> Siphon Indexed c a
|
||||||
indexed ix f = SiphonAp (Indexed ix) f (SiphonPure id)
|
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
|
-- $setup
|
||||||
--
|
--
|
||||||
-- This code is copied from the head section. It has to be
|
-- This code is copied from the head section. It has to be
|
||||||
|
@ -15,6 +15,7 @@ module Siphon.Types
|
|||||||
import Data.Vector (Vector)
|
import Data.Vector (Vector)
|
||||||
import Control.Exception (Exception)
|
import Control.Exception (Exception)
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Data.Functor.Classes (Eq1,Show1,liftEq,liftShowsPrec)
|
||||||
|
|
||||||
data CellError = CellError
|
data CellError = CellError
|
||||||
{ cellErrorColumn :: !Int
|
{ cellErrorColumn :: !Int
|
||||||
@ -25,6 +26,12 @@ newtype Indexed a = Indexed
|
|||||||
{ indexedIndex :: Int
|
{ indexedIndex :: Int
|
||||||
} deriving (Eq,Ord,Functor,Show,Read)
|
} 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
|
data SiphonError = SiphonError
|
||||||
{ siphonErrorRow :: !Int
|
{ siphonErrorRow :: !Int
|
||||||
, siphonErrorCause :: !RowError
|
, siphonErrorCause :: !RowError
|
||||||
|
@ -4,33 +4,35 @@
|
|||||||
|
|
||||||
module Main (main) where
|
module Main (main) where
|
||||||
|
|
||||||
import Test.QuickCheck (Gen, Arbitrary(..), choose, elements, Property)
|
import Colonnade (headed,headless,Colonnade,Headed,Headless)
|
||||||
import Test.QuickCheck.Property (Result, succeeded, exception)
|
import Control.Exception
|
||||||
import Test.HUnit (Assertion,(@?=))
|
|
||||||
import Test.Framework (defaultMain, testGroup, Test)
|
|
||||||
import Test.Framework.Providers.QuickCheck2 (testProperty)
|
|
||||||
import Test.Framework.Providers.HUnit (testCase)
|
|
||||||
import Data.ByteString (ByteString)
|
import Data.ByteString (ByteString)
|
||||||
import Data.Text (Text)
|
import Data.Char (ord)
|
||||||
import GHC.Generics (Generic)
|
|
||||||
import Data.Either.Combinators
|
import Data.Either.Combinators
|
||||||
import Siphon.Types
|
|
||||||
import Data.Functor.Identity
|
|
||||||
import Data.Functor.Contravariant (contramap)
|
import Data.Functor.Contravariant (contramap)
|
||||||
import Data.Functor.Contravariant.Divisible (divided,conquered)
|
import Data.Functor.Contravariant.Divisible (divided,conquered)
|
||||||
import Colonnade (headed,headless,Colonnade,Headed,Headless)
|
import Data.Functor.Identity
|
||||||
import Data.Profunctor (lmap)
|
import Data.Profunctor (lmap)
|
||||||
import Streaming (Stream,Of(..))
|
import Data.Text (Text)
|
||||||
import Control.Exception
|
|
||||||
import Debug.Trace
|
|
||||||
import Data.Word (Word8)
|
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.Text as Text
|
||||||
import qualified Data.ByteString.Builder as Builder
|
import qualified Data.ByteString.Builder as Builder
|
||||||
import qualified Data.ByteString.Lazy as LByteString
|
import qualified Data.ByteString.Lazy as LByteString
|
||||||
import qualified Data.ByteString as ByteString
|
import qualified Data.ByteString as ByteString
|
||||||
import qualified Data.ByteString.Char8 as BC8
|
import qualified Data.ByteString.Char8 as BC8
|
||||||
import qualified Data.ByteString as B
|
import qualified Data.ByteString as B
|
||||||
|
import qualified Data.Vector as Vector
|
||||||
import qualified Colonnade as Colonnade
|
import qualified Colonnade as Colonnade
|
||||||
import qualified Siphon as S
|
import qualified Siphon as S
|
||||||
import qualified Streaming.Prelude as SMP
|
import qualified Streaming.Prelude as SMP
|
||||||
@ -118,6 +120,30 @@ tests =
|
|||||||
]
|
]
|
||||||
)
|
)
|
||||||
) @?= (["drew","martin, drew"] :> Nothing)
|
) @?= (["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)"
|
, testProperty "Headed Isomorphism (int,char,bool)"
|
||||||
$ propIsoStream BC8.unpack
|
$ propIsoStream BC8.unpack
|
||||||
(S.decodeCsvUtf8 decodingB)
|
(S.decodeCsvUtf8 decodingB)
|
||||||
@ -165,6 +191,18 @@ decodingB = (,,)
|
|||||||
<*> S.headed "letter" dbWord8
|
<*> S.headed "letter" dbWord8
|
||||||
<*> S.headed "boolean" dbBool
|
<*> 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 :: Siphon Headed ByteString ByteString
|
||||||
decodingF = S.headed "name" Just
|
decodingF = S.headed "name" Just
|
||||||
|
|
||||||
|
Loading…
Reference in New Issue
Block a user