diff --git a/siphon/siphon.cabal b/siphon/siphon.cabal index 6954fbf..306ad25 100644 --- a/siphon/siphon.cabal +++ b/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 diff --git a/siphon/src/Siphon.hs b/siphon/src/Siphon.hs index 5fb13bc..7ffe8db 100644 --- a/siphon/src/Siphon.hs +++ b/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 diff --git a/siphon/src/Siphon/Types.hs b/siphon/src/Siphon/Types.hs index 17fd386..2f04376 100644 --- a/siphon/src/Siphon/Types.hs +++ b/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 diff --git a/siphon/test/Test.hs b/siphon/test/Test.hs index 06f7af2..5886d7b 100644 --- a/siphon/test/Test.hs +++ b/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