mirror of
https://github.com/byteverse/colonnade.git
synced 2024-09-11 06:45:41 +03:00
fix siphon more
This commit is contained in:
parent
7fdd984470
commit
56787f573c
@ -1,4 +1,4 @@
|
|||||||
packages: ./colonnade
|
packages: ./colonnade
|
||||||
./blaze-colonnade
|
./blaze-colonnade
|
||||||
./lucid-colonnade
|
./lucid-colonnade
|
||||||
./yesod-colonnade
|
./siphon
|
||||||
|
@ -57,6 +57,7 @@ import qualified Data.Attoparsec.Types as ATYP
|
|||||||
import qualified Colonnade.Encode as CE
|
import qualified Colonnade.Encode as CE
|
||||||
import qualified Data.Vector.Mutable as MV
|
import qualified Data.Vector.Mutable as MV
|
||||||
import qualified Data.ByteString.Builder as BB
|
import qualified Data.ByteString.Builder as BB
|
||||||
|
import qualified Data.Semigroup as SG
|
||||||
|
|
||||||
import Control.Monad.Trans.Class
|
import Control.Monad.Trans.Class
|
||||||
import Data.Functor.Identity (Identity(..))
|
import Data.Functor.Identity (Identity(..))
|
||||||
@ -72,6 +73,7 @@ import Streaming (Stream,Of(..))
|
|||||||
import Data.Vector.Mutable (MVector)
|
import Data.Vector.Mutable (MVector)
|
||||||
import Control.Monad.ST
|
import Control.Monad.ST
|
||||||
import Data.Text (Text)
|
import Data.Text (Text)
|
||||||
|
import Data.Semigroup (Semigroup)
|
||||||
|
|
||||||
newtype Escaped c = Escaped { getEscaped :: c }
|
newtype Escaped c = Escaped { getEscaped :: c }
|
||||||
data Ended = EndedYes | EndedNo
|
data Ended = EndedYes | EndedNo
|
||||||
@ -258,10 +260,13 @@ headedToIndexed toStr v =
|
|||||||
|
|
||||||
data HeaderErrors = HeaderErrors !(Vector (Vector CellError)) !(Vector T.Text) !(Vector Int)
|
data HeaderErrors = HeaderErrors !(Vector (Vector CellError)) !(Vector T.Text) !(Vector Int)
|
||||||
|
|
||||||
|
instance Semigroup HeaderErrors where
|
||||||
|
HeaderErrors a1 b1 c1 <> HeaderErrors a2 b2 c2 = HeaderErrors
|
||||||
|
(mappend a1 a2) (mappend b1 b2) (mappend c1 c2)
|
||||||
|
|
||||||
instance Monoid HeaderErrors where
|
instance Monoid HeaderErrors where
|
||||||
mempty = HeaderErrors mempty mempty mempty
|
mempty = HeaderErrors mempty mempty mempty
|
||||||
mappend (HeaderErrors a1 b1 c1) (HeaderErrors a2 b2 c2) = HeaderErrors
|
mappend = (SG.<>)
|
||||||
(mappend a1 a2) (mappend b1 b2) (mappend c1 c2)
|
|
||||||
|
|
||||||
-- byteStringChar8 :: Siphon ByteString
|
-- byteStringChar8 :: Siphon ByteString
|
||||||
-- byteStringChar8 = Siphon
|
-- byteStringChar8 = Siphon
|
||||||
@ -533,7 +538,7 @@ mapLeft f (Left a) = Left (f a)
|
|||||||
consumeHeaderRowUtf8 :: Monad m
|
consumeHeaderRowUtf8 :: Monad m
|
||||||
=> Stream (Of ByteString) m ()
|
=> Stream (Of ByteString) m ()
|
||||||
-> m (Either SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
|
-> m (Either SiphonError (Of (Vector ByteString) (Stream (Of ByteString) m ())))
|
||||||
consumeHeaderRowUtf8 = consumeHeaderRow utf8ToStr (A.parse (field comma)) B.null B.empty (\() -> True)
|
consumeHeaderRowUtf8 = consumeHeaderRow (A.parse (field comma)) B.null B.empty (\() -> True)
|
||||||
|
|
||||||
consumeBodyUtf8 :: forall m a. Monad m
|
consumeBodyUtf8 :: forall m a. Monad m
|
||||||
=> Int -- ^ index of first row, usually zero or one
|
=> Int -- ^ index of first row, usually zero or one
|
||||||
@ -548,14 +553,13 @@ utf8ToStr :: ByteString -> T.Text
|
|||||||
utf8ToStr = either (\_ -> T.empty) id . decodeUtf8'
|
utf8ToStr = either (\_ -> T.empty) id . decodeUtf8'
|
||||||
|
|
||||||
consumeHeaderRow :: forall m r c. Monad m
|
consumeHeaderRow :: forall m r c. Monad m
|
||||||
=> (c -> T.Text)
|
=> (c -> ATYP.IResult c (CellResult c))
|
||||||
-> (c -> ATYP.IResult c (CellResult c))
|
|
||||||
-> (c -> Bool) -- ^ true if null string
|
-> (c -> Bool) -- ^ true if null string
|
||||||
-> c
|
-> c
|
||||||
-> (r -> Bool) -- ^ true if termination is acceptable
|
-> (r -> Bool) -- ^ true if termination is acceptable
|
||||||
-> Stream (Of c) m r
|
-> Stream (Of c) m r
|
||||||
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
|
-> m (Either SiphonError (Of (Vector c) (Stream (Of c) m r)))
|
||||||
consumeHeaderRow toStr parseCell isNull emptyStr isGood s0 = go 0 StrictListNil s0
|
consumeHeaderRow parseCell isNull emptyStr isGood s0 = go 0 StrictListNil s0
|
||||||
where
|
where
|
||||||
go :: Int
|
go :: Int
|
||||||
-> StrictList c
|
-> StrictList c
|
||||||
|
@ -23,12 +23,15 @@ import Data.Profunctor (lmap)
|
|||||||
import Streaming (Stream,Of(..))
|
import Streaming (Stream,Of(..))
|
||||||
import Control.Exception
|
import Control.Exception
|
||||||
import Debug.Trace
|
import Debug.Trace
|
||||||
import qualified Data.Text as Text
|
import Data.Word (Word8)
|
||||||
import qualified Data.ByteString.Builder as Builder
|
import Data.Char (ord)
|
||||||
import qualified Data.ByteString.Lazy as LByteString
|
import qualified Data.Text as Text
|
||||||
import qualified Data.ByteString as ByteString
|
import qualified Data.ByteString.Builder as Builder
|
||||||
import qualified Data.ByteString.Char8 as BC8
|
import qualified Data.ByteString.Lazy as LByteString
|
||||||
import qualified Colonnade as Colonnade
|
import qualified Data.ByteString as ByteString
|
||||||
|
import qualified Data.ByteString.Char8 as BC8
|
||||||
|
import qualified Data.ByteString as B
|
||||||
|
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
|
||||||
import qualified Data.Text.Lazy as LText
|
import qualified Data.Text.Lazy as LText
|
||||||
@ -42,7 +45,7 @@ tests :: [Test]
|
|||||||
tests =
|
tests =
|
||||||
[ testGroup "ByteString encode/decode"
|
[ testGroup "ByteString encode/decode"
|
||||||
[ testCase "Headed Encoding (int,char,bool)"
|
[ testCase "Headed Encoding (int,char,bool)"
|
||||||
$ runTestScenario [(4,'c',False)]
|
$ runTestScenario [(4,intToWord8 (ord 'c'),False)]
|
||||||
S.encodeCsvStreamUtf8
|
S.encodeCsvStreamUtf8
|
||||||
encodingB
|
encodingB
|
||||||
$ ByteString.concat
|
$ ByteString.concat
|
||||||
@ -75,7 +78,7 @@ tests =
|
|||||||
, "244,z,true\n"
|
, "244,z,true\n"
|
||||||
]
|
]
|
||||||
)
|
)
|
||||||
) @?= ([(244,'z',True)] :> Nothing)
|
) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing)
|
||||||
, testCase "Headed Decoding (escaped characters, one big chunk)"
|
, testCase "Headed Decoding (escaped characters, one big chunk)"
|
||||||
$ ( runIdentity . SMP.toList )
|
$ ( runIdentity . SMP.toList )
|
||||||
( S.decodeCsvUtf8 decodingF
|
( S.decodeCsvUtf8 decodingF
|
||||||
@ -103,6 +106,9 @@ tests =
|
|||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|
||||||
|
intToWord8 :: Int -> Word8
|
||||||
|
intToWord8 = fromIntegral
|
||||||
|
|
||||||
data Foo = FooA | FooB | FooC
|
data Foo = FooA | FooB | FooC
|
||||||
deriving (Generic,Eq,Ord,Show,Read,Bounded,Enum)
|
deriving (Generic,Eq,Ord,Show,Read,Bounded,Enum)
|
||||||
|
|
||||||
@ -134,10 +140,10 @@ decodingA = (,,)
|
|||||||
<*> S.headless dbChar
|
<*> S.headless dbChar
|
||||||
<*> S.headless dbBool
|
<*> S.headless dbBool
|
||||||
|
|
||||||
decodingB :: Siphon Headed ByteString (Int,Char,Bool)
|
decodingB :: Siphon Headed ByteString (Int,Word8,Bool)
|
||||||
decodingB = (,,)
|
decodingB = (,,)
|
||||||
<$> S.headed "number" dbInt
|
<$> S.headed "number" dbInt
|
||||||
<*> S.headed "letter" dbChar
|
<*> S.headed "letter" dbWord8
|
||||||
<*> S.headed "boolean" dbBool
|
<*> S.headed "boolean" dbBool
|
||||||
|
|
||||||
decodingF :: Siphon Headed ByteString ByteString
|
decodingF :: Siphon Headed ByteString ByteString
|
||||||
@ -174,10 +180,10 @@ decodingY = (,,)
|
|||||||
encodingF :: Colonnade Headed ByteString ByteString
|
encodingF :: Colonnade Headed ByteString ByteString
|
||||||
encodingF = headed "name" id
|
encodingF = headed "name" id
|
||||||
|
|
||||||
encodingB :: Colonnade Headed (Int,Char,Bool) ByteString
|
encodingB :: Colonnade Headed (Int,Word8,Bool) ByteString
|
||||||
encodingB = mconcat
|
encodingB = mconcat
|
||||||
[ lmap fst3 (headed "number" ebInt)
|
[ lmap fst3 (headed "number" ebInt)
|
||||||
, lmap snd3 (headed "letter" ebChar)
|
, lmap snd3 (headed "letter" ebWord8)
|
||||||
, lmap thd3 (headed "boolean" ebBool)
|
, lmap thd3 (headed "boolean" ebBool)
|
||||||
]
|
]
|
||||||
|
|
||||||
@ -263,6 +269,11 @@ dbChar b = case BC8.length b of
|
|||||||
1 -> Just (BC8.head b)
|
1 -> Just (BC8.head b)
|
||||||
_ -> Nothing
|
_ -> Nothing
|
||||||
|
|
||||||
|
dbWord8 :: ByteString -> Maybe Word8
|
||||||
|
dbWord8 b = case B.length b of
|
||||||
|
1 -> Just (B.head b)
|
||||||
|
_ -> Nothing
|
||||||
|
|
||||||
dbInt :: ByteString -> Maybe Int
|
dbInt :: ByteString -> Maybe Int
|
||||||
dbInt b = do
|
dbInt b = do
|
||||||
(a,bsRem) <- BC8.readInt b
|
(a,bsRem) <- BC8.readInt b
|
||||||
@ -279,6 +290,9 @@ dbBool b
|
|||||||
ebChar :: Char -> ByteString
|
ebChar :: Char -> ByteString
|
||||||
ebChar = BC8.singleton
|
ebChar = BC8.singleton
|
||||||
|
|
||||||
|
ebWord8 :: Word8 -> ByteString
|
||||||
|
ebWord8 = B.singleton
|
||||||
|
|
||||||
ebInt :: Int -> ByteString
|
ebInt :: Int -> ByteString
|
||||||
ebInt = LByteString.toStrict
|
ebInt = LByteString.toStrict
|
||||||
. Builder.toLazyByteString
|
. Builder.toLazyByteString
|
||||||
|
@ -1,4 +1,4 @@
|
|||||||
resolver: lts-11.11
|
resolver: nightly-2018-06-11
|
||||||
packages:
|
packages:
|
||||||
- 'colonnade'
|
- 'colonnade'
|
||||||
- 'blaze-colonnade'
|
- 'blaze-colonnade'
|
||||||
|
Loading…
Reference in New Issue
Block a user