module Break
( breakEnd
, breakSep
, prop_breakEnd_sepPred
, prop_breakEnd_constPred
, prop_breakSep_firstSep
, prop_breakSep_falsePred
, prop_breakSep_truePred
, prop_breakSep_generalizesBreak
)
where

import Control.Arrow
import qualified Data.ByteString as BS
import Data.Maybe
import Data.Word
import Test.QuickCheck

breakEnd :: (a -> Bool) -> [a] -> ([a], [a])
breakEnd p xs =
  case breakSep p xs of
    (pre,  Just (s, post)) -> first ((pre++) . (s:)) . breakEnd p $ post
    (post, Nothing)        -> ([], post)

breakSep :: (a -> Bool) -> [a] -> ([a], Maybe (a, [a]))
breakSep p (x:xs)
  | p x       = ([], Just (x, xs))
  | otherwise = first (x:) . breakSep p $ xs
breakSep _ e@[] = (e, Nothing)

prop_breakEnd_sepPred :: [Word8] -> Word8 -> [Word8] -> Property
prop_breakEnd_sepPred pre sep post =
  breakEnd_matches "prop_breakEnd_sepPred: "
                   (== sep) (pre ++ [sep] ++ post)

prop_breakEnd_constPred :: Bool -> [Word8] -> Property
prop_breakEnd_constPred b xs =
  breakEnd_matches "prop_breakEnd_constPred: "
                   (const b) xs

breakEnd_matches :: String -> (Word8 -> Bool) -> [Word8] -> Property
breakEnd_matches prefix p str =
  assert prefix (==)
         ((BS.unpack *** BS.unpack) $ BS.breakEnd p (BS.pack str))
         (breakEnd p $ str)

prop_breakSep_firstSep :: [Word8] -> Word8 -> [Word8] -> Property
prop_breakSep_firstSep pre sep post =
  not (sep `elem` pre) ==>
    assert "prop_breakSep_firstSep: " (==)
           (pre, Just (sep, post))
           (breakSep (== sep) (pre ++ [sep] ++ post))

prop_breakSep_falsePred :: [Word8] -> Property
prop_breakSep_falsePred xs =
  assert "prop_breakSep_falsePred: " (==)
         (xs, Nothing) (breakSep (const False) xs)

prop_breakSep_truePred :: [Word8] -> Property
prop_breakSep_truePred xs@(x:xs') =
  assert "prop_breakSep_truePred: " (==)
         ([], Just (x, xs')) (breakSep (const True) xs)
prop_breakSep_truePred xs@[] =
  assert "prop_breakSep_truePred: " (==)
         ([], Nothing) (breakSep (const True) xs)

prop_breakSep_generalizesBreak :: [Word8] -> Word8 -> [Word8] -> Property
prop_breakSep_generalizesBreak pre sep post =
  not (sep `elem` pre) ==>
    assert "prop_breakSep_generalizesBreak: " (==)
           (break (== sep) str)
           (second (uncurry (:) . fromJust) . breakSep (== sep) $ str)
  where
    str = pre ++ [sep] ++ post

assert :: Show a => String -> (a -> a -> Bool) -> a -> a -> Property
assert prefix op expected actual =
  let message = prefix ++ "Expected " ++ show expected
                       ++ ", got "    ++ show actual
  in  printTestCase message (expected `op` actual)