Making ByteString.hGetLine behave like System.IO.hGetLine

Data/ByteString.hs

@@ -1816,31 +1816,48 @@ hGetLine h =
                   else ioe_EOF
        else haveBuf h_ buf' len xss
 
-  haveBuf h_@Handle__{haByteBuffer}
+  haveBuf h_@Handle__{haByteBuffer, haInputNL}
           buf@Buffer{ bufRaw=raw, bufR=w, bufL=r }
           len xss =
     do
-        off <- findEOL r w raw
+        (off, sizeNewline) <- findEOL haInputNL r w raw
         let new_len = len + off - r
         xs <- mkPS raw r off
 
       -- if eol == True, then off is the offset of the '\n'
       -- otherwise off == w and the buffer is now empty.
         if off /= w
-            then do if w == off + 1
-                            then writeIORef haByteBuffer buf{ bufL=0, bufR=0 }
-                            else writeIORef haByteBuffer buf{ bufL = off + 1 }
-                    mkBigPS new_len (xs:xss)
+            then do
+                -- If off + sizeNewline == w then the remaining buffer is empty
+                if (off + sizeNewline) == w
+                  then writeIORef haByteBuffer buf{ bufL=0, bufR=0 }
+                  else writeIORef haByteBuffer buf{ bufL = off + sizeNewline }
+                mkBigPS new_len (xs:xss)
             else fill h_ buf{ bufL=0, bufR=0 } new_len (xs:xss)
 
   -- find the end-of-line character, if there is one
-  findEOL r w raw
-        | r == w = return w
+  findEOL haInputNL r w raw
+        | r == w = return (w, 0)
         | otherwise =  do
             c <- readWord8Buf raw r
             if c == fromIntegral (ord '\n')
-                then return r -- NB. not r+1: don't include the '\n'
-                else findEOL (r+1) w raw
+                then do
+                   -- NB. not r+1: don't include the '\n'
+                   -- Also, it is important that it ends the line in both modes
+                   -- To match System.IO.hGetLine's behavior
+                  return (r, 1)
+                else if haInputNL == CRLF && c == fromIntegral (ord '\r') && r+1 < w
+                  then do
+                    c' <- readWord8Buf raw (r+1)
+                    if c' == fromIntegral (ord '\n')
+                      then return (r, 2)  -- NB. not r+1 or r+2: don't include the '\r\n'
+                      else do
+                        -- We cannot jump 2 characters ahead
+                        -- because if we encountered '\r\r\n'
+                        -- We would miss the pattern starting on the second '\r'
+                        findEOL haInputNL (r+1) w raw
+                  else findEOL haInputNL (r+1) w raw
+
 
 mkPS :: RawBuffer Word8 -> Int -> Int -> IO ByteString
 mkPS buf start end =

tests/Properties.hs

@@ -1614,6 +1614,36 @@ prop_read_write_file_D x = unsafePerformIO $ do
         (const $ do y <- D.readFile f
                     return (x==y))
 
+prop_hgetline_like_s8_hgetline (LinedASCII filetext) (lineEndIn, lineEndOut) = idempotentIOProperty $ do
+    tid <- myThreadId
+    let f = "qc-test-"++show tid
+    let newlineMode = NewlineMode (if lineEndIn then LF else CRLF) (if lineEndOut then LF else CRLF)
+    bracket_
+        (writeFile f filetext)
+        (removeFile f)
+        $ do 
+            bsLines <- withFile f ReadMode (\h -> do
+                hSetNewlineMode h newlineMode
+                readByLines C.hGetLine h
+              )
+            sLines <- withFile f ReadMode (\h -> do
+                hSetNewlineMode h newlineMode
+                readByLines System.IO.hGetLine h
+              )
+            return $ map C.unpack bsLines === sLines
+
+  where
+    readByLines getLine h_ = go []
+      where 
+        go lines = do
+          isEnd <- hIsEOF h_
+          if isEnd
+            then return lines
+            else do
+              !nextLine <- getLine h_
+              go (nextLine : lines)
+
+
 ------------------------------------------------------------------------
 
 prop_append_file_P x y = unsafePerformIO $ do
@@ -1791,7 +1821,8 @@ io_tests =
     , testProperty "appendFile        " prop_append_file_D
 
     , testProperty "packAddress       " prop_packAddress
-
+
+    , testProperty "pack.hGetLine=hGetLine" prop_hgetline_like_s8_hgetline
     ]
 
 misc_tests =

tests/QuickCheckUtils.hs

@@ -93,6 +93,22 @@ instance Arbitrary String8 where
       toChar :: Word8 -> Char
       toChar = toEnum . fromIntegral
 
+-- | Strings, but each char is ASCII and there are a lot of newlines generated
+-- 
+newtype LinedASCII = LinedASCII String
+  deriving (Eq, Ord, Show)
+
+instance Arbitrary LinedASCII where
+  arbitrary = fmap LinedASCII . listOf . oneof $
+    [ arbitraryASCIIChar
+    , elements ['\n', '\r']
+    ]
+
+  shrink (LinedASCII s) = fmap LinedASCII (shrink s)
+
+instance CoArbitrary LinedASCII where
+  coarbitrary (LinedASCII s) = coarbitrary s
+
 ------------------------------------------------------------------------
 --
 -- We're doing two forms of testing here. Firstly, model based testing.