DPutils-0.0.2.0: tests/properties.hs

module Main where

import           Control.Lens
import           Control.Monad.Identity
import           Data.ByteString (ByteString)
import           Data.List as L
import           Data.Map.Strict as M
import           Data.Tuple (swap)
import           Data.Vector as V
import           Debug.Trace
import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSL
import qualified Pipes as P
import qualified Pipes.ByteString as PB
import qualified Pipes.Parse as PP
import qualified Pipes.Prelude as P
import           Test.QuickCheck
import           Test.Tasty
import           Test.Tasty.QuickCheck as QC
import           Test.Tasty.TH

import           Data.Paired.Foldable as DPF
import           Data.Paired.Vector as DPV
import           Math.TriangularNumbers
import           Pipes.Split.ByteString



-- * Data.Paired.Vector

-- |

prop_vector_upperTri_On :: NonNegative Int -> Bool
prop_vector_upperTri_On (NonNegative k) = V.toList vs == ls
  where vs = snd $ upperTriVG OnDiag v
        ls = [ (a,b)
             | as@(a:_) <- L.init . L.tails $ V.toList v
             , b <- as
             ]
        v = V.enumFromTo 0 k

-- |

prop_vector_upperTri_No :: NonNegative Int -> Bool
prop_vector_upperTri_No (NonNegative k) = V.toList vs == ls
  where vs = snd $ upperTriVG NoDiag v
        ls = [ (a,b)
             | (a:as) <- L.init . L.tails $ V.toList v
             , b <- as
             ]
        v = V.enumFromTo 0 k

-- |

prop_vector_rectangular :: NonNegative Int -> NonNegative Int -> Bool
prop_vector_rectangular (NonNegative k) (NonNegative l) = V.toList vs == ls
  where vs = snd $ rectangularVG as bs
        ls = [ (a,b)
             | a <- V.toList as
             , b <- V.toList bs
             ]
        as = V.enumFromTo 0 k
        bs = V.enumFromTo 0 l



-- * Data.Paired.Foldable

-- | Generalized upper triangular elements. We want to enumerate all
-- elements, including those on the main diagonal.

prop_foldable_upperTri_On_All :: (NonNegative Int, Bool) -> Bool
prop_foldable_upperTri_On_All (NonNegative n, b)
  | chk       = True
  | otherwise = traceShow (ls,vs) False
  where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) OnDiag All xs
        ls = [ ((a,b),(a,b))
             | as@(a:_) <- L.init . L.tails $ xs
             , b <- as
             ]
        xs = [ 0 .. n-1 ]
        chk = vs == ls

-- | Only a subset of elements, starting at @k@ (counting from 0) and
-- taking @s@ elements.

prop_foldable_upperTri_On_FromN :: (NonNegative Int, NonNegative Int, NonNegative Int, Bool) -> Bool
prop_foldable_upperTri_On_FromN (NonNegative n, NonNegative k, NonNegative s, b)
  | chk       = True
  | otherwise = traceShow (ls,vs) False
  where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) OnDiag (FromN k s) xs
        ls = L.take s
           . L.drop k
           $ [ ((a,b),(a,b))
             | as@(a:_) <- L.init . L.tails $ xs
             , b <- as
             ]
        xs = [ 0 .. n-1 ]
        chk = vs == ls

prop_foldable_upperTri_No_All :: (NonNegative Int, Bool) -> Bool
prop_foldable_upperTri_No_All (NonNegative n, b)
  | chk       = True
  | otherwise = traceShow (ls,vs) False
  where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) NoDiag All xs
        ls = [ ((a,b),(a,b))
             | (a:as) <- L.init . L.tails $ xs
             , b <- as
             ]
        xs = [ 0 .. n-1 ]
        chk = vs == ls

prop_foldable_upperTri_No_FromN :: (NonNegative Int, NonNegative Int, NonNegative Int, Bool) -> Bool
prop_foldable_upperTri_No_FromN (NonNegative n, NonNegative k, NonNegative s, b)
  | chk       = True
  | otherwise = traceShow (ls,vs) False
  where Right (_,_,vs) = DPF.upperTri (if b then KnownSize n else UnknownSize) NoDiag (FromN k s) xs
        ls = L.take s
           . L.drop k
           $ [ ((a,b),(a,b))
             | (a:as) <- L.init . L.tails $ xs
             , b <- as
             ]
        xs = [ 0 .. n-1 ]
        chk = vs == ls



-- * Math.TriangularNumbers

-- | Test that each index pair @(i,j)@ is assigned a unique linear index
-- @k@ given @0 <= i <= j <= n@.

prop_uniqueLinear :: NonNegative Int -> Bool
prop_uniqueLinear (NonNegative n) = M.null $ M.filter ((/=1) . L.length) mp
  where mp = M.fromListWith (L.++) [ (toLinear n (i,j), [(i,j)]) | i <- [0..n], j <- [i..n] ]

-- | Back and forth translation between paired and linear indices is
-- unique.

prop_BackForth :: NonNegative Int -> Bool
prop_BackForth (NonNegative n) = L.and xs
  where mb = M.fromList ls
        mf = M.fromList $ L.map swap ls
        ls = [ (toLinear n (i,j), (i,j)) | i <- [0..n], j <- [i..n] ]
        xs = [ (mb M.! k == (i,j)) && (mf M.! (i,j) == k) && fromLinear n k == (i,j)
             | (k,(i,j)) <- ls ]

--

-- | Check if both splitKeepEnd and simple tokenization provide the same
-- result.

prop_splitKeepEndStrict :: String -> Small Int -> Small Int -> Bool
prop_splitKeepEndStrict str' (Small k) (Small l)
  | tt == ss  = True
  | otherwise = traceShow ("ske",pat,str,k,l,tt,ss,ee) False
  where str = BS.concat . L.replicate skeMult $ BS.pack str'
        -- make a small pattern with a chance that it repeats
        pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str
        -- what ske thinks is a good split
        (ss,ee,_) = ske pat str
        -- manual splitting
        tt = referenceByteStringTokenizer pat str

-- | Check if both splitKeepEnd and simple tokenization provide the same
-- result.

prop_splitKeepEndLazy :: String -> Small Int -> Small Int -> Bool
prop_splitKeepEndLazy str' (Small k) (Small l)
  | tt == ll  = True
  | otherwise = traceShow ("ske'",pat,str',str,strL,k,l,tt,ll,ee,rr) False
  where str = BS.concat . L.replicate skeMult $ BS.pack str'
        strL = BSL.fromChunks $ L.replicate skeMult $ BS.pack str'
        -- make a small pattern with a chance that it repeats
        pat = BS.take (l `mod` 2 + 1) $ BS.drop (k `mod` 10) str
        -- what we get with the lazy version
        (ll,ee,rr) = ske' pat strL
        -- manual splitting
        tt = referenceByteStringTokenizer pat str

-- The actual splitting system

ske :: ByteString -> ByteString -> ([ByteString],[ByteString],[ByteString])
ske pat str | BS.null pat || BS.null str = ([],[],[])
ske pat str =
  let parse = do
        xs <- zoom (splitKeepEnd pat) PP.drawAll
        case xs of
          [] -> return $ Left []
          xs -> return $ Right $ BS.concat xs
      (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PP.yield str
  in (a,b, fst . runIdentity . P.toListM' $ p)

ske' :: ByteString -> BSL.ByteString -> ([ByteString],[ByteString],[ByteString])
ske' pat _ | BS.null pat = ([],[],[])
ske' pat str =
  let parse = do
        xs <- zoom (splitKeepEnd pat) PP.drawAll
        case xs of
          [] -> return $ Left []
          xs -> return $ Right $ BS.concat xs
      (a,(b,p)) = runIdentity . P.toListM' $ PP.parsed parse $ PB.fromLazy str
  in (a,b, fst . runIdentity . P.toListM' $ p)

skeMult :: Int
skeMult = 1000



-- * Streaming tests.


main :: IO ()
main = $(defaultMainGenerator)