diff --git a/cabal.project b/cabal.project index 2829611..c51a100 100644 --- a/cabal.project +++ b/cabal.project @@ -1,4 +1,4 @@ packages: ./colonnade ./blaze-colonnade ./lucid-colonnade - ./yesod-colonnade + ./siphon diff --git a/siphon/src/Siphon.hs b/siphon/src/Siphon.hs index 8f46484..bb618e3 100644 --- a/siphon/src/Siphon.hs +++ b/siphon/src/Siphon.hs @@ -57,6 +57,7 @@ import qualified Data.Attoparsec.Types as ATYP import qualified Colonnade.Encode as CE import qualified Data.Vector.Mutable as MV import qualified Data.ByteString.Builder as BB +import qualified Data.Semigroup as SG import Control.Monad.Trans.Class import Data.Functor.Identity (Identity(..)) @@ -72,6 +73,7 @@ import Streaming (Stream,Of(..)) import Data.Vector.Mutable (MVector) import Control.Monad.ST import Data.Text (Text) +import Data.Semigroup (Semigroup) newtype Escaped c = Escaped { getEscaped :: c } data Ended = EndedYes | EndedNo @@ -258,10 +260,13 @@ headedToIndexed toStr v = 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 mempty = HeaderErrors mempty mempty mempty - mappend (HeaderErrors a1 b1 c1) (HeaderErrors a2 b2 c2) = HeaderErrors - (mappend a1 a2) (mappend b1 b2) (mappend c1 c2) + mappend = (SG.<>) -- byteStringChar8 :: Siphon ByteString -- byteStringChar8 = Siphon @@ -533,7 +538,7 @@ mapLeft f (Left a) = Left (f a) consumeHeaderRowUtf8 :: Monad m => 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 => Int -- ^ index of first row, usually zero or one @@ -548,14 +553,13 @@ utf8ToStr :: ByteString -> T.Text utf8ToStr = either (\_ -> T.empty) id . decodeUtf8' 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 -> (r -> Bool) -- ^ true if termination is acceptable -> 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 go :: Int -> StrictList c diff --git a/siphon/test/Test.hs b/siphon/test/Test.hs index 77b6ab0..4fc6791 100644 --- a/siphon/test/Test.hs +++ b/siphon/test/Test.hs @@ -23,12 +23,15 @@ import Data.Profunctor (lmap) import Streaming (Stream,Of(..)) import Control.Exception import Debug.Trace -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 Colonnade as Colonnade +import Data.Word (Word8) +import Data.Char (ord) +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 Colonnade as Colonnade import qualified Siphon as S import qualified Streaming.Prelude as SMP import qualified Data.Text.Lazy as LText @@ -42,7 +45,7 @@ tests :: [Test] tests = [ testGroup "ByteString encode/decode" [ testCase "Headed Encoding (int,char,bool)" - $ runTestScenario [(4,'c',False)] + $ runTestScenario [(4,intToWord8 (ord 'c'),False)] S.encodeCsvStreamUtf8 encodingB $ ByteString.concat @@ -75,7 +78,7 @@ tests = , "244,z,true\n" ] ) - ) @?= ([(244,'z',True)] :> Nothing) + ) @?= ([(244,intToWord8 (ord 'z'),True)] :> Nothing) , testCase "Headed Decoding (escaped characters, one big chunk)" $ ( runIdentity . SMP.toList ) ( S.decodeCsvUtf8 decodingF @@ -103,6 +106,9 @@ tests = ] ] +intToWord8 :: Int -> Word8 +intToWord8 = fromIntegral + data Foo = FooA | FooB | FooC deriving (Generic,Eq,Ord,Show,Read,Bounded,Enum) @@ -134,10 +140,10 @@ decodingA = (,,) <*> S.headless dbChar <*> S.headless dbBool -decodingB :: Siphon Headed ByteString (Int,Char,Bool) +decodingB :: Siphon Headed ByteString (Int,Word8,Bool) decodingB = (,,) <$> S.headed "number" dbInt - <*> S.headed "letter" dbChar + <*> S.headed "letter" dbWord8 <*> S.headed "boolean" dbBool decodingF :: Siphon Headed ByteString ByteString @@ -174,10 +180,10 @@ decodingY = (,,) encodingF :: Colonnade Headed ByteString ByteString encodingF = headed "name" id -encodingB :: Colonnade Headed (Int,Char,Bool) ByteString +encodingB :: Colonnade Headed (Int,Word8,Bool) ByteString encodingB = mconcat [ lmap fst3 (headed "number" ebInt) - , lmap snd3 (headed "letter" ebChar) + , lmap snd3 (headed "letter" ebWord8) , lmap thd3 (headed "boolean" ebBool) ] @@ -263,6 +269,11 @@ dbChar b = case BC8.length b of 1 -> Just (BC8.head b) _ -> Nothing +dbWord8 :: ByteString -> Maybe Word8 +dbWord8 b = case B.length b of + 1 -> Just (B.head b) + _ -> Nothing + dbInt :: ByteString -> Maybe Int dbInt b = do (a,bsRem) <- BC8.readInt b @@ -279,6 +290,9 @@ dbBool b ebChar :: Char -> ByteString ebChar = BC8.singleton +ebWord8 :: Word8 -> ByteString +ebWord8 = B.singleton + ebInt :: Int -> ByteString ebInt = LByteString.toStrict . Builder.toLazyByteString diff --git a/stack.yaml b/stack.yaml index c65dbe6..e026e1c 100644 --- a/stack.yaml +++ b/stack.yaml @@ -1,4 +1,4 @@ -resolver: lts-11.11 +resolver: nightly-2018-06-11 packages: - 'colonnade' - 'blaze-colonnade'