fix siphon more

cabal.project

@@ -1,4 +1,4 @@
 packages: ./colonnade
           ./blaze-colonnade
           ./lucid-colonnade
-          ./yesod-colonnade
+          ./siphon

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 = (SG.<>)
-    (mappend a1 a2) (mappend b1 b2) (mappend c1 c2)
 
 -- 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

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 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 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 

stack.yaml

@@ -1,4 +1,4 @@
-resolver: lts-11.11
+resolver: nightly-2018-06-11
 packages:
 - 'colonnade'
 - 'blaze-colonnade'