tasty-sugar 1.1.0.0 → 1.1.1.0
raw patch · 8 files changed
+162/−70 lines, 8 filesdep +kvitabledep +microlensdep +textdep ~directorydep ~filemanipdep ~filepathPVP ok
version bump matches the API change (PVP)
Dependencies added: kvitable, microlens, text
Dependency ranges changed: directory, filemanip, filepath, logict, optparse-applicative, prettyprinter, tagged, tasty
API changes (from Hackage documentation)
+ Test.Tasty.Sugar: sweetsKVITable :: [Sweets] -> KVITable FilePath
+ Test.Tasty.Sugar: sweetsTextTable :: [CUBE] -> [Sweets] -> Text
Files
- CHANGELOG.md +9/−0
- src/Test/Tasty/Sugar.hs +26/−17
- src/internal/Test/Tasty/Sugar/ParamCheck.hs +1/−1
- src/internal/Test/Tasty/Sugar/Report.hs +49/−0
- src/internal/Test/Tasty/Sugar/RootCheck.hs +35/−35
- tasty-sugar.cabal +26/−15
- test/TestGCD.hs +7/−1
- test/TestMultiAssoc.hs +9/−1
CHANGELOG.md view
@@ -1,5 +1,14 @@ # Revision history for tasty-sugar +## 1.1.1.0 -- 2021-04-19++ * Use 'kvitable' to render `--showsearch` output.+ * Update build warnings and refactor code to remove potential partial+ results.+ * Fix tasty ingredients option double-defaulting.+ * Add dependency constraint bounds.+ * Update haddock usage for usage changes.+ ## 1.1.0.0 -- 2021-01-31 * Allow multiple tests to be generated for each `Expectation` via
src/Test/Tasty/Sugar.hs view
@@ -23,6 +23,7 @@ -- > import Test.Tasty as T -- > import Test.Tasty.Options -- > import Test.Tasty.Sugar+-- > import Numeric.Natural -- > -- > sugarCube = mkCUBE { inputDir = "test/samples" -- > , rootName = "*.c"@@ -31,22 +32,24 @@ -- > } -- > -- > ingredients = T.includingOptions sugarOptions :--- > sugarIngredients sugarCube <>+-- > sugarIngredients [sugarCube] <> -- > T.defaultIngredients -- > -- > main = -- > do testSweets <- findSugar sugarCube--- > T.defaultMainWithIngredients ingredients $--- > T.testGroup "sweet tests" $--- > withSugarGroups testSweets T.testGroup mkTest+-- > T.defaultMainWithIngredients ingredients .+-- > T.testGroup "sweet tests" =<<+-- > withSugarGroups testSweets T.testGroup mkTest -- >--- > mkTest :: Sweets -> Natural -> Expectation -> T.TestTree--- > mkTest s n e = testCase (rootMatchName s <> " #" <> show n) $ do--- > Just inpF <- lookup "inputs" $ associated e--- > inp <- readFile inpF--- > exp <- reads <$> readFile $ expectedFile e--- > result <- testSomething inp--- > result @?= exp+-- > mkTest :: Sweets -> Natural -> Expectation -> IO [T.TestTree]+-- > mkTest s n e = do+-- > inp <- readFile inpF+-- > exp <- reads <$> readFile $ expectedFile e+-- > return [ testCase (rootMatchName s <> " #" <> show n) $ do+-- > Just inpF <- lookup "inputs" $ associated e+-- > result <- testSomething inp+-- > result @?= exp+-- > ] -- -- See the README for more information. @@ -76,6 +79,9 @@ , NamedParamMatch , ParamMatch(..) , paramMatchVal+ -- ** Reporting+ , sweetsKVITable+ , sweetsTextTable ) where @@ -83,11 +89,13 @@ import Control.Monad import Control.Monad.IO.Class import Control.Monad.Logic+import qualified Data.Foldable as F import Data.Function import qualified Data.List as L import Data.Maybe ( isJust, isNothing, fromJust ) import Data.Proxy import Data.Tagged+import qualified Data.Text as T import Data.Typeable ( Typeable ) import Numeric.Natural ( Natural ) import Options.Applicative@@ -97,6 +105,7 @@ import Test.Tasty.Options import Test.Tasty.Sugar.Analysis+import Test.Tasty.Sugar.Report import Test.Tasty.Sugar.Types import Prelude hiding ( exp )@@ -111,12 +120,9 @@ parseValue = fmap ShowSugarSearch . safeRead optionName = pure $ "showsearch" optionHelp = pure $ "Show details of the search for the set of\n\- \sample-file driven tests that would be\n\- \performed based on the search."- optionCLParser = ShowSugarSearch <$> switch- ( long (untag (optionName :: Tagged ShowSugarSearch String))- <> help (untag (optionHelp :: Tagged ShowSugarSearch String))- )+ \ sample-file driven tests that would be\n\+ \ performed based on the search."+ optionCLParser = flagCLParser Nothing (ShowSugarSearch True) -- | Specify the Sugar-specific Tasty command-line options@@ -147,6 +153,9 @@ show (sum $ fmap (length . fst) searchinfo) ++ "]:") putStrLn $ show $ vsep $ concatMap (map (("•" <+>) . align . pretty) . fst) searchinfo+ putStrLn ""+ putStrLn $ T.unpack $ sweetsTextTable pats $+ F.fold (fst <$> searchinfo) return True else Nothing
src/internal/Test/Tasty/Sugar/ParamCheck.hs view
@@ -95,6 +95,6 @@ candidateVals <- pvVal rpv let rset = preset <> candidateVals orderedRset = fmap from_rset $ fmap fst pvals- from_rset n = let Just v = L.lookup n rset in (n,v)+ from_rset n = let v = maybe NotSpecified id $ L.lookup n rset in (n,v) pvstr <- genPVStr orderedRset return (rset, length orderedRset, pvstr)
+ src/internal/Test/Tasty/Sugar/Report.hs view
@@ -0,0 +1,49 @@+{-# LANGUAGE OverloadedStrings #-}++module Test.Tasty.Sugar.Report+ (+ sweetsKVITable+ , sweetsTextTable+ )+ where++import Data.KVITable+import Data.KVITable.Render.ASCII ( render+ , defaultRenderConfig+ , RenderConfig(..) )+import Data.Text ( Text )+import qualified Data.Text as T+import Lens.Micro ( (&), (.~) )+import qualified Prettyprinter as PP+import System.FilePath ( takeFileName )++import Test.Tasty.Sugar.Types+++sweetsKVITable :: [Sweets] -> KVITable FilePath+sweetsKVITable [] = mempty+sweetsKVITable sweets =+ let t = fromList $ concatMap+ (\s ->+ [+ ( ("base", T.pack $ rootBaseName s)+ : [ (T.pack pn, T.pack $ show $ PP.pretty pv)+ | (pn,pv) <- expParamsMatch e ]+ <> [ (T.pack an, T.pack $ takeFileName af)+ | (an,af) <- associated e ]+ , takeFileName (expectedFile e)+ )+ | e <- expected s+ ])+ sweets+ in t & valueColName .~ "Expected File"++sweetsTextTable :: [CUBE] -> [Sweets] -> Text+sweetsTextTable [] _ = "No CUBE provided for report"+sweetsTextTable _ [] = "No Sweets provided for report"+sweetsTextTable c s =+ let cfg = defaultRenderConfig+ { rowGroup = "base"+ : (T.pack . fst <$> take 1 (validParams $ head c))+ }+ in render cfg $ sweetsKVITable s
src/internal/Test/Tasty/Sugar/RootCheck.hs view
@@ -43,10 +43,6 @@ isRootSep (RootSep _) = True isRootSep _ = False -isRootSuffix :: RootPart -> Bool-isRootSuffix (RootSuffix _) = True-isRootSuffix _ = False- rpStr :: [RootPart] -> String rpStr = let s = \case RootSep x -> x@@ -143,13 +139,14 @@ Nothing -> mzero Just p -> do idx <- eachFrom [i | i <- [2..length allRP], even i]- let free = RootParNm (fst p) idxv- RootText idxv = head $ drop idx allRP- start = take (idx - 1) allRP- guard (not $ isRootSuffix $ head $ drop idx allRP)- return ( rpNPM [free]- , rpStr $ start- , rpStr $ drop (idx + 2) allRP )+ case drop idx allRP of+ (RootText idxv:_) -> do+ let free = RootParNm (fst p) idxv+ start = take (idx - 1) allRP+ return ( rpNPM [free]+ , rpStr $ start+ , rpStr $ drop (idx + 2) allRP )+ _ -> mzero freeFirst (Just (Left (pfx, pl1, sfx))) = if length pfx < 3 then mzero@@ -161,13 +158,12 @@ Just p -> -- There is a wildcard parameter, try it at the end -- of pfx and before pl1- let free = RootParNm (fst p) lpv- RootText lpv = last start- start = init pfx- in do guard (not . isRootSuffix $ last start)- return ( rpNPM $ free : pl1- , rpStr $ reverse $ drop 3 $ reverse pfx- , rpStr sfx )+ case reverse pfx of+ (_:RootText lpv:_) ->+ return ( rpNPM $ RootParNm (fst p) lpv : pl1+ , rpStr $ reverse $ drop 3 $ reverse pfx+ , rpStr sfx )+ _ -> mzero freeLast Nothing = mzero freeLast (Just (Right _)) = mzero@@ -180,12 +176,12 @@ Just p -> -- There is a wildcard parameter, try it at the end -- of pfx and before pl1- let free = [RootParNm (fst p) fsv]- RootText fsv = head sfx- in do guard (not $ isRootSuffix $ head sfx)- return ( rpNPM $ parms1 <> free+ case sfx of+ (RootText fsv:_) ->+ return ( rpNPM $ parms1 <> [RootParNm (fst p) fsv] , rpStr pfx , rpStr $ tail sfx )+ _ -> mzero freeMid Nothing = mzero freeMid (Just (Left _)) = mzero@@ -198,11 +194,13 @@ else case freeValueParm of Nothing -> mzero Just p ->- let free = [RootParNm (fst p) mv]- (ms1:RootText mv:ms2:[]) = mid- in return ( rpNPM $ parms1 <> free <> parms2- , rpStr $ pfx <> [ms1]- , rpStr $ ms2 : sfx )+ case mid of+ (ms1:RootText mv:ms2:[]) ->+ return ( rpNPM ( parms1 <> [RootParNm (fst p) mv] <>+ parms2 )+ , rpStr $ pfx <> [ms1]+ , rpStr $ ms2 : sfx )+ _ -> mzero (freeFirst rnChunks) `mplus` (freeLast rnChunks)@@ -225,14 +223,16 @@ , pvstr `L.isInfixOf` rootNm , not $ pvstr `L.isPrefixOf` rootNm ])- let (basename, suffix) =- let l1 = length rootNm- l2 = length pvstr- bslen = l1 - l2- matches n = pvstr `L.isPrefixOf` (drop n rootNm)- Just pfxlen = L.find matches $ reverse [1..bslen]- in (take pfxlen rootNm, drop (pfxlen + l2) rootNm)- return (explicit, basename, suffix)+ let l1 = length rootNm+ l2 = length pvstr+ bslen = l1 - l2+ matches n = pvstr `L.isPrefixOf` (drop n rootNm)+ case L.find matches $ reverse [1..bslen] of+ Just pfxlen ->+ let basename = take pfxlen rootNm+ suffix = drop (pfxlen + l2) rootNm+ in return (explicit, basename, suffix)+ _ -> mzero -- Return origRootName up to each sep-indicated point. noRootParamMatch :: FilePath -> Separators
tasty-sugar.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.0 name: tasty-sugar-version: 1.1.0.0+version: 1.1.1.0 synopsis: Tests defined by Search Using Golden Answer References description: .@@ -25,7 +25,7 @@ category: Testing build-type: Simple -tested-with: GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.1+tested-with: GHC ==8.6.5 GHC ==8.8.4 GHC ==8.10.1 GHC ==9.0.1 extra-source-files: CHANGELOG.md README.org@@ -58,18 +58,22 @@ library exposed-modules: Test.Tasty.Sugar build-depends: base >=4.10 && < 5- , directory- , filepath- , filemanip- , logict- , optparse-applicative- , prettyprinter >= 1.7.0- , tagged- , tasty+ , directory >= 1.3 && < 1.4+ , filepath >= 1.4 && < 1.5+ , filemanip >= 0.3 && < 0.4+ , logict >= 0.7.0.3 && < 0.9+ , optparse-applicative >= 0.15 && < 0.17+ , prettyprinter >= 1.7.0 && < 1.8+ , tagged >= 0.8 && < 0.9+ , tasty >= 1.2 && < 1.5 , tasty-sugar-internal+ , text >= 1.2 && < 1.3 hs-source-dirs: src default-language: Haskell2010- GHC-options: -Wall -Wcompat -fhide-source-paths+ GHC-options: -Wall -Wcompat+ -Wincomplete-uni-patterns+ -Wpartial-fields+ -fhide-source-paths -- other-modules: -- other-extensions: @@ -79,16 +83,23 @@ , Test.Tasty.Sugar.AssocCheck , Test.Tasty.Sugar.ExpectCheck , Test.Tasty.Sugar.ParamCheck+ , Test.Tasty.Sugar.Report , Test.Tasty.Sugar.RootCheck , Test.Tasty.Sugar.Types build-depends: base >= 4.10 , filepath , filemanip+ , kvitable >= 1.0 && < 1.1 , logict- , prettyprinter+ , microlens >= 0.4 && < 0.5+ , prettyprinter >= 1.7 && < 1.8+ , text >= 1.2 && < 1.3 hs-source-dirs: src/internal- default-language: Haskell2010- GHC-options: -Wall -Wcompat -fhide-source-paths+ default-language: Haskell2010+ GHC-options: -Wall -Wcompat+ -Wincomplete-uni-patterns+ -Wpartial-fields+ -fhide-source-paths test-suite test-sugar@@ -117,7 +128,7 @@ , tasty-hedgehog , tasty-hunit , tasty-sugar-+ , text test-suite test-passthru-ascii type: exitcode-stdio-1.0
test/TestGCD.hs view
@@ -3,7 +3,7 @@ module TestGCD ( gcdSampleTests ) where -import Data.List+import qualified Data.Text as T import System.FilePath ( (</>) ) import qualified Test.Tasty as TT import Test.Tasty.HUnit@@ -34,6 +34,12 @@ let (sugar,sdesc) = findSugarIn sugarCube gcdSamples in [ testCase "valid sample" $ 20 @=? length gcdSamples , sugarTestEq "correct found count" sugarCube gcdSamples 1 length++ , testCase "sweets rendering" $+ let actual = sweetsTextTable [sugarCube] sugar+ in do putStrLn "Table" -- try to start table on its own line+ putStrLn $ T.unpack actual+ T.length actual > 0 @? "change this to see the table" , testCaseSteps "sweets info" $ \step -> do step "rootMatchName"
test/TestMultiAssoc.hs view
@@ -1,7 +1,9 @@+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} module TestMultiAssoc ( multiAssocTests ) where +import qualified Data.Text as T import System.FilePath ( (</>) ) import qualified Test.Tasty as TT import Test.Tasty.HUnit@@ -30,15 +32,21 @@ ] } + multiAssocTests :: [TT.TestTree] multiAssocTests = let (sugar1,_s1desc) = findSugarIn sugarCube sample1 in [- -- This is simply the number of entries in sample1; if this -- fails in means that sample1 has been changed and the other -- tests here are likely to need updating. testCase "valid sample" $ 58 @=? length sample1++ , testCase "sweets rendering" $+ let actual = sweetsTextTable [sugarCube] sugar1+ in do putStrLn "Table" -- try to start table on its own line+ putStrLn $ T.unpack actual+ T.length actual > 0 @? "change this to see the table" , sugarTestEq "correct found count" sugarCube sample1 6 length