fix-whitespace 0.0.11 → 0.1
raw patch · 18 files changed
+422/−163 lines, 18 filesdep +QuickCheckdep +bytestringdep +fix-whitespacedep ~basedep ~filepathdep ~text
Dependencies added: QuickCheck, bytestring, fix-whitespace, tasty, tasty-golden, tasty-quickcheck, transformers
Dependency ranges changed: base, filepath, text
Files
- CHANGELOG.md +6/−0
- FixWhitespace.hs +37/−94
- LICENSE +2/−2
- ParseConfig.hs +1/−1
- README.md +8/−2
- fix-whitespace.cabal +90/−40
- src/Data/List/Extra/Drop.hs +24/−0
- src/Data/Text/FixWhitespace.hs +163/−0
- stack-8.0.2.yaml +0/−8
- stack-8.2.2.yaml +0/−7
- stack-9.2.4.yaml +0/−3
- stack-9.2.5.yaml +0/−3
- stack-9.2.8.yaml +3/−0
- stack-9.4.3.yaml +0/−3
- stack-9.4.5.yaml +3/−0
- stack-9.6.2.yaml +3/−0
- test/Golden.hs +47/−0
- test/QuickCheck.hs +35/−0
CHANGELOG.md view
@@ -2,6 +2,12 @@ Version history. +# 0.1 Rainy Summer edition released 2023-08-07++- Flag `--verbose` now also displays locations of whitespace violations+ ([#7](https://github.com/agda/fix-whitespace/issues/7), contributed by Artem Pelenitsyn).+- Tested with GHC 8.0.2 - 9.8.1-alpha1.+ ## 0.0.11 Santa Clause edition released 2022-12-06 - Delete trailing tabs even when `--tab=0`
FixWhitespace.hs view
@@ -1,50 +1,42 @@ -- | Program to enforce a whitespace policy. +{-# LANGUAGE OverloadedStrings #-}+ module Main where -import Control.Monad-import Control.Exception (IOException, handle)+import Control.Monad ( unless, when ) -import Data.Char as Char-import Data.List.Extra (nubOrd)-import Data.Text (Text)-import Data.Version (showVersion)-import qualified Data.Text as Text-import qualified Data.Text.IO as Text -- Strict IO.+import Data.List.Extra ( nubOrd )+import qualified Data.Text as Text+import qualified Data.Text.IO as Text {- Strict IO -}+import Data.Version ( showVersion ) -import System.Directory (getCurrentDirectory, doesFileExist)-import System.Environment-import System.Exit--- import System.FilePath--- import System.FilePattern-import System.FilePattern.Directory (getDirectoryFiles, getDirectoryFilesIgnore)-import System.IO-import System.Console.GetOpt+import System.Console.GetOpt ( OptDescr(Option), ArgDescr(NoArg, ReqArg), ArgOrder(Permute), getOpt, usageInfo )+import System.Directory ( getCurrentDirectory, doesFileExist )+import System.Environment ( getArgs, getProgName )+import System.Exit ( die, exitFailure, exitSuccess )+import System.FilePattern.Directory ( getDirectoryFiles, getDirectoryFilesIgnore )+import System.IO ( IOMode(WriteMode), hPutStr, hPutStrLn, hSetEncoding, stderr, utf8, withFile ) -import Text.Read (readMaybe)+import Text.Read ( readMaybe ) -import ParseConfig-import qualified Paths_fix_whitespace as PFW (version)+import Data.Text.FixWhitespace ( CheckResult(CheckOK, CheckViolation, CheckIOError), checkFile, displayLineError+ , TabSize, Verbose, defaultTabSize ) +import ParseConfig ( Config(Config), parseConfig )+import qualified Paths_fix_whitespace as PFW ( version )+ -- | Default configuration file. defaultConfigFile :: String defaultConfigFile = "fix-whitespace.yaml" --- | Default tab size.--defaultTabSize :: String-defaultTabSize = "8"- -- Modes. data Mode = Fix -- ^ Fix whitespace issues. | Check -- ^ Check if there are any whitespace issues. deriving (Show, Eq) -type Verbose = Bool-type TabSize = Int- data Options = Options { optVerbose :: Verbose -- ^ Display the location of a file being checked or not.@@ -66,7 +58,7 @@ , optVersion = False , optMode = Fix , optConfig = defaultConfigFile- , optTabSize = defaultTabSize+ , optTabSize = show defaultTabSize } options :: [OptDescr (Options -> Options)]@@ -74,16 +66,19 @@ [ Option ['h'] ["help"] (NoArg (\opts -> opts { optHelp = True })) "Show this help information."- , Option [] ["version"]+ , Option ['V'] ["version"] (NoArg (\opts -> opts { optVersion = True })) "Show the program's version." , Option ['v'] ["verbose"] (NoArg (\opts -> opts { optVerbose = True }))- "Show files as they are being checked."+ (unlines+ [ "Show files as they are being checked."+ , "Display location of detected whitespace violations."+ ]) , Option ['t'] ["tab"] (ReqArg (\ts opts -> opts { optTabSize = ts }) "TABSIZE") (unlines- [ "Expand tab characters to TABSIZE (default: " ++ defaultTabSize ++ ") many spaces."+ [ "Expand tab characters to TABSIZE (default: " ++ show defaultTabSize ++ ") many spaces." , "Keep tabs if 0 is given as TABSIZE." ]) , Option [] ["config"]@@ -122,7 +117,7 @@ , " * Removes trailing whitespace." , " * Removes trailing lines containing nothing but whitespace." , " * Ensures that the file ends in a newline character."- , " * Convert tabs to TABSIZE (default: " ++ defaultTabSize ++ ") spaces, unless TABSIZE is set to 0."+ , " * Convert tabs to TABSIZE (default: " ++ show defaultTabSize ++ ") spaces, unless TABSIZE is set to 0." , "" , "for files specified in [FILES] or" , ""@@ -209,18 +204,15 @@ fix :: Mode -> Verbose -> TabSize -> FilePath -> IO Bool fix mode verbose tabSize f =- checkFile tabSize f >>= \case+ checkFile tabSize verbose f >>= \case CheckOK -> do when verbose $ putStrLn $ "[ Checked ] " ++ f return False - CheckViolation s -> do- hPutStrLn stderr $- "[ Violation " ++- (if mode == Fix then "fixed" else "detected") ++- " ] " ++ f+ CheckViolation s vs -> do+ hPutStrLn stderr (msg vs) when (mode == Fix) $ withFile f WriteMode $ \h -> do hSetEncoding h utf8@@ -232,61 +224,12 @@ "[ Read error ] " ++ f return False --- | Result of checking a file against the whitespace policy.--data CheckResult- = CheckOK- -- ^ The file satifies the policy.- | CheckViolation Text- -- ^ The file violates the policy, a fix is returned.- | CheckIOError IOException- -- ^ An I/O error occurred while accessing the file.- -- (E.g., the file is not UTF8 encoded.)---- | Check a file against the whitespace policy,--- returning a fix if violations occurred.--checkFile :: TabSize -> FilePath -> IO CheckResult-checkFile tabSize f =- handle (\ (e :: IOException) -> return $ CheckIOError e) $- withFile f ReadMode $ \ h -> do- hSetEncoding h utf8- s <- Text.hGetContents h- let s' = transform tabSize s- return $ if s' == s then CheckOK else CheckViolation s'---- | Transforms the contents of a file.--transform- :: TabSize -- ^ Expand tab characters to so many spaces. Keep tabs if @<= 0@.- -> Text -- ^ Text before transformation.- -> Text -- ^ Text after transformation.-transform tabSize =- Text.unlines .- removeFinalEmptyLinesExceptOne .- map (removeTrailingWhitespace . convertTabs) .- Text.lines where- removeFinalEmptyLinesExceptOne =- reverse . dropWhile1 Text.null . reverse-- removeTrailingWhitespace =- Text.dropWhileEnd $ \ c -> generalCategory c `elem` [Space,Format] || c == '\t'-- convertTabs = if tabSize <= 0 then id else- Text.pack . reverse . fst . foldl convertOne ([], 0) . Text.unpack-- convertOne (a, p) '\t' = (addSpaces n a, p + n)- where- n = tabSize - p `mod` tabSize -- Here, tabSize > 0 is guaranteed- convertOne (a, p) c = (c:a, p+1)-- addSpaces :: Int -> String -> String- addSpaces n = (replicate n ' ' ++)+ msg vs+ | mode == Fix =+ "[ Violation fixed ] " ++ f --- | 'dropWhile' except keep the first of the dropped elements-dropWhile1 :: (a -> Bool) -> [a] -> [a]-dropWhile1 _ [] = []-dropWhile1 p (x:xs)- | p x = x : dropWhile p xs- | otherwise = x : xs+ | otherwise =+ "[ Violation detected ] " ++ f +++ (if not verbose then "" else+ ":\n" ++ unlines (map (Text.unpack . displayLineError f) vs))
LICENSE view
@@ -1,9 +1,9 @@-Copyright (c) 2005-2021 remains with the authors.+Copyright (c) 2005-2023 remains with the authors. fix-whitespace was originally written by Nils Anders Danielsson as part of Agda 2 with contributions from Ulf Norell, Andrés Sicard-Ramírez, Andreas Abel, Philipp Hausmann, Jesper Cockx,-Vlad Semenov, and Liang-Ting Chen.+Vlad Semenov, Liang-Ting Chen, and Artem Pelenitsyn. Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the
ParseConfig.hs view
@@ -7,7 +7,7 @@ import Data.Maybe (fromMaybe) import qualified Data.Yaml as Y-import Data.Yaml (FromJSON(..), (.:?))+import Data.Yaml (FromJSON(parseJSON), (.:?)) data RawConfig = RawConfig { __included_dirs :: Maybe [FilePath]
README.md view
@@ -10,7 +10,7 @@ This tool can keep your project and repository clean of trailing whitespace and missing terminal newline. -Usage: `fix-whitespace [-h|--help] [-v|--verbose] [--version] [--check] [--config CONFIG] [FILES]`+Usage: `fix-whitespace [-h|--help] [-v|--verbose] [-V|--version] [--check] [--config CONFIG] [FILES]` The program does the following to files specified in `FILES` or in the configuration file `fix-whitespace.yaml` under the current directory@@ -30,8 +30,9 @@ * `-v --verbose` Show files as they are being checked.+ _Since 0.1:_ Display location of detected whitespace violations. -* `--version`+* `-V --version` Show program's version. @@ -51,3 +52,8 @@ In the latter case, it returns with a non-zero exit code. For an example configuration file see [the one of Agda](https://github.com/agda/agda/blob/f9a181685397517b5d14943ca88a1c0acacc2075/fix-whitespace.yaml).++Continuous integration+----------------------++`fix-whitespace` comfortably integrates into your GitHub CI via the [`fix-whitespace-action`](https://github.com/andreasabel/fix-whitespace-action).
fix-whitespace.cabal view
@@ -1,20 +1,24 @@+cabal-version: 2.2 name: fix-whitespace-version: 0.0.11-cabal-version: 1.24+version: 0.1 build-type: Simple++category: Text+synopsis: Fixes whitespace issues. description: Removes trailing whitespace, lines containing only whitespace, expands tabs, and ensures that every file ends in a newline character.-license: OtherLicense+license: MIT license-file: LICENSE-author: fix-whitespace was originally written by Nils Anders Danielsson as part of Agda 2 with contributions from Ulf Norell, Andrés Sicard-Ramírez, Andreas Abel, Philipp Hausmann, Jesper Cockx, Vlad Semenov, and Liang-Ting Chen.+author: fix-whitespace was originally written by Nils Anders Danielsson as part of Agda 2 with contributions from Ulf Norell, Andrés Sicard-Ramírez, Andreas Abel, Philipp Hausmann, Jesper Cockx, Vlad Semenov, Liang-Ting Chen, and Artem Pelenitsyn.+maintainer: Andreas Abel, Liang-Ting Chen <liang.ting.chen.tw@gmail.com> homepage: https://github.com/agda/fix-whitespace bug-reports: https://github.com/agda/fix-whitespace/issues-maintainer: Liang-Ting Chen <liang.ting.chen.tw@gmail.com>, Andreas Abel-Category: Text-Synopsis: Fixes whitespace issues.+ tested-with:- GHC == 9.4.3- GHC == 9.2.5+ -- cabal-supported GHCs+ GHC == 9.6.2+ GHC == 9.4.5+ GHC == 9.2.8 GHC == 9.0.2 GHC == 8.10.7 GHC == 8.8.4@@ -23,51 +27,97 @@ GHC == 8.2.2 GHC == 8.0.2 -extra-source-files:+extra-doc-files: CHANGELOG.md README.md fix-whitespace.yaml- stack-8.0.2.yaml- stack-8.2.2.yaml- stack-8.4.4.yaml- stack-8.6.5.yaml- stack-8.8.4.yaml- stack-8.10.7.yaml+ -- stack-supported GHCs+ stack-9.6.2.yaml+ stack-9.4.5.yaml+ stack-9.2.8.yaml stack-9.0.2.yaml- stack-9.2.4.yaml- stack-9.2.5.yaml- stack-9.4.3.yaml+ stack-8.10.7.yaml+ stack-8.8.4.yaml+ stack-8.6.5.yaml+ stack-8.4.4.yaml source-repository head type: git location: https://github.com/agda/fix-whitespace.git -executable fix-whitespace- hs-source-dirs: .- main-is: FixWhitespace.hs- other-modules: ParseConfig- Paths_fix_whitespace++common common-build-parameters default-language: Haskell2010 default-extensions: LambdaCase ScopedTypeVariables - build-depends: base >= 4.9.0.0 && < 5- , directory >= 1.2.6.2 && < 1.4- , extra >= 1.1 && < 2.0- , filepath >= 1.4.1.0 && < 1.5- , filepattern >= 0.1.3 && < 0.2- -- filepattern 0.1.3 fixes issue fix-whitespace#9- , text >= 1.2.3.0 && < 1.3 || == 2.0.*- , yaml >= 0.8.4 && < 0.12-- -- ASR (2018-10-16).- -- text-1.2.3.0 required for supporting GHC 8.4.1, 8.4.2 and 8.4.3.- -- See Agda issue #3277.- -- The other GHC versions can restrict to >= 1.2.3.1.- if impl(ghc < 8.4.1) || impl(ghc > 8.4.3)- build-depends: text >= 1.2.3.1- ghc-options: -Wall -Wcompat+ -Wmissing-import-lists++library+ import: common-build-parameters++ hs-source-dirs: src+ exposed-modules: Data.List.Extra.Drop+ Data.Text.FixWhitespace++ build-depends:+ base >= 4.9.0.0 && < 5+ , text >= 1.2.3.0 && < 1.3 || == 2.0.*+ , transformers >= 0.5.2.0 && < 0.7++executable fix-whitespace+ import: common-build-parameters++ hs-source-dirs: .+ main-is: FixWhitespace.hs+ other-modules: ParseConfig+ Paths_fix_whitespace+ autogen-modules: Paths_fix_whitespace++ build-depends:+ fix-whitespace+ , base+ , text+ -- non-inherited dependencies:+ , directory >= 1.2.6.2 && < 1.4+ , extra >= 1.1 && < 2.0+ , filepath >= 1.4.1.0 && < 1.5+ , filepattern >= 0.1.3 && < 0.2+ -- filepattern 0.1.3 fixes issue fix-whitespace#9+ , yaml >= 0.8.4 && < 0.12++test-suite QuickCheck+ import: common-build-parameters++ hs-source-dirs: test+ main-is: QuickCheck.hs+ type: exitcode-stdio-1.0++ build-depends:+ fix-whitespace+ , base+ -- non-inherited dependencies+ , QuickCheck+ , tasty+ , tasty-quickcheck++test-suite Golden+ import: common-build-parameters++ hs-source-dirs: test+ main-is: Golden.hs+ type: exitcode-stdio-1.0++ build-depends:+ fix-whitespace+ , base+ , filepath+ , text+ -- non-inherited dependencies+ , bytestring+ , tasty+ , tasty-golden
+ src/Data/List/Extra/Drop.hs view
@@ -0,0 +1,24 @@+module Data.List.Extra.Drop where++-- | 'dropWhile' except keep the first of the dropped elements.+--+dropWhile1 :: (a -> Bool) -> [a] -> [a]+dropWhile1 _ [] = []+dropWhile1 p (x:xs)+ | p x = x : dropWhile p xs+ | otherwise = x : xs++-- | 'dropWhileEnd' except keep the first of the dropped elements.+--+dropWhileEnd1 :: (a -> Bool) -> [a] -> [a]+dropWhileEnd1 p = go+ where+ -- State where @p@ isn't holding atm.+ go = \case+ [] -> []+ x:xs -> x : if p x then go' [] xs else go xs+ -- State where @p@ is holding atm.+ -- The accumulator holds the elements where @p@ holds (but the first of these).+ go' acc = \case+ [] -> []+ x:xs -> if p x then go' (x:acc) xs else reverse acc ++ x : go xs
+ src/Data/Text/FixWhitespace.hs view
@@ -0,0 +1,163 @@++{-# LANGUAGE OverloadedStrings #-}++module Data.Text.FixWhitespace+ ( CheckResult(..)+ , checkFile+ , LineError(..)+ , displayLineError+ , transform+ , transformWithLog+ , TabSize+ , Verbose+ , defaultTabSize+ )+ where++import Control.Monad ( (<=<) )+import Control.Monad.Trans.Writer.Strict ( Writer, runWriter, tell )+import Control.Exception ( IOException, handle )++import Data.Char ( GeneralCategory(Space, Format), generalCategory )+import Data.Text ( Text )+import qualified Data.Text as Text+import qualified Data.Text.IO as Text {- Strict IO -}++import System.IO ( IOMode(ReadMode), hSetEncoding, utf8, withFile )++import Data.List.Extra.Drop ( dropWhileEnd1, dropWhile1 )++type Verbose = Bool+type TabSize = Int++-- | Default tab size.+--+defaultTabSize :: TabSize+defaultTabSize = 8++-- | Result of checking a file against the whitespace policy.+--+data CheckResult+ = CheckOK+ -- ^ The file satifies the policy.+ | CheckViolation Text [LineError]+ -- ^ The file violates the policy, a fix and a list of+ -- violating lines are returned.+ | CheckIOError IOException+ -- ^ An I/O error occurred while accessing the file.+ -- (E.g., the file is not UTF8 encoded.)++-- | Represents a line of input violating whitespace rules.+-- Stores the index of the line and the line itself.+data LineError = LineError Int Text++-- | Check a file against the whitespace policy,+-- returning a fix if violations occurred.+--+checkFile :: TabSize -> Verbose -> FilePath -> IO CheckResult+checkFile tabSize verbose f =+ handle (\ (e :: IOException) -> return $ CheckIOError e) $+ withFile f ReadMode $ \ h -> do+ hSetEncoding h utf8+ s <- Text.hGetContents h+ let (s', lvs)+ | verbose = transformWithLog tabSize s+ | otherwise = (transform tabSize s, [])+ return $ if s' == s then CheckOK else CheckViolation s' lvs++transform+ :: TabSize -- ^ Expand tab characters to so many spaces. Keep tabs if @<= 0@.+ -> Text -- ^ Text before transformation.+ -> Text -- ^ Text after transformation.+transform tabSize =+ Text.unlines .+ removeFinalEmptyLinesExceptOne .+ map (removeTrailingWhitespace . convertTabs tabSize) .+ Text.lines+ where+ removeFinalEmptyLinesExceptOne =+ reverse . dropWhile1 Text.null . reverse++-- | The transformation monad: maintains info about lines that+-- violate the rules. Used in the verbose mode to build a log.+--+type TransformM = Writer [LineError]++-- | Transforms the contents of a file.+--+transformWithLog+ :: TabSize -- ^ Expand tab characters to so many spaces. Keep tabs if @<= 0@.+ -> Text -- ^ Text before transformation.+ -> (Text, [LineError]) -- ^ Text after transformation and violating lines if any.+transformWithLog tabSize =+ runWriter .+ fmap Text.unlines .+ fixAllViolations .+ zip [1..] .+ Text.lines+ where+ fixAllViolations :: [(Int,Text)] -> TransformM [Text]+ fixAllViolations =+ removeFinalEmptyLinesExceptOne+ <=<+ mapM (fixLineWith $ removeTrailingWhitespace . convertTabs tabSize)++ removeFinalEmptyLinesExceptOne :: [Text] -> TransformM [Text]+ removeFinalEmptyLinesExceptOne ls+ | lenLs == lenLs' = pure ls+ | otherwise = do+ tell $ zipWith LineError [1+lenLs' ..] els+ pure ls'+ where+ ls' = dropWhileEnd1 Text.null ls+ lenLs = length ls+ lenLs' = length ls'+ els = replicate (lenLs - lenLs') ""++ fixLineWith :: (Text -> Text) -> (Int, Text) -> TransformM Text+ fixLineWith fixer (i, l)+ | l == l' = pure l+ | otherwise = do+ tell [LineError i l]+ pure l'+ where+ l' = fixer l++removeTrailingWhitespace :: Text -> Text+removeTrailingWhitespace =+ Text.dropWhileEnd $ \ c -> generalCategory c `elem` [Space,Format] || c == '\t'++convertTabs :: TabSize -> Text -> Text+convertTabs tabSize = if tabSize <= 0 then id else+ Text.pack . reverse . fst . foldl (convertOne tabSize) ([], 0) . Text.unpack++convertOne :: TabSize -> (String, Int) -> Char -> (String, Int)+convertOne tabSize (a, p) '\t' = (addSpaces n a, p + n)+ where+ n = tabSize - p `mod` tabSize -- Here, tabSize > 0 is guaranteed+convertOne _tabSize (a, p) c = (c:a, p+1)++addSpaces :: Int -> String -> String+addSpaces n = (replicate n ' ' ++)++-- | Print a erroneous line with 'visibleSpaces'.+--+displayLineError :: FilePath -> LineError -> Text+displayLineError fname (LineError i l) = Text.concat+ [ Text.pack fname+ , ":"+ , Text.pack $ show i+ , ": "+ , visibleSpaces l+ ]++-- | Replace spaces and tabs with visible characters for presentation purposes.+-- Space turns into '·' and tab into '<TAB>'.+--+visibleSpaces :: Text -> Text+visibleSpaces s+ | Text.null s = "<NEWLINE>"+ | otherwise = flip Text.concatMap s $ \case+ '\t' -> "<TAB>"+ ' ' -> "·"+ c -> Text.pack [c]
− stack-8.0.2.yaml
@@ -1,8 +0,0 @@-resolver: lts-9.21-compiler: ghc-8.0.2-compiler-check: match-exact--extra-deps:- - text-1.2.3.1- - extra-1.7.1- - filepattern-0.1.3
− stack-8.2.2.yaml
@@ -1,7 +0,0 @@-resolver: lts-11.22-compiler: ghc-8.2.2-compiler-check: match-exact--extra-deps:- - text-1.2.3.1- - filepattern-0.1.3
− stack-9.2.4.yaml
@@ -1,3 +0,0 @@-resolver: nightly-2022-11-12-compiler: ghc-9.2.4-compiler-check: match-exact
− stack-9.2.5.yaml
@@ -1,3 +0,0 @@-resolver: lts-20.3-compiler: ghc-9.2.5-compiler-check: match-exact
+ stack-9.2.8.yaml view
@@ -0,0 +1,3 @@+resolver: lts-20.26+compiler: ghc-9.2.8+compiler-check: match-exact
− stack-9.4.3.yaml
@@ -1,3 +0,0 @@-resolver: nightly-2022-12-05-compiler: ghc-9.4.3-compiler-check: match-exact
+ stack-9.4.5.yaml view
@@ -0,0 +1,3 @@+resolver: lts-21.0+compiler: ghc-9.4.5+compiler-check: match-exact
+ stack-9.6.2.yaml view
@@ -0,0 +1,3 @@+resolver: nightly-2023-06-22+compiler: ghc-9.6.2+compiler-check: match-exact
+ test/Golden.hs view
@@ -0,0 +1,47 @@+{-# LANGUAGE OverloadedStrings #-}++-- | A golden value testsuite for fix-whitespace.+--++module Main where++import Data.ByteString.Lazy ( ByteString )+import qualified Data.Text as Text+import qualified Data.Text.Lazy as LazyText+import qualified Data.Text.Lazy.Encoding as LazyText++import System.FilePath ( takeBaseName, replaceExtension )++import Test.Tasty ( defaultMain, TestTree, testGroup )+import Test.Tasty.Golden ( goldenVsString, findByExtension )++import Data.Text.FixWhitespace ( CheckResult(CheckOK, CheckViolation, CheckIOError)+ , checkFile, displayLineError, defaultTabSize )++main :: IO ()+main = defaultMain =<< goldenTests++goldenTests :: IO TestTree+goldenTests = do+ files <- findByExtension [".txt"] "test"+ return $ testGroup "Golden tests"+ [ goldenVsString+ (takeBaseName file) -- test name+ (replaceExtension file ".golden") -- golden file path+ (goldenValue file) -- action whose result is tested+ | file <- files+ ]++goldenValue :: FilePath -> IO ByteString+goldenValue file = do+ checkFile defaultTabSize {-verbose: -}True file >>= \case++ CheckIOError e ->+ ioError e++ CheckOK ->+ return "OK\n"++ CheckViolation _ errs ->+ return $ LazyText.encodeUtf8 $ LazyText.fromStrict $+ Text.unlines $ "Violations:" : map (displayLineError file) errs
+ test/QuickCheck.hs view
@@ -0,0 +1,35 @@+{-# LANGUAGE TemplateHaskell #-}++-- | Test 'dropWhileEnd1'.++module Main where++import Data.Maybe ( isJust )++import Test.QuickCheck.All ( allProperties )+import Test.Tasty ( defaultMain )+import Test.Tasty.QuickCheck ( testProperties )++import Data.List.Extra.Drop ( dropWhile1, dropWhileEnd1 )++-- | If the predicate is true for exactly one value, we can express 'dropWhileEnd1' in terms of 'dropWhile1'.+--+-- Example: predicate 'not' holds only for 'False'.+--+prop_dropWhileEnd1_Bool :: [Bool] -> Bool+prop_dropWhileEnd1_Bool xs = dropWhileEnd1 not xs == (reverse . dropWhile1 not . reverse) xs++-- | If the predicate is *not* a singleton, this relation does not hold.+--+prop_dropWhileEnd1_Maybe_Bool :: Bool+prop_dropWhileEnd1_Maybe_Bool = l /= r+ where+ xs = [Just True, Just False]+ l = dropWhileEnd1 isJust xs -- Just True+ r = (reverse . dropWhile1 isJust . reverse) xs -- Just False++-- Pseudo Template Haskell instruction to make $allProperties work+return []++main :: IO ()+main = defaultMain $ testProperties "Tests" $allProperties