packages feed

sydtest 0.15.1.0 → 0.15.1.1

raw patch · 9 files changed

+49/−553 lines, 9 filesdep +fast-myers-diff

Dependencies added: fast-myers-diff

Files

CHANGELOG.md view
@@ -1,5 +1,11 @@ # Changelog +## [0.15.1.1] - 2023-10-04++* Compatibility with `optparse-applicative > 0.18`.+* Compatibility with `GHC >= 9.7`.+* Refactored out `fast-myers-diff` into its own package.+ ## [0.15.1.0] - 2023-07-28  * `setupAroundWithAll`: so it's easier to use multiple outer resources to provide an inner resource, without the need of extra type annotation.
− src/Test/Syd/Diff.hs
@@ -1,527 +0,0 @@-{-# LANGUAGE LambdaCase #-}-{-# LANGUAGE RankNTypes #-}-{-# LANGUAGE ScopedTypeVariables #-}-{-# OPTIONS_GHC -Wno-unused-imports -Werror=name-shadowing #-}--module Test.Syd.Diff-  ( -- * Diffing-    Diff,-    PolyDiff (..),-    getTextDiff,-    getStringDiff,-    getGroupedStringDiff,-    getVectorDiff,-    getGroupedVectorDiff,-    getVectorDiffBy,-    getGroupedVectorDiffBy,--    -- ** Internals-    Edit (..),-    getEditScript,-    getEditScriptBy,-    computeDiffFromEditScript,-    computeGroupedDiffFromEditScript,--    -- ** Backwards compatibility with @Diff@-    getDiff,-    getDiffBy,-    getGroupedDiff,-    getGroupedDiffBy,-  )-where--import Control.Monad-import Control.Monad.ST-import Data.DList (DList)-import qualified Data.DList as DList-import Data.Maybe (fromJust)-import Data.STRef-import Data.Text (Text)-import qualified Data.Text as T-import qualified Data.Text.Array as TA-import Data.Vector (Vector, (!))-import qualified Data.Vector as V-import Data.Vector.Mutable (MVector)-import qualified Data.Vector.Mutable as MV--type Diff a = PolyDiff a a--mapDiff :: (a -> b) -> Diff a -> Diff b-mapDiff f = bimapPolyDiff f f---- | A value is either from the 'First' list, the 'Second' or from 'Both'.--- 'Both' contains both the left and right values, in case you are using a form--- of equality that doesn't check all data (for example, if you are using a--- newtype to only perform equality on side of a tuple).-data PolyDiff a b = First a | Second b | Both a b-  deriving (Show, Eq)--bimapPolyDiff :: (a -> c) -> (b -> d) -> PolyDiff a b -> PolyDiff c d-bimapPolyDiff f g = \case-  First a -> First (f a)-  Second b -> Second (g b)-  Both a b -> Both (f a) (g b)---- |------ For backward compatibility with 'Diff', use more specific functions if you can.-getDiff :: Eq a => [a] -> [a] -> [Diff a]-getDiff = getDiffBy (==)---- |------ For backward compatibility with 'Diff', use more specific functions if you can.-getDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff a b]-getDiffBy eq as bs = V.toList (getVectorDiffBy eq (V.fromList as) (V.fromList bs))---- |------ For backward compatibility with 'Diff', use more specific functions if you can.-getGroupedDiff :: Eq a => [a] -> [a] -> [Diff [a]]-getGroupedDiff = getGroupedDiffBy (==)---- |------ For backward compatibility with 'Diff', use more specific functions if you can.-getGroupedDiffBy :: (a -> b -> Bool) -> [a] -> [b] -> [PolyDiff [a] [b]]-getGroupedDiffBy eq as bs = V.toList (V.map (bimapPolyDiff V.toList V.toList) (getGroupedVectorDiffBy eq (V.fromList as) (V.fromList bs)))---- | Text diff------ Uses pack and unpack, so does not roundtrip.--- It uses pack and unpack because 'Text' is not the same as @Vector Char@;--- You can't index a text in O(1) time, it takes O(n) time.-getTextDiff :: Text -> Text -> Vector (Diff Text)-getTextDiff expected actual = V.map (mapDiff packFromVector) $ getGroupedVectorDiff (unpackToVector expected) (unpackToVector actual)-  where-    packFromVector :: Vector Char -> Text-    packFromVector = T.pack . V.toList-    unpackToVector :: Text -> Vector Char-    unpackToVector = V.fromList . T.unpack---- | 'String' diff------ You probably want to use 'getTextDiff' with packed strings instead, but this--- function doesn't have the roundtripping problem that 'getTextDiff' has.-getStringDiff :: String -> String -> [Diff Char]-getStringDiff actual expected = V.toList (getVectorDiff (V.fromList actual) (V.fromList expected))---- | Grouped 'String' diff------ Like 'getStringDiff' but with entire strings instead of individual characters.-getGroupedStringDiff :: String -> String -> [Diff String]-getGroupedStringDiff actual expected = V.toList $ V.map (mapDiff V.toList) $ getGroupedVectorDiff (V.fromList actual) (V.fromList expected)---- | Diff two vectors------ Prefer 'getGroupedVectorDiff' for performance reasons.-getVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff a)-getVectorDiff = getVectorDiffBy (==)---- | Diff two vectors with different types using a custom equality operator------ Prefer 'getGroupedVectorDiffBy' for performance reasons.-getVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff a b)-getVectorDiffBy eq old new = computeDiffFromEditScript old new (getEditScriptBy eq old new)---- | Diff two vectors with grouped results-getGroupedVectorDiff :: Eq a => Vector a -> Vector a -> Vector (Diff (Vector a))-getGroupedVectorDiff = getGroupedVectorDiffBy (==)---- | Diff two vectors with grouped results using a custom equality operator-getGroupedVectorDiffBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector (PolyDiff (Vector a) (Vector b))-getGroupedVectorDiffBy eq old new = computeGroupedDiffFromEditScript old new (getEditScriptBy eq old new)---- | Compute the edit script to turn a given vector into the second given vector-getEditScript :: forall a. Eq a => Vector a -> Vector a -> Vector Edit-getEditScript = getEditScriptBy (==)---- | Compute the edit script to turn a given vector into the second given vector with a custom equality operator------ From https://blog.robertelder.org/diff-algorithm/-getEditScriptBy :: forall a b. (a -> b -> Bool) -> Vector a -> Vector b -> Vector Edit-getEditScriptBy eq old new = V.fromList $ DList.toList $ runST $ go old new 0 0-  where-    go :: forall s. Vector a -> Vector b -> Int -> Int -> ST s (DList Edit)-    go e f i j = do-      -- N,M,L,Z = len(e),len(f),len(e)+len(f),2*min(len(e),len(f))+2-      let upperN :: Int-          upperN = V.length e--      let upperM :: Int-          upperM = V.length f--      let upperL :: Int-          upperL = upperN + upperM--      let upperZ :: Int-          upperZ = 2 * min upperN upperM + 2--      -- if N > 0 and M > 0:-      if upperN > 0 && upperM > 0-        then do-          -- w,g,p = N-M,[0]*Z,[0]*Z-          let w :: Int-              w = upperN - upperM--          g <- MV.replicate upperZ 0 :: ST s (MVector s Int)--          p <- MV.replicate upperZ 0 :: ST s (MVector s Int)--          -- for h in range(0, (L//2+(L%2!=0))+1):-          let hs :: [Int]-              hs = [0 .. ((upperL `quot` 2) + (if odd upperL then 1 else 0))]--          mResult <- forUntilJust hs $ \h -> do-            -- for r in range(0, 2):-            forUntilJust [0, 1 :: Int] $ \r -> do-              -- c,d,o,m = (g,p,1,1) if r==0 else (p,g,0,-1)-              let (c, d, o, m) = if r == 0 then (g, p, 1, 1) else (p, g, 0, -1)--              -- for k in range(-(h-2*max(0,h-M)), h-2*max(0,h-N)+1, 2):-              let lo :: Int-                  lo = -(h - 2 * max 0 (h - upperM))--              let hi :: Int-                  hi = h - 2 * max 0 (h - upperN)--              let ks :: [Int]-                  ks = [lo, lo + 2 .. hi]--              forUntilJust ks $ \k -> do-                -- a = c[(k+1)%Z] if (k==-h or k!=h and c[(k-1)%Z]<c[(k+1)%Z]) else c[(k-1)%Z]+1-                initAVal <- do-                  let part1 = k == -h--                  let part2 = k /= h--                  -- (k+1)%Z-                  let kp1Ix = (k + 1) `modPortable` upperZ--                  -- (k-1)%Z-                  let km1Ix = (k - 1) `modPortable` upperZ-                  if part1-                    then MV.unsafeRead c kp1Ix-                    else do-                      if part2-                        then do-                          -- c[(k-1)%Z]-                          km1 <- MV.unsafeRead c km1Ix--                          -- c[(k+1)%Z]-                          kp1 <- MV.unsafeRead c kp1Ix-                          let part3 = km1 < kp1-                          pure $-                            if part3-                              then kp1-                              else km1 + 1-                        else do-                          km1 <- MV.unsafeRead c km1Ix--                          pure $ km1 + 1--                a <- newSTRef initAVal--                -- b = a-k-                let initBVal :: Int-                    initBVal = initAVal - k--                b <- newSTRef initBVal--                -- s,t = a,b-                s <- newSTRef initAVal-                t <- newSTRef initBVal--                -- while a<N and b<M and e[(1-o)*N+m*a+(o-1)]==f[(1-o)*M+m*b+(o-1)]:-                let computeWhileCond = do-                      aVal <- readSTRef a-                      -- a<N-                      let part1 = aVal < upperN-                      if part1-                        then do-                          bVal <- readSTRef b-                          -- b<M-                          let part2 = bVal < upperM-                          -- e[(1-o)*N+m*a+(o-1)]==f[(1-o)*M+m*b+(o-1)]:-                          let mkPart3 = do-                                let imo = 1 - o-                                    omi = o - 1-                                -- e[(1-o)*N+m*a+(o-1)]-                                leftVal <- do-                                  -- (1-o)*N+m*a+(o-1)-                                  let ix = imo * upperN + m * aVal + omi--                                  pure $ e ! ix-                                -- f[(1-o)*M+m*b+(o-1)]-                                rightVal <- do-                                  -- (1-o)*M+m*b+(o-1)-                                  let ix = imo * upperM + m * bVal + omi--                                  pure $ f ! ix-                                pure $ leftVal `eq` rightVal-                          part2 &&. mkPart3-                        else pure False-                whileM_ computeWhileCond $ do-                  --   a,b = a+1,b+1-                  modifySTRef a (+ 1)-                  modifySTRef b (+ 1)-                -- c[k%Z],z=a,-(k-w)-                do-                  aVal <- readSTRef a--                  MV.unsafeWrite c (k `modPortable` upperZ) aVal--                let z = -(k - w)--                -- if L%2==o and z>=-(h-o) and z<=h-o and c[k%Z]+d[z%Z] >= N:-                let -- L%2==o-                    part1 = upperL `rem` 2 == o-                    -- (h-o)-                    hmo = h - o-                    -- z>=-(h-o)-                    part2 = z >= -hmo-                    -- z<=h-o-                    part3 = z <= hmo-                    -- c[k%Z]+d[z%Z] >= N-                    mkPart4 = do-                      ck <- MV.unsafeRead c (k `modPortable` upperZ)--                      dz <- MV.unsafeRead d (z `modPortable` upperZ)--                      pure (ck + dz >= upperN)-                    mkCondition = part1 &&. (part2 &&. (part3 &&. mkPart4))-                condition <- mkCondition-                if condition-                  then do-                    -- D,x,y,u,v = (2*h-1,s,t,a,b) if o==1 else (2*h,N-a,M-b,N-s,M-t)-                    (upperD, x, y, u, v) <- do-                      aVal <- readSTRef a-                      bVal <- readSTRef b-                      sVal <- readSTRef s-                      tVal <- readSTRef t-                      pure $-                        if o == 1-                          then (2 * h - 1, sVal, tVal, aVal, bVal)-                          else (2 * h, upperN - aVal, upperM - bVal, upperN - sVal, upperM - tVal)--                    -- if D > 1 or (x != u and y != v):-                    if upperD > 1 || (x /= u && y /= v)-                      then do-                        -- return diff(e[0:x],f[0:y],i,j)+diff(e[u:N],f[v:M],i+u,j+v)-                        -- diff(e[0:x],f[0:y],i,j)-                        firstHalf <- go (V.slice 0 x e) (V.slice 0 y f) i j-                        -- diff(e[u:N],f[v:M],i+u,j+v)-                        secondHalf <- go (sliceIx u upperN e) (sliceIx v upperM f) (i + u) (j + v)-                        pure (Just (firstHalf <> secondHalf))-                      else -- elif M > N:--                        if upperM > upperN-                          then do-                            -- return diff([],f[N:M],i+N,j+N)-                            Just <$> go V.empty (sliceIx upperN upperM f) (i + upperN) (j + upperN)-                          else -- elif M < N:--                            if upperM < upperN-                              then do-                                --   return diff(e[M:N],[],i+M,j+M)-                                Just <$> go (sliceIx upperM upperN e) V.empty (i + upperM) (j + upperM)-                              else -- else:-                              --   return []-                                pure (Just mempty)-                  else pure Nothing-          case mResult of-            Nothing -> error "Test.Syd.Diff: This is a bug, the diffing algorithm was supposed to terminate and it didn't."-            Just result -> pure result-        else do-          -- elif N > 0: #  Modify the return statements below if you want a different edit-          if upperN > 0-            then do-              -- return [{"operation": "delete", "position_old": i+n} for n in range(0,N)]--              pure $ DList.singleton (Delete i upperN)-            else do-              -- return [{"operation": "insert", "position_old": i,"position_new":j+n} for n in range(0,M)]-              if upperM > 0-                then do-                  pure $ DList.singleton (Insert i j upperM)-                else do-                  pure DList.empty---- | Compute a diff using an edit script.------ Prefer `computeGroupedDiffFromEditScript` for performance reasons.-computeGroupedDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff (Vector a) (Vector b))-computeGroupedDiffFromEditScript old new editSteps = V.create $ do-  -- Computing the exact size is cumbersome, so we make enough space and cut down later.-  -- Enough space means: Space between every two edit steps, and one before and one after.-  let size = length editSteps * 2 + 1-  v <- MV.new size-  groupMarker <- newSTRef 0--  oldMarker <- newSTRef 0-  curMarker <- newSTRef 0-  newMarker <- newSTRef 0--  forM_ editSteps $ \editStep -> do-    -- Copy over the pieces between the last and current edit-    inbetweenIx <- readSTRef oldMarker-    let inbetweenLen = oldPosition editStep - inbetweenIx-    when (inbetweenLen > 0) $ do-      groupIx <- readSTRef groupMarker-      oldIx <- readSTRef oldMarker-      newIx <- readSTRef newMarker-      MV.unsafeWrite v groupIx (Both (V.slice oldIx inbetweenLen old) (V.slice newIx inbetweenLen new))-      modifySTRef groupMarker (+ 1)-      modifySTRef oldMarker (+ inbetweenLen)-      modifySTRef curMarker (+ inbetweenLen)-      modifySTRef newMarker (+ inbetweenLen)--    -- Apply the edit-    case editStep of-      Delete oldPosStart upperN -> do-        groupIx <- readSTRef groupMarker-        MV.unsafeWrite v groupIx (First (V.slice oldPosStart upperN old))-        modifySTRef groupMarker (+ 1)-        modifySTRef oldMarker (+ upperN)-        modifySTRef curMarker (+ upperN)-      Insert _ newPosStart upperM -> do-        groupIx <- readSTRef groupMarker-        MV.unsafeWrite v groupIx (Second (V.slice newPosStart upperM new))-        modifySTRef groupMarker (+ 1)-        modifySTRef curMarker (+ upperM)-        modifySTRef newMarker (+ upperM)--  oldIx <- readSTRef oldMarker-  let afterLen = V.length old - oldIx-  when (afterLen > 0) $ do-    newIx <- readSTRef newMarker-    groupIx <- readSTRef groupMarker-    MV.unsafeWrite v groupIx (Both (V.slice oldIx afterLen old) (V.slice newIx afterLen new))-    modifySTRef groupMarker (+ 1)-    modifySTRef oldMarker (+ 1)-    modifySTRef curMarker (+ 1)-    modifySTRef newMarker (+ 1)--  endGroupIx <- readSTRef groupMarker--  pure (MV.slice 0 endGroupIx v)---- | Compute a diff using an edit script.------ Prefer `computeGroupedDiffFromEditScript` for performance reasons.-computeDiffFromEditScript :: Vector a -> Vector b -> Vector Edit -> Vector (PolyDiff a b)-computeDiffFromEditScript old new editSteps = V.create $ do-  -- The total size of the diff is the size of the old vector plus the number-  -- of inserts that need to happen.-  -- Not minus the number of deletions, because they get a 'First' constructor and stay.-  let totalSize = V.length old + sum (V.map insertLength editSteps)--  v <- MV.new totalSize-  oldMarker <- newSTRef 0-  curMarker <- newSTRef 0-  newMarker <- newSTRef 0--  forM_ editSteps $ \editStep -> do-    let computeWhileCond1 = do-          oldIx <- readSTRef oldMarker-          pure $ oldPosition editStep > oldIx-    -- Copy over the pieces between the last and current edit-    whileM_ computeWhileCond1 $ do-      oldIx <- readSTRef oldMarker-      curIx <- readSTRef curMarker-      newIx <- readSTRef newMarker-      MV.unsafeWrite v curIx (Both (old ! oldIx) (new ! newIx))-      modifySTRef oldMarker (+ 1)-      modifySTRef curMarker (+ 1)-      modifySTRef newMarker (+ 1)--    -- Apply the edit-    case editStep of-      Delete oldPosStart upperN -> do-        curIx <- readSTRef curMarker-        forM_ [0 .. upperN - 1] $ \n -> do-          MV.unsafeWrite v (curIx + n) (First (old ! (oldPosStart + n)))-        modifySTRef oldMarker (+ upperN)-        modifySTRef curMarker (+ upperN)-      Insert _ newPosStart upperM -> do-        curIx <- readSTRef curMarker-        forM_ [0 .. upperM - 1] $ \n -> do-          MV.unsafeWrite v (curIx + n) (Second (new ! (newPosStart + n)))-        modifySTRef curMarker (+ upperM)-        modifySTRef newMarker (+ upperM)--  let computeWhileCond2 = do-        oldIx <- readSTRef oldMarker-        pure $ oldIx < V.length old--  -- Copy over the pieces between the last and current edit-  whileM_ computeWhileCond2 $ do-    oldIx <- readSTRef oldMarker-    curIx <- readSTRef curMarker-    newIx <- readSTRef newMarker--    MV.unsafeWrite v curIx (Both (old ! oldIx) (new ! newIx))-    modifySTRef oldMarker (+ 1)-    modifySTRef curMarker (+ 1)-    modifySTRef newMarker (+ 1)--  pure v--data Edit-  = -- | Delete from the old vector-    Delete-      Int-      -- ^ position in the old vector-      Int-      -- ^ number of items to delete-  | -- | Insert into the old vector-    Insert-      Int-      -- ^ position in the old vector-      Int-      -- ^ position in the new vector-      Int-      -- ^ number of items to insert-  deriving (Show, Eq, Ord)--oldPosition :: Edit -> Int-oldPosition = \case-  Delete i _ -> i-  Insert i _ _ -> i--insertLength :: Edit -> Int-insertLength = \case-  Delete _ _ -> 0-  Insert _ _ m -> m--modPortable :: Int -> Int -> Int-modPortable a b =-  let r = a `rem` b-   in if r >= 0 then r else r + b--sliceIx :: Int -> Int -> Vector a -> Vector a-sliceIx start end = V.slice start (end - start)---- | Short-circuiting monadic (&&)-(&&.) :: Applicative m => Bool -> m Bool -> m Bool-(&&.) b1 mkB2 = do-  if b1-    then mkB2-    else pure False--forUntilJust :: Monad m => [a] -> (a -> m (Maybe b)) -> m (Maybe b)-forUntilJust [] _ = pure Nothing-forUntilJust (a : rest) func = do-  mRes <- func a-  case mRes of-    Nothing -> forUntilJust rest func-    Just res -> pure $ Just res--whileM_ :: (Monad m) => m Bool -> m a -> m ()-whileM_ p f = go-  where-    go = do-      x <- p-      if x-        then f >> go-        else return ()
src/Test/Syd/Expectation.hs view
@@ -1,7 +1,8 @@ {-# LANGUAGE CPP #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeApplications #-}-{-# OPTIONS_GHC -fno-warn-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-redundant-constraints #-}+{-# OPTIONS_GHC -Wno-unused-imports #-}  -- | This module defines all the functions you will use to define your tests module Test.Syd.Expectation where
src/Test/Syd/OptParse.hs view
@@ -13,12 +13,12 @@ import Control.Monad import Data.Functor ((<&>)) import Data.Maybe+import Data.String import Data.Text (Text) import qualified Data.Text as T import qualified Env import GHC.Generics (Generic) import Options.Applicative as OptParse-import qualified Options.Applicative.Help as OptParse (string) import Path import Path.IO import System.Exit@@ -263,30 +263,46 @@   codec =     object "Configuration" $       Configuration-        <$> optionalField "seed" "Seed for random generation of test cases" .= configSeed+        <$> optionalField "seed" "Seed for random generation of test cases"+          .= configSeed         <*> parseAlternative           (optionalField "randomise-execution-order" "Randomise the execution order of the tests in the test suite")           (optionalField "randomize-execution-order" "American spelling")           .= configRandomiseExecutionOrder-        <*> optionalField "parallelism" "How parallel to execute the tests" .= configThreads-        <*> optionalField "max-size" "Maximum size parameter to pass to generators" .= configMaxSize-        <*> optionalField "max-success" "Number of quickcheck examples to run" .= configMaxSuccess-        <*> optionalField "max-discard" "Maximum number of discarded tests per successful test before giving up" .= configMaxDiscard-        <*> optionalField "max-shrinks" "Maximum number of shrinks of a failing test input" .= configMaxShrinks-        <*> optionalField "golden-start" "Whether to write golden tests if they do not exist yet" .= configGoldenStart-        <*> optionalField "golden-reset" "Whether to overwrite golden tests instead of having them fail" .= configGoldenReset+        <*> optionalField "parallelism" "How parallel to execute the tests"+          .= configThreads+        <*> optionalField "max-size" "Maximum size parameter to pass to generators"+          .= configMaxSize+        <*> optionalField "max-success" "Number of quickcheck examples to run"+          .= configMaxSuccess+        <*> optionalField "max-discard" "Maximum number of discarded tests per successful test before giving up"+          .= configMaxDiscard+        <*> optionalField "max-shrinks" "Maximum number of shrinks of a failing test input"+          .= configMaxShrinks+        <*> optionalField "golden-start" "Whether to write golden tests if they do not exist yet"+          .= configGoldenStart+        <*> optionalField "golden-reset" "Whether to overwrite golden tests instead of having them fail"+          .= configGoldenReset         <*> parseAlternative           (optionalField "colour" "Whether to use coloured output")           (optionalField "color" "American spelling")           .= configColour-        <*> optionalField "filter" "Filter to select which parts of the test tree to run" .= configFilter-        <*> optionalField "fail-fast" "Whether to stop executing upon the first test failure" .= configFailFast-        <*> optionalField "iterations" "How many iterations to use to look diagnose flakiness" .= configIterations-        <*> optionalField "retries" "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'" .= configRetries-        <*> optionalField "fail-on-flaky" "Whether to fail when any flakiness is detected in tests marked as potentially flaky" .= configFailOnFlaky-        <*> optionalField "progress" "How to report progres" .= configReportProgress-        <*> optionalField "debug" "Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true" .= configDebug-        <*> optionalField "profile" "Turn on profiling mode" .= configProfile+        <*> optionalField "filter" "Filter to select which parts of the test tree to run"+          .= configFilter+        <*> optionalField "fail-fast" "Whether to stop executing upon the first test failure"+          .= configFailFast+        <*> optionalField "iterations" "How many iterations to use to look diagnose flakiness"+          .= configIterations+        <*> optionalField "retries" "The number of retries to use for flakiness diagnostics. 0 means 'no flakiness diagnostics'"+          .= configRetries+        <*> optionalField "fail-on-flaky" "Whether to fail when any flakiness is detected in tests marked as potentially flaky"+          .= configFailOnFlaky+        <*> optionalField "progress" "How to report progres"+          .= configReportProgress+        <*> optionalField "debug" "Turn on debug-mode. This implies randomise-execution-order: false, parallelism: 1 and fail-fast: true"+          .= configDebug+        <*> optionalField "profile" "Turn on profiling mode"+          .= configProfile  instance HasCodec Threads where   codec = dimapCodec f g codec@@ -447,7 +463,7 @@ flagsParser =   OptParse.info     (OptParse.helper <*> parseFlags)-    (OptParse.fullDesc <> OptParse.footerDoc (Just $ OptParse.string footerStr))+    (OptParse.fullDesc <> OptParse.footerDoc (Just $ fromString footerStr))   where     -- Show the variables from the environment that we parse and the config file format     footerStr =
src/Test/Syd/Output.hs view
@@ -24,9 +24,9 @@ import qualified Data.Vector as V import Data.Word import GHC.Stack+import Myers.Diff import Safe import Test.QuickCheck.IO ()-import Test.Syd.Diff import Test.Syd.OptParse import Test.Syd.Run import Test.Syd.SpecDef
src/Test/Syd/Runner/Asynchronous.hs view
@@ -19,9 +19,7 @@ import Control.Concurrent.QSem import Control.Concurrent.STM as STM import Control.Exception-#if MIN_VERSION_mtl(2,3,0)-import Control.Monad (when)-#endif+import Control.Monad import Control.Monad.Reader import Data.Maybe import qualified Data.Text as T
src/Test/Syd/Runner/Synchronous/Interleaved.hs view
@@ -9,6 +9,7 @@ module Test.Syd.Runner.Synchronous.Interleaved (runSpecForestInterleavedWithOutputSynchronously) where  import Control.Exception+import Control.Monad import Control.Monad.IO.Class import Control.Monad.Reader import qualified Data.Text as T
sydtest.cabal view
@@ -5,7 +5,7 @@ -- see: https://github.com/sol/hpack  name:           sydtest-version:        0.15.1.0+version:        0.15.1.1 synopsis:       A modern testing framework for Haskell with good defaults and advanced testing features. description:    A modern testing framework for Haskell with good defaults and advanced testing features. Sydtest aims to make the common easy and the hard possible. See https://github.com/NorfairKing/sydtest#readme for more information. category:       Testing@@ -45,7 +45,6 @@       Test.Syd.Def.SetupFunc       Test.Syd.Def.Specify       Test.Syd.Def.TestDefM-      Test.Syd.Diff       Test.Syd.Expectation       Test.Syd.HList       Test.Syd.Modify@@ -78,6 +77,7 @@     , containers     , dlist     , envparse+    , fast-myers-diff     , filepath     , mtl     , optparse-applicative@@ -172,6 +172,7 @@       QuickCheck     , base >=4.7 && <5     , bytestring+    , fast-myers-diff     , path     , path-io     , safe-coloured-text
test/Test/Syd/DiffSpec.hs view
@@ -11,8 +11,8 @@ import qualified Data.Text as T import Data.Vector (Vector) import qualified Data.Vector as V+import Myers.Diff import Test.Syd-import Test.Syd.Diff  -- Just for this test instance IsString (Vector Char) where