pipes-break-0.2.0.0: test/Spec.hs

{-# LANGUAGE OverloadedStrings, TemplateHaskell, DeriveGeneric, GeneralizedNewtypeDeriving #-}

module Main (main) where


import Test.QuickCheck

import Control.Monad (void)

import Data.Tuple (swap)

import qualified Data.ByteString.Char8 as B

import Pipes as P
import qualified Pipes.Prelude as P

import Data.List (mapAccumL, isInfixOf)

import Pipes.Break.ByteString as PB

import Control.Monad.Identity

-- type BS = B.ByteString

-- debug :: (MonadIO m, Show a) => Producer a m (Producer a m r) -> m ()
-- debug p = do
--   (beg,rest) <- P.toListM' p
--   end <- P.toListM (void rest)
--      
--   liftIO $ putStrLn $ "beg:" <> show beg
--   liftIO $ putStrLn $ "rest:" <> show end
--   return ()

-- A string that most likely contains this delimiter or at least some parts of it in a few places
arbitraryStringWithDelimiter :: String -> Gen String
arbitraryStringWithDelimiter "" = arbitrary
arbitraryStringWithDelimiter del = do
  n <- choose (1,1000)
  mconcat <$> vectorOf n (oneof [return del, pieceOfDelim, someStr])
  where
    -- a long string where the delimiter is not contained in it
    someStr = arbitrary `suchThat` (\str -> not (del `isInfixOf` str))

    -- randomly pull out a peice of the delimiter
    pieceOfDelim = do
      beg <- choose (1,length del)
      end <- choose (0, beg - 1)
      return $ drop end $  take beg $ del

-- Split up a string into randomly sized chunks
arbitrarySplit :: String -> Gen [String]
arbitrarySplit bs = do
 offsets <- arbitrarySplits (length bs)
 let (rest, items) = mapAccumL (\str idx -> swap $ splitAt idx str) bs offsets
 return $ items ++ [rest]
 where
   arbitrarySplits :: Int -> Gen [Int]
   arbitrarySplits n = listOf (choose (0,10)) `suchThat` (\ls -> sum ls <= n)

-- For any delimiter, for any string that has pieces of that delimiter in it,
-- which has been broken up into random chunks, every call to breakBy should
-- at least be advancing the stream on each call.
prop_WillFinish :: String -> Property
prop_WillFinish delimiter =
  forAll (arbitraryStringWithDelimiter delimiter) $ \str ->
    forAll (arbitrarySplit str) $ \frags ->
      let remainder = runIdentity $ do
            rest <- runEffect $ breakBy (B.pack delimiter) (traverse (yield . B.pack) frags) >-> P.drain
            B.unpack . mconcat <$> P.toListM (void rest)
        
      in length str > 0 ==> length str > length remainder

-- Ensure invertibility of breaksBy and unBreaksBy
prop_BreaksEquiv :: String -> Property
prop_BreaksEquiv delimiter =
  forAll (arbitraryStringWithDelimiter delimiter) $ \str ->
    forAll (arbitrarySplit str) $ \frags ->
      str === B.unpack (breakByThenBackToStr (B.pack <$> frags) (B.pack delimiter))
  where
    breakByThenBackToStr :: [B.ByteString] -> B.ByteString -> B.ByteString
    breakByThenBackToStr frags br = mconcat $ P.toList (PB.unBreaksBy br $  PB.breaksBy br $ P.each frags)

-- Ensure invertibility of breakBy and unBreakBy
prop_BreakEquiv :: String -> Property
prop_BreakEquiv delimiter =
  forAll (arbitraryStringWithDelimiter delimiter) $ \str ->
    forAll (arbitrarySplit str) $ \frags ->
      str === (B.unpack $ mconcat $ P.toList $ unBreakBy (B.pack delimiter) $ breakBy (B.pack delimiter) $ P.each (B.pack <$> frags))


return []
runTests :: IO Bool
-- runTests = $verboseCheckAll
runTests = $quickCheckAll

main :: IO ()
main = void runTests