{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE StandaloneDeriving #-}
module Main where
import Data.List.Split.Internals
import Test.QuickCheck
import Test.QuickCheck.Function
import Control.Monad
import System.Environment
import Text.Printf
import Data.Char
import Data.Functor
import Data.List (genericTake, group, intercalate,
isInfixOf, isPrefixOf, isSuffixOf,
tails)
import Data.Maybe (isJust)
newtype Elt = Elt { unElt :: Char }
deriving (Eq)
instance Show Elt where
show (Elt c) = show c
instance Arbitrary Elt where
arbitrary = elements (map Elt "abcde")
instance CoArbitrary Elt where
coarbitrary = coarbitrary . ord . unElt
instance Function Elt where
function = functionMap unElt Elt
deriving instance Show (Splitter Elt)
instance Show (Delimiter Elt) where
show (Delimiter ps) = show (map function ps)
instance (Arbitrary a, CoArbitrary a, Function a) => Arbitrary (Delimiter a) where
arbitrary = (Delimiter . map apply) <$> arbitrary
instance Arbitrary a => Arbitrary (Chunk a) where
arbitrary = oneof [ liftM Text (listOf arbitrary)
, liftM Delim (listOf arbitrary)
]
instance Arbitrary DelimPolicy where
arbitrary = elements [Drop, Keep, KeepLeft, KeepRight]
instance Arbitrary CondensePolicy where
arbitrary = elements [Condense, KeepBlankFields]
instance Arbitrary EndPolicy where
arbitrary = elements [DropBlank, KeepBlank]
instance (Arbitrary a, CoArbitrary a, Function a) => Arbitrary (Splitter a) where
arbitrary = liftM5 Splitter arbitrary arbitrary arbitrary arbitrary arbitrary
type Delim a = [Fun a Bool]
unDelim :: Delim a -> Delimiter a
unDelim = Delimiter . map apply
main :: IO ()
main = do
results <- mapM (\(s,t) -> printf "%-40s" s >> t) tests
when (not . all isSuccess $ results) $ fail "Not all tests passed!"
where
isSuccess (Success{}) = True
isSuccess _ = False
qc x = quickCheckWithResult (stdArgs { maxSuccess = 200 }) x
tests = [ ("default/id", qc prop_default_id)
, ("match/decompose", qc prop_match_decompose)
, ("match/yields delim", qc prop_match_yields_delim)
, ("splitInternal/lossless", qc prop_splitInternal_lossless)
, ("splitInternal/yields delims", qc prop_splitInternal_yields_delims)
, ("splitInternal/text", qc prop_splitInternal_text_not_delims)
, ("doCondense/no consec delims", qc prop_doCondense_no_consec_delims)
, ("insBlanks/no consec delims", qc prop_insBlanks_no_consec_delims)
, ("insBlanks/fl not delims", qc prop_insBlanks_fl_not_delim)
, ("mergeL/no delims", qc prop_mergeL_no_delims)
, ("mergeR/no delims", qc prop_mergeR_no_delims)
, ("oneOf", qc prop_oneOf)
, ("oneOf/not text", qc prop_oneOf_not_text)
, ("onSublist", qc prop_onSublist)
, ("onSublist/not text", qc prop_onSublist_not_text)
, ("whenElt", qc prop_whenElt)
, ("whenElt/not text", qc prop_whenElt_not_text)
, ("process/dropDelims", qc prop_dropDelims)
, ("process/keepDelimsL no delims", qc prop_keepDelimsL_no_delims)
, ("process/keepDelimsR no delims", qc prop_keepDelimsR_no_delims)
, ("process/keepDelimsL match", qc prop_keepDelimsL_match)
, ("process/keepDelimsR match", qc prop_keepDelimsR_match)
, ("condense/no consec delims", qc prop_condense_no_consec_delims)
, ("condense/all delims", qc prop_condense_all_delims)
, ("dropInitBlank", qc prop_dropInitBlank)
, ("dropFinalBlank", qc prop_dropFinalBlank)
, ("dropBlanks", qc prop_dropBlanks)
, ("startsWith", qc prop_startsWith)
, ("startsWithOneOf", qc prop_startsWithOneOf)
, ("endsWith", qc prop_endsWith)
, ("endsWithOneOf", qc prop_endsWithOneOf)
, ("splitOn/right inv", qc prop_splitOn_right_inv)
, ("splitOn/idem", qc prop_splitOn_intercalate_idem)
, ("splitOn/empty delim", qc prop_splitOn_empty_delim)
, ("split/empty delim", qc prop_split_empty_delim_drop)
, ("chunksOf/lengths", qc prop_chunksOf_all_n)
, ("chunksOf/last <= n", qc prop_chunksOf_last_less_n)
, ("chunksOf/preserve", qc prop_chunksOf_preserve)
, ("splitPlaces/lengths", qc prop_splitPlaces_lengths)
, ("splitPlaces/last <= n", qc prop_splitPlaces_last_less_n)
, ("splitPlaces/preserve", qc prop_splitPlaces_preserve)
, ("splitPlaces/chunksOf", qc prop_splitPlaces_chunksOf)
, ("splitPlacesB/length", qc prop_splitPlacesB_length)
, ("splitPlacesB/last <= n", qc prop_splitPlacesB_last_less_n)
, ("splitPlacesB/preserve", qc prop_splitPlacesB_preserve)
, ("lines", qc prop_lines)
, ("wordsBy/words", qc prop_wordsBy_words)
, ("linesBy/lines", qc prop_linesBy_lines)
, ("chop/group", qc prop_chop_group)
, ("chop/words", qc prop_chop_words)
, ("divvy/evenly", qc prop_divvy_evenly)
, ("divvy/discard_remainder", qc prop_divvy_discard_remainder)
, ("divvy/outputlists_allsame_length", qc prop_divvy_outputlists_allsame_length)
, ("divvy/output_are_sublists", qc prop_divvy_output_are_sublists)
, ("divvy/heads", qc prop_divvy_heads)
]
prop_default_id :: [Elt] -> Bool
prop_default_id l = split defaultSplitter l == [l]
prop_match_decompose :: Delim Elt -> [Elt] -> Bool
prop_match_decompose d l = maybe True ((==l) . uncurry (++)) $ matchDelim (unDelim d) l
isDelimMatch :: Delim Elt -> [Elt] -> Bool
isDelimMatch d l = matchDelim (unDelim d) l == Just (l,[])
prop_match_yields_delim :: Delim Elt -> [Elt] -> Bool
prop_match_yields_delim d l =
case matchDelim (unDelim d) l of
Nothing -> True
Just (del,rest) -> isDelimMatch d del
prop_splitInternal_lossless :: Delim Elt -> [Elt] -> Bool
prop_splitInternal_lossless d l = concatMap fromElem (splitInternal (unDelim d) l) == l
prop_splitInternal_yields_delims :: Delim Elt -> [Elt] -> Bool
prop_splitInternal_yields_delims d l =
all (isDelimMatch d) $ [ del | (Delim del) <- splitInternal d' l ]
where d' = unDelim d
prop_splitInternal_text_not_delims :: Delim Elt -> [Elt] -> Bool
prop_splitInternal_text_not_delims d l =
all (not . isDelimMatch d) $ [ ch | (Text ch) <- splitInternal d' l ]
where d' = unDelim d
noConsecDelims :: SplitList Elt -> Bool
noConsecDelims [] = True
noConsecDelims [x] = True
noConsecDelims (Delim _ : Delim _ : _) = False
noConsecDelims (_ : xs) = noConsecDelims xs
prop_doCondense_no_consec_delims :: SplitList Elt -> Bool
prop_doCondense_no_consec_delims l = noConsecDelims $ doCondense Condense l
prop_insBlanks_no_consec_delims :: SplitList Elt -> Bool
prop_insBlanks_no_consec_delims l = noConsecDelims $ insertBlanks Condense l
prop_insBlanks_fl_not_delim :: SplitList Elt -> Bool
prop_insBlanks_fl_not_delim l =
case insertBlanks Condense l of
[] -> True
xs -> (not . isDelim $ head xs) && (not . isDelim $ last xs)
prop_mergeL_no_delims :: SplitList Elt -> Bool
prop_mergeL_no_delims = all (not . isDelim) . mergeLeft . insertBlanks Condense
prop_mergeR_no_delims :: SplitList Elt -> Bool
prop_mergeR_no_delims = all (not . isDelim) . mergeRight . insertBlanks Condense
getDelims :: Splitter Elt -> [Elt] -> [[Elt]]
getDelims s l = [ d | Delim d <- splitInternal (delimiter s) l ]
getTexts :: Splitter Elt -> [Elt] -> [[Elt]]
getTexts s l = [ c | Text c <- splitInternal (delimiter s) l ]
prop_oneOf :: [Elt] -> [Elt] -> Bool
prop_oneOf elts l = all ((==1) . length) ds && all ((`elem` elts) . head) ds
where ds = getDelims (oneOf elts) l
prop_oneOf_not_text :: [Elt] -> [Elt] -> Bool
prop_oneOf_not_text elts l = all (not . (`elem` elts)) (concat cs)
where cs = getTexts (oneOf elts) l
prop_onSublist :: [Elt] -> [Elt] -> Bool
prop_onSublist sub l = all (==sub) $ getDelims (onSublist sub) l
prop_onSublist_not_text :: [Elt] -> [Elt] -> Property
prop_onSublist_not_text sub l =
(not . null $ sub) ==>
all (not . isInfixOf sub) $ getTexts (onSublist sub) l
prop_whenElt :: (Fun Elt Bool) -> [Elt] -> Bool
prop_whenElt (Fun _ p) l = all ((==1) . length) ds && all (p . head) ds
where ds = getDelims (whenElt p) l
prop_whenElt_not_text :: (Fun Elt Bool) -> [Elt] -> Bool
prop_whenElt_not_text (Fun _ p) l = all (not . p) (concat cs)
where cs = getTexts (whenElt p) l
process :: Splitter Elt -> [Elt] -> SplitList Elt
process s = postProcess s . splitInternal (delimiter s)
prop_dropDelims :: Splitter Elt -> [Elt] -> Bool
prop_dropDelims s l = all (not . isDelim) (process (dropDelims s) l)
prop_keepDelimsL_no_delims :: Splitter Elt -> [Elt] -> Bool
prop_keepDelimsL_no_delims s l = all (not . isDelim) (process (keepDelimsL s) l)
prop_keepDelimsL_match :: Splitter Elt -> NonEmptyList Elt -> Bool
prop_keepDelimsL_match s (NonEmpty l) =
all (isJust . matchDelim (delimiter s)) [ c | Text c <- tail p ]
where p = process (keepDelimsL s) l
prop_keepDelimsR_no_delims :: Splitter Elt -> [Elt] -> Bool
prop_keepDelimsR_no_delims s l = all (not . isDelim) (process (keepDelimsR s) l)
prop_keepDelimsR_match :: Splitter Elt -> NonEmptyList Elt -> Bool
prop_keepDelimsR_match s (NonEmpty l) =
all (any (isJust . matchDelim (delimiter s)) . tails)
[ c | Text c <- init p ]
where p = process (keepDelimsR s) l
prop_condense_no_consec_delims :: Splitter Elt -> [Elt] -> Bool
prop_condense_no_consec_delims s l = noConsecDelims $ process (condense s) l
prop_condense_all_delims :: Splitter Elt -> [Elt] -> Bool
prop_condense_all_delims s l = all allDelims p
where p = [ d | Delim d <- process (condense s) l ]
allDelims t = all isDelim (splitInternal (delimiter s) t)
prop_dropInitBlank :: Splitter Elt -> NonEmptyList Elt -> Bool
prop_dropInitBlank s (NonEmpty l) = head p /= Text []
where p = process (dropInitBlank $ s { delimPolicy = Keep } ) l
prop_dropFinalBlank :: Splitter Elt -> NonEmptyList Elt -> Bool
prop_dropFinalBlank s (NonEmpty l) = last p /= Text []
where p = process (dropFinalBlank $ s { delimPolicy = Keep } ) l
prop_dropBlanks :: Splitter Elt -> [Elt] -> Bool
prop_dropBlanks s = null . filter (== (Text [])) . process (dropBlanks s)
prop_startsWith :: [Elt] -> NonEmptyList Elt -> Bool
prop_startsWith s (NonEmpty l) = all (s `isPrefixOf`) (tail $ split (startsWith s) l)
prop_startsWithOneOf :: [Elt] -> NonEmptyList Elt -> Bool
prop_startsWithOneOf elts (NonEmpty l) = all ((`elem` elts) . head) (tail $ split (startsWithOneOf elts) l)
prop_endsWith :: [Elt] -> NonEmptyList Elt -> Bool
prop_endsWith s (NonEmpty l) = all (s `isSuffixOf`) (init $ split (endsWith s) l)
prop_endsWithOneOf :: [Elt] -> NonEmptyList Elt -> Bool
prop_endsWithOneOf elts (NonEmpty l) = all ((`elem` elts) . last) (init $ split (endsWithOneOf elts) l)
prop_splitOn_right_inv :: [Elt] -> [Elt] -> Bool
prop_splitOn_right_inv x l = intercalate x (splitOn x l) == l
{- This property fails: for example,
splitOn "dd" (intercalate "dd" ["d",""]) == ["","d"]
so it's not enough just to say that the delimiter is not an infix of
any elements of l!
prop_splitOn_left_inv :: [Elt] -> NonEmptyList [Elt] -> Property
prop_splitOn_left_inv x (NonEmpty ls) = not (any (x `isInfixOf`) ls) ==>
splitOn x (intercalate x ls) == ls
-}
-- Note, the below property is in fact logically entailed by
-- prop_splitOn_right_inv, but we keep it here just for kicks.
prop_splitOn_intercalate_idem :: [Elt] -> [[Elt]] -> Bool
prop_splitOn_intercalate_idem x ls = f (f ls) == f ls
where f = splitOn x . intercalate x
prop_splitOn_empty_delim :: [Elt] -> Bool
prop_splitOn_empty_delim ls = splitOn [] ls == [] : map (:[]) ls
prop_split_empty_delim_drop :: [Elt] -> Bool
prop_split_empty_delim_drop ls
= split (dropDelims . dropBlanks $ onSublist []) ls == map (:[]) ls
prop_chunksOf_all_n :: Positive Int -> NonEmptyList Elt -> Bool
prop_chunksOf_all_n (Positive n) (NonEmpty l) = all ((==n) . length) (init $ chunksOf n l)
prop_chunksOf_last_less_n :: Positive Int -> NonEmptyList Elt -> Bool
prop_chunksOf_last_less_n (Positive n) (NonEmpty l) = (<=n) . length . last $ chunksOf n l
prop_chunksOf_preserve :: Positive Int -> [Elt] -> Bool
prop_chunksOf_preserve (Positive n) l = concat (chunksOf n l) == l
prop_splitPlaces_lengths :: [NonNegative Int] -> [Elt] -> Bool
prop_splitPlaces_lengths ps = and . mInit . zipWith (==) ps' . map length . splitPlaces ps'
where ps' = map unNN ps
prop_splitPlaces_last_less_n :: NonEmptyList (NonNegative Int) -> NonEmptyList Elt -> Bool
prop_splitPlaces_last_less_n (NonEmpty ps) (NonEmpty l) = (head $ drop (length l' - 1) ps') >= length (last l')
where l' = splitPlaces ps' l
ps' = map unNN ps
prop_splitPlaces_preserve :: [NonNegative Integer] -> [Elt] -> Bool
prop_splitPlaces_preserve ps l = concat (splitPlaces ps' l) == genericTake (sum ps') l
where ps' = map unNN ps
prop_splitPlaces_chunksOf :: Positive Int -> [Elt] -> Bool
prop_splitPlaces_chunksOf (Positive n) l = splitPlaces (repeat n) l == chunksOf n l
prop_splitPlacesB_length :: [NonNegative Int] -> [Elt] -> Bool
prop_splitPlacesB_length ps xs = length ps' == length (splitPlacesBlanks ps' xs)
where ps' = map unNN ps
prop_splitPlacesB_last_less_n :: NonEmptyList (NonNegative Int) -> NonEmptyList Elt -> Bool
prop_splitPlacesB_last_less_n (NonEmpty ps) (NonEmpty l) = (head $ drop (length l' - 1) ps') >= length (last l')
where l' = splitPlacesBlanks ps' l
ps' = map unNN ps
prop_splitPlacesB_preserve :: [NonNegative Integer] -> [Elt] -> Bool
prop_splitPlacesB_preserve ps l = concat (splitPlacesBlanks ps' l) == genericTake (sum ps') l
where ps' = map unNN ps
unNN :: NonNegative a -> a
unNN (NonNegative x) = x
mInit :: [a] -> [a]
mInit [] = []
mInit [x] = []
mInit (x:xs) = x : init xs
newtype EltWS = EltWS { unEltWS :: Char }
deriving (Eq, Show)
instance Arbitrary EltWS where
arbitrary = elements (map EltWS "abcde \n")
prop_lines :: [EltWS] -> Bool
prop_lines s = lines s' == endBy "\n" s'
where s' = map unEltWS s
prop_wordsBy_words :: [EltWS] -> Bool
prop_wordsBy_words s = words s' == wordsBy isSpace s'
where s' = map unEltWS s
prop_linesBy_lines :: [EltWS] -> Bool
prop_linesBy_lines s = lines s' == linesBy (=='\n') s'
where s' = map unEltWS s
prop_chop_group :: [Elt] -> Bool
prop_chop_group s = chop (\xs@(x:_) -> span (==x) xs) s == group s
prop_chop_words :: [EltWS] -> Bool
prop_chop_words s = words s' == (filter (not . null) . chop (span (not . isSpace) . dropWhile isSpace) $ s')
where s' = map unEltWS s
prop_divvy_evenly :: [Elt] -> Positive Int -> Bool
prop_divvy_evenly elems (Positive n) = concat (divvy n n elems') == elems'
where
-- Chop off the smallest possible tail of elems to make the length
-- evenly divisible by n. This property used to have a
-- precondition (length elemens `mod` n == 0), but that led to too
-- many discarded test cases and occasional test suite failures.
elems' = take ((length elems `div` n) * n) elems
prop_divvy_discard_remainder :: [Elt] -> Positive Int -> Bool
prop_divvy_discard_remainder elems (Positive n) =
concat (divvy n n elems) == (reverse . drop (length elems `mod` n) . reverse $ elems)
prop_divvy_outputlists_allsame_length :: [Elt] -> Positive Int -> Positive Int -> Bool
prop_divvy_outputlists_allsame_length elems (Positive n) (Positive m) = allSame xs
where
allSame :: [Int] -> Bool
allSame [] = True
allSame zs = and $ map (== head zs) (tail zs)
xs = map length (divvy n m elems)
prop_divvy_output_are_sublists :: [Elt] -> Positive Int -> Positive Int -> Bool
prop_divvy_output_are_sublists elems (Positive n) (Positive m) = and $ map (\x -> isInfixOf x elems) xs
where xs = divvy n m elems
takeEvery :: Int -> [a] -> [a]
takeEvery _ [] = []
takeEvery n lst = (map head . chunksOf n) $ lst
initNth :: Int -> [a] -> [a]
initNth _ [] = []
initNth n lst = (reverse . drop n . reverse) $ lst
prop_divvy_heads :: [Elt] -> Positive Int -> Positive Int -> Bool
prop_divvy_heads [] _ _ = True
prop_divvy_heads elems (Positive n) (Positive m) = hds1 == hds2
where hds1 = takeEvery m (initNth (n - 1) elems)
hds2 = map head $ divvy n m elems