DPutils 0.0.2.0 → 0.1.0.0

raw patch · 7 files changed

+407/−272 lines, 7 filesdep +primitivedep +smallcheckdep +tasty-smallcheckdep ~QuickCheckdep ~basedep ~pipesPVP ok

version bump matches the API change (PVP)

Dependencies added: primitive, smallcheck, tasty-smallcheck

Dependency ranges changed: QuickCheck, base, pipes, streaming, streaming-bytestring, vector

API changes (from Hackage documentation)

Files

• DP/Backtraced/Core.hs +78/−0
• DPutils.cabal +58/−66
• Streaming/Primitive.hs +16/−0
• changelog.md +6/−0
• tests/QuickCheck.hs +203/−0
• tests/SmallCheck.hs +31/−0
• tests/properties.hs +15/−206

@@ -0,0 +1,78 @@++-- | The base constructors for generic backtracing.+--+-- NOTE this currently can capture dot-bracket notation, but not deep+-- semantics.++module DP.Backtraced.Core where++import           Control.Lens+import           Data.Foldable+import           GHC.Generics (Generic)+import qualified Data.Sequence as Seq+import qualified Test.QuickCheck as QC+import qualified Test.SmallCheck.Series as SC++-- | This is a bit like a lazy "Data.Sequence" in terms of constructors. We can+-- not be spine-strict, otherwise we'd use @Data.Sequence@ and enjoy the better+-- performance.++data Backtraced ty where+  -- | This backtrace is done+  Epsilon ∷ Backtraced ty+  -- | Expand a backtrace to the left. This is lazy, since backtracing relies+  -- on laziness.+  Cons ∷ ty → Backtraced ty → Backtraced ty+  -- | Expand lazily to the right.+  Snoc ∷ Backtraced ty → ty → Backtraced ty+  -- | concatenate two structures+  Append ∷ Backtraced ty → Backtraced ty → Backtraced ty+  deriving (Eq,Ord,Show,Read,Generic,Functor,Foldable,Traversable)++-- | This is somewhat tricky, since we might have to walk down the structure+-- quite a bit and shuffle constructors without changing the actual leaf order.++instance Cons (Backtraced ty) (Backtraced ty') ty ty' where+  {-# Inlinable _Cons #-}+  _Cons =+    let go1 Epsilon = Left Epsilon+        go1 (Cons x xs)    = Right (x,xs)+        go1 (Snoc xs x)    = go2 xs (Left x)+        go1 (Append xs ys) = go2 xs (Right ys)+        go2 Epsilon        (Left y)   = Right (y,Epsilon)+        go2 Epsilon        (Right ys) = go1 ys+        go2 (Cons x xs)    (Left y)   = Right (x,Snoc xs y)+        go2 (Cons x xs)    (Right ys) = Right (x, Append xs ys)+        go2 (Snoc xs x)    (Left y)   = go2 xs (Right $ x `Cons` Epsilon `Snoc` y)+        go2 (Snoc xs x)    (Right ys) = go2 xs (Right $ x `Cons` ys)+        go2 (Append xs ys) (Left z)   = go2 xs (Right $ ys `Snoc` z)+        go2 (Append xs ys) (Right zs) = go2 xs (Right $ ys `Append` zs)+    in  prism (uncurry Cons) go1++instance Snoc (Backtraced ty) (Backtraced ty') ty ty' where+  {-# Inlinable _Snoc #-}+  _Snoc =+    let go1 Epsilon = Left Epsilon+        go1 (Cons x xs)    = go2 (Left x) xs+        go1 (Snoc xs x)    = Right (xs,x)+        go1 (Append xs ys) = go2 (Right xs) ys+        go2 (Left x)   Epsilon        = Right (Epsilon,x)+        go2 (Right xs) Epsilon        = go1 xs+        go2 (Left x)   (Cons y ys)    = go2 (Right $ x `Cons` (y `Cons` Epsilon)) ys+        go2 (Right xs) (Cons y ys)    = go2 (Right $ xs `Snoc` y) ys+        go2 (Left x)   (Snoc ys y)    = Right (x `Cons` ys, y)+        go2 (Right xs) (Snoc ys y)    = Right (xs `Append` ys, y)+        go2 (Left x)   (Append ys zs) = go2 (Right $ x `Cons` ys) zs+        go2 (Right xs) (Append ys zs) = go2 (Right $ xs `Append` ys) zs+    in  prism (uncurry Snoc) go1++(<|) = Cons+(|>) = Snoc+(><) = Append++infixr 5 <|+infixr 5 ><+infixl 5 |>++instance SC.Serial m a ⇒ SC.Serial m (Backtraced a)+

@@ -1,20 +1,21 @@+Cabal-version:  2.2 Name:           DPutils-Version:        0.0.2.0-License:        BSD3+Version:        0.1.0.0+License:        BSD-3-Clause License-file:   LICENSE Maintainer:     choener@bioinf.uni-leipzig.de-author:         Christian Hoener zu Siederdissen, 2016-2018-copyright:      Christian Hoener zu Siederdissen, 2016-2018+author:         Christian Hoener zu Siederdissen, 2016-2019+copyright:      Christian Hoener zu Siederdissen, 2016-2019 homepage:       https://github.com/choener/DPutils bug-reports:    https://github.com/choener/DPutils/issues Stability:      Experimental Category:       Data Build-type:     Simple-Cabal-version:  >=1.10.0 tested-with:    GHC == 8.4.4 Synopsis:       utilities for DP Description:-                Small set of utility functions+                Small set of utility functions, as well as the base types for+                generic backtracing.                 .  @@ -25,37 +26,48 @@   -Library-  Exposed-modules:-    Data.Attoparsec.ByteString.Streaming-    Data.ByteString.Streaming.Split-    Data.Char.Util-    Data.Paired.Common-    Data.Paired.Foldable-    Data.Paired.Vector-    Data.Vector.Generic.Unstream-    Math.TriangularNumbers-    Pipes.Parallel-    Pipes.Split.ByteString+common deps   build-depends: base                 >= 4.7    &&  < 5.0                , attoparsec           >= 0.13                , bytestring                , containers+               , criterion            >= 1.1                , kan-extensions       >= 4.0+               , lens                 >= 4.0+               , mtl                , parallel             >= 3.0                , pipes                >= 4.0+               , pipes-bytestring     >= 2.0+               , pipes-parse          >= 3.0+               , primitive            >= 0.6                , QuickCheck           >= 2.7                , streaming            >= 0.1                , streaming-bytestring >= 0.1                , stringsearch         >= 0.3+               , smallcheck           >= 1.1+               , tasty                >= 0.11+               , tasty-quickcheck     >= 0.8+               , tasty-smallcheck     >= 0.8+               , tasty-th             >= 0.1                , transformers         >= 0.5                , vector               >= 0.10   default-extensions: BangPatterns                     , CPP+                    , DeriveGeneric+                    , DeriveFunctor+                    , DeriveFoldable+                    , DeriveTraversable                     , FlexibleContexts+                    , FlexibleInstances+                    , GADTs+                    , LambdaCase+                    , MultiParamTypeClasses                     , RankNTypes                     , ScopedTypeVariables+                    , TemplateHaskell+                    , TypeApplications                     , TypeFamilies+                    , UndecidableInstances                     , UnicodeSyntax   default-language:     Haskell2010@@ -64,81 +76,61 @@     -funbox-strict-fields  +Library+  import: deps+  Exposed-modules:+    Data.Attoparsec.ByteString.Streaming+    Data.ByteString.Streaming.Split+    Data.Char.Util+    Data.Paired.Common+    Data.Paired.Foldable+    Data.Paired.Vector+    Data.Vector.Generic.Unstream+    DP.Backtraced.Core+    Math.TriangularNumbers+    Pipes.Parallel+    Pipes.Split.ByteString+    Streaming.Primitive ++ test-suite properties+  import:+    deps+  build-depends:+    DPutils   type:     exitcode-stdio-1.0   main-is:     properties.hs+  other-modules:+    QuickCheck+    SmallCheck   ghc-options:-    -O2 -threaded -rtsopts -with-rtsopts=-N+    -threaded -rtsopts -with-rtsopts=-N   hs-source-dirs:     tests-  default-language:-    Haskell2010-  default-extensions: CPP-                    , RankNTypes-                    , ScopedTypeVariables-                    , TemplateHaskell-  build-depends: base-               , bytestring-               , containers-               , lens                 >= 4.0-               , mtl-               , pipes-               , pipes-bytestring     >= 2.0-               , pipes-parse          >= 3.0-               , QuickCheck-               , streaming-               , streaming-bytestring-               , tasty                >= 0.11-               , tasty-quickcheck     >= 0.8-               , tasty-th             >= 0.1-               , vector-               ---               , DPutils    benchmark benchmark+  import: deps   type:     exitcode-stdio-1.0-  build-depends: base-               , criterion            >= 1.1-               , streaming-               , streaming-bytestring-               , vector-               ---               , DPutils   hs-source-dirs:     tests   main-is:     benchmark.hs-  default-language:-    Haskell2010-  ghc-options:-    -O2    benchmark streaming+  import: deps   type:     exitcode-stdio-1.0-  build-depends: base-               , streaming-               , streaming-bytestring-               , bytestring-               , timeit               >= 2.0-               ---               , DPutils+  build-depends: timeit               >= 2.0   hs-source-dirs:     tests-  default-extensions: BangPatterns-                    , CPP-                    , RankNTypes-                    , ScopedTypeVariables-                    , TemplateHaskell-                    , UnicodeSyntax   main-is:     streaming.hs   default-language:

@@ -0,0 +1,16 @@++module Streaming.Primitive where++import Control.Monad.Primitive+import Streaming++++-- | Orphan instance providing a primitive monad instance for streams. Allows+-- impurely folds into mutable vectors from streams.++instance (Monad m, PrimMonad m, Functor f) ⇒ PrimMonad (Stream f m) where+  type PrimState (Stream f m) = PrimState m+  {-# Inline primitive #-}+  primitive = lift . primitive+

@@ -1,3 +1,9 @@+0.1.0.0+-------++- DP.Backtraced.Core provide a "core" system for backtraces in DP algorithms,+  splitting out individual tapes+ 0.0.2.0 ------- 

@@ -0,0 +1,203 @@++module QuickCheck where++import Data.List as L+import Data.Map.Strict as M+import Data.Tuple (swap)+import Data.Vector as V+import Debug.Trace+import Test.QuickCheck+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++-- * 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.+++testQuickCheck = $(testGroupGenerator)+

@@ -0,0 +1,31 @@++module SmallCheck where++import Control.Arrow (second)+import Control.Lens+import Data.Foldable+import Debug.Trace+import Test.SmallCheck+import Test.SmallCheck.Drivers+import Test.Tasty.SmallCheck as SC+import Test.Tasty.TH++import DP.Backtraced.Core++++-- prop_BackTraced_Cons+--   ∷ forall m+--   . ( Monad m )+--   ⇒ Proxy a → Property m++-- xprop_Backtraced_Cons ∷ Monad m ⇒ m (Maybe PropertyFailure)+prop_Backtraced_Cons = changeDepth (const 4) $+  {- smallCheckM 4 $ -} \(bt ∷ Backtraced Bool) →+    let lst = toList bt+        btC ∷ Maybe (Bool,[Bool])+        btC = fmap (second toList) $ bt^?_Cons+--    in  traceShow (bt) $ traceShow (bt^?_Cons,lst^?_Cons) (btC == lst^?_Cons) -- bt^._Cons == lst^._Cons+    in  btC == lst^?_Cons++testSmallCheck = $(testGroupGenerator)

@@ -1,217 +1,26 @@  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           Control.Lens+--import           Control.Monad.Identity+--import           Data.ByteString (ByteString)+--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.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 ]-+--import           Test.Tasty.SmallCheck as SC ------ | 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)+--import           Pipes.Split.ByteString -skeMult :: Int-skeMult = 1000+import QuickCheck+import SmallCheck   --- * Streaming tests.-- main :: IO ()-main = $(defaultMainGenerator)+main = do+  defaultMain $ testGroup "all tests" [testQuickCheck, testSmallCheck]