stylish-cabal 0.3.0.2 → 0.4.0.0
raw patch · 19 files changed
+223/−215 lines, 19 filesdep ~Cabaldep ~basedep ~haddock-library
Dependency ranges changed: Cabal, base, haddock-library
Files
- ChangeLog.md +4/−0
- Main.hs +2/−1
- src/Parse.hs +49/−33
- src/Render.hs +13/−5
- src/Render/Lib.hs +17/−63
- src/Render/Lib/Haddock.hs +1/−1
- src/StylishCabal.hs +0/−1
- src/Transform.hs +17/−4
- src/Types/Field.hs +7/−2
- stylish-cabal.cabal +12/−11
- tests/cabal-files/example-out.txt +9/−9
- tests/cabal-files/example.txt +1/−1
- tests/roundtrip/Hackage.hs +8/−1
- tests/roundtrip/Main.hs +10/−11
- tests/strictness/Instances.hs +31/−28
- tests/strictness/Main.hs +5/−3
- tests/utils/Expectations.hs +9/−21
- tests/utils/SortedPackageDescription.hs +20/−12
- tests/utils/SortedPackageDescription/TH.hs +8/−8
ChangeLog.md view
@@ -27,3 +27,7 @@ * Description rendering has been rewritten. Rather than naive reformatting, it now uses the proper Haddock parser. * Show1/Eq1 instances for Result++## 0.4.0.0 -- 2018-03-08++* Cabal 2.2 and GHC 8.4 support
Main.hs view
@@ -3,6 +3,7 @@ module Main where +import qualified Data.ByteString as B import Data.Char import Data.Monoid.Compat import Options.Applicative hiding (ParserResult(..))@@ -67,7 +68,7 @@ main :: IO () main = do o <- execParser $ info (opts <**> helper) (fullDesc <> progDesc "Format a Cabal file")- f <- maybe getContents readFile (file o)+ f <- maybe B.getContents B.readFile (file o) doc <- prettyOpts (renderOpts o) <$> readPackageDescription (file o) f if inPlace o then case file o of
src/Parse.hs view
@@ -15,17 +15,21 @@ ) where import Control.DeepSeq+import Control.Monad.Compat import Data.Data import Data.Maybe-import Distribution.PackageDescription.Parse (parseGenericPackageDescription)-import Distribution.ParseUtils+import Distribution.PackageDescription+import Distribution.PackageDescription.Parsec+ ( parseGenericPackageDescription+ , runParseResult+ )+import Distribution.Parsec.Common import Distribution.Simple.Utils import Distribution.Verbosity+import Distribution.Version import GHC.Generics import Prelude.Compat-import System.Environment import System.Exit-import System.IO #if MIN_VERSION_base(4,9,0) import Data.Functor.Classes@@ -34,8 +38,7 @@ -- | Like Cabal's @ParseResult@, but treats warnings as a separate failure -- case. data Result a- = Error (Maybe LineNo)- String -- ^ Parse error on the given line.+ = Error [PError] -- ^ Parse errors. | Warn [PWarning] -- ^ Warnings emitted during parse. | Success a -- ^ The input is a compliant package description. deriving (Show, Eq, Functor, Generic, Typeable, Data)@@ -44,48 +47,70 @@ deriving instance Generic1 Result #endif +#if !MIN_VERSION_base(4,8,0)+deriving instance Typeable PError++deriving instance Typeable Position++deriving instance Typeable PWarnType+#endif+ #if MIN_VERSION_base(4,9,0) instance Show1 Result where liftShowsPrec sp _ p (Success n) = showsUnaryWith sp "Success" p n liftShowsPrec _ _ p (Warn pws) = showsUnaryWith showsPrec "Warn" p pws- liftShowsPrec _ _ p (Error ml s) = showsBinaryWith showsPrec showsPrec "Error" p ml s+ liftShowsPrec _ _ p (Error s) = showsUnaryWith showsPrec "Error" p s instance Eq1 Result where liftEq eq (Success a) (Success b) = eq a b- liftEq _ (Error ml s) (Error ml2 s2) = (ml,s) == (ml2,s2)+ liftEq _ (Error s) (Error s2) = s == s2 liftEq _ (Warn pws) (Warn pws2) = pws == pws2 liftEq _ _ _ = False #endif -- | Case analysis for 'Result'.-result :: (Maybe LineNo -> String -> b) -> ([PWarning] -> b) -> (a -> b) -> Result a -> b+result :: ([PError] -> b) -> ([PWarning] -> b) -> (a -> b) -> Result a -> b result e w s p = case p of- Error l m -> e l m+ Error l -> e l Warn ws -> w ws Success r -> s r -instance NFData a => NFData (Result a)+deriving instance Data PError -deriving instance Generic PWarning+deriving instance Eq PError +deriving instance Eq PWarning++instance NFData a => NFData (Result a)+ deriving instance Data PWarning -deriving instance Typeable PWarning+deriving instance Data Position -instance NFData PWarning+deriving instance Data PWarnType +deriving instance Typeable PWarning+ -- | This function is similar to Cabal's own file parser, except that it -- treats warnings as a separate failure case. There are a wide range of -- different behaviors accepted by different Cabal parser versions. Parse -- warnings generally indicate a version-related inconsistency, so we play -- it safe here. parsePackageDescription input =- case parseGenericPackageDescription input of- ParseFailed e -> uncurry Error $ locatedErrorMsg e- ParseOk warnings x- | null warnings -> Success x- | otherwise -> Warn $ reverse warnings+ let (warnings, r) = runParseResult $ parseGenericPackageDescription input+ in case r of+ Left (_, errors) -> Error errors+ Right x+ | null warnings -> parseResult x+ | otherwise -> Warn warnings+ where+ parseResult gpd =+ if specVersionRaw (packageDescription gpd) == Right anyVersion+ then Warn [PWarning PWTOther zeroPos versWarning]+ else Success gpd+ versWarning =+ "File does not specify a cabal-version. stylish-cabal requires at least 1.2" -- | Shorthand to combine 'parsePackageDescription' and one of 'printWarnings' or -- 'displayError'. The given 'FilePath' is used only for error messages and@@ -98,17 +123,8 @@ printWarnings fpath ps = mapM_ (warn normal . showPWarning (fromMaybe "<input>" fpath)) ps >> exitFailure --- | Print a parse error to 'stderr', annotated with filepath and line--- number (if available), then exit.-displayError :: Maybe FilePath -> Maybe LineNo -> String -> IO a-displayError fpath line' message = do- prog <- getProgName- hPutStrLn stderr $- prog ++- ": " ++- fromMaybe "<input>" fpath ++- (case line' of- Just lineno -> ":" ++ show lineno- Nothing -> "") ++- ": " ++ message- exitFailure+-- | Print a parse error to 'stderr', annotated with filepath if available,+-- then exit.+displayError :: Maybe FilePath -> [PError] -> IO a+displayError fpath warns =+ mapM_ (warn normal . showPError (fromMaybe "<input>" fpath)) warns >> exitFailure
src/Render.hs view
@@ -10,6 +10,7 @@ import Data.List.Compat hiding (group) import Data.Maybe import Data.Ord+import Distribution.Pretty import Distribution.Types.Dependency import Distribution.Types.IncludeRenaming import Distribution.Types.LegacyExeDependency@@ -20,6 +21,7 @@ import Distribution.Types.PkgconfigDependency import Distribution.Types.PkgconfigName import Distribution.Version+import Documentation.Haddock.Types import Prelude.Compat hiding ((<$>)) import qualified Prelude.Compat as P import Text.PrettyPrint.ANSI.Leijen@@ -51,17 +53,18 @@ val' (File x) = pure $ filepath x val' (Version v) = pure $ string $ prettyShow v val' (CabalVersion (Left v)) = pure $ string $ prettyShow v- val' (CabalVersion (Right v))- | v == anyVersion = showVersionRange (orLaterVersion (mkVersion [1, 10]))- | otherwise = showVersionRange v+ val' (CabalVersion (Right vr))+ | vr == anyVersion = showVersionRange (orLaterVersion (mkVersion [1, 10]))+ | otherwise = showVersionRange vr val' (License l) = pure $ string $ prettyShow l+ val' (SPDXLicense l) = pure $ string $ prettyShow l val' (TestedWith ts) = renderTestedWith ts val' (LongList fs) = pure $ vcat $ map filepath fs val' (Commas fs) = pure $ fillSep $ punctuate comma $ map filepath fs val' (Spaces ls) = pure $ fillSep $ map filepath ls val' (Modules ms) = pure $ vcat $ map moduleDoc $ sort ms val' (Module m) = pure $ moduleDoc m- val' (Extensions es) = val' (LongList $ map prettyShow es)+ val' (Extensions es) = val' (LongList $ map prettyShow $ sort es) val' (FlibType ty) = pure $ string $ prettyShow ty val' (FlibOptions fs) = val' $ Spaces $ map prettyShow fs val' x = error $ show x@@ -69,7 +72,12 @@ descriptionToDoc k paras = do n <- asks indentSize- return $ (<>) colon $ nest n $ flatAlt (linebreak <> ds) (indent (k + 1) ds)+ return $+ (<>) colon $+ nest n $+ case paras of+ DocParagraph {} -> indent (k + 1) ds+ _ -> linebreak <> ds where ds = renderDescription paras
src/Render/Lib.hs view
@@ -1,4 +1,3 @@-{-# OPTIONS_GHC -fno-warn-deprecations #-} {-# Language FlexibleContexts #-} {-# Language OverloadedStrings #-} @@ -6,7 +5,6 @@ ( P(..) , renderBlockHead , showVersionRange- , prettyShow , moduleDoc , rexpModuleDoc , filepath@@ -20,11 +18,11 @@ import Distribution.Compiler import Distribution.ModuleName import Distribution.PackageDescription-import Distribution.Text+import Distribution.Pretty import Distribution.Types.ExeDependency import Distribution.Types.PackageName import Distribution.Types.UnqualComponentName-import Distribution.Version hiding (foldVersionRange)+import Distribution.Version import Prelude.Compat import Text.PrettyPrint.ANSI.Leijen hiding ((<$>)) @@ -32,18 +30,6 @@ import Render.Options import Types.Block -prettyShow = show . disp--wildcardUpperBound =- alterVersion $ \lowerBound -> init lowerBound ++ [last lowerBound + 1]--majorUpperBound :: Version -> Version-majorUpperBound = alterVersion go- where- go [] = [0, 1]- go [m1] = [m1, 1]- go (m1:m2:_) = [m1, m2 + 1]- newtype P = P { unP :: String } deriving (Eq)@@ -70,56 +56,24 @@ showVersionRange r = do opts <- ask return $- foldVersionRange- empty- (\v -> green "==" <+> dullyellow (string (showVersion v)))- (\v -> green ">" <+> dullyellow (string (showVersion v)))- (\v -> green "<" <+> dullyellow (string (showVersion v)))- (\v -> green ">=" <+> dullyellow (string (showVersion v)))- (\v -> green "<=" <+> dullyellow (string (showVersion v)))- (\v _ -> green "==" <+> dullyellow (string (showVersion v) <> ".*"))- (\v _ -> green "^>=" <+> dullyellow (string (showVersion v)))- (\a b -> a <+> green "||" <+> b)- (\a b -> a <+> green "&&" <+> b)- parens .+ cataVersionRange fold' $ (if simplifyVersions opts then simplifyVersionRange- else id) $- r--{------------ EVIL HACK GOES HERE ------------------- Distribution.Version.foldVersionRange' treats both of the following-- * "(== v) || (> v)"-- * "(> v) || (== v)"-- as "(>= v)"---- Makes sense, right? Nope. ">=" is always Union (This ...) (Later ...),-- whereas if Union (Later ...) (This ...) is present in the source file, we-- must preserve it, otherwise roundtrip tests fail because we're switching-- the order of the Union arguments!---- The other solution is to wrap VersionRange in a newtype that disregards-- Union argument ordering for the equality test, but I leave that as an-- exercise to the reader.---- Arguments renamed to avoid shadowing--}-foldVersionRange anyv this later earlier orL orE wildcard major both oneof wrap = fold+ else id)+ r where- fold AnyVersion = anyv- fold (ThisVersion v) = this v- fold (LaterVersion v) = later v- fold (EarlierVersion v) = earlier v- fold (UnionVersionRanges (ThisVersion v) (LaterVersion v'))- | v == v' = orL v- fold (UnionVersionRanges (ThisVersion v) (EarlierVersion v'))- | v == v' = orE v- fold (WildcardVersion v) = wildcard v (wildcardUpperBound v)- fold (MajorBoundVersion v) = major v (majorUpperBound v)- fold (UnionVersionRanges v1 v2) = both (fold v1) (fold v2)- fold (IntersectVersionRanges v1 v2) = oneof (fold v1) (fold v2)- fold (VersionRangeParens v) = wrap (fold v)+ fold' AnyVersionF = empty+ fold' (ThisVersionF v) = green "==" <+> dullyellow (string (prettyShow v))+ fold' (LaterVersionF v) = green ">" <+> dullyellow (string (prettyShow v))+ fold' (OrLaterVersionF v) = green ">=" <+> dullyellow (string (prettyShow v))+ fold' (EarlierVersionF v) = green "<" <+> dullyellow (string (prettyShow v))+ fold' (OrEarlierVersionF v) = green "<=" <+> dullyellow (string (prettyShow v))+ fold' (WildcardVersionF v) = green "==" <+> dullyellow (string (prettyShow v) <> ".*")+ fold' (MajorBoundVersionF v) = green "^>=" <+> dullyellow (string (prettyShow v))+ fold' (UnionVersionRangesF a b) = a <+> green "||" <+> b+ fold' (IntersectVersionRangesF a b) = a <+> green "&&" <+> b+ fold' (VersionRangeParensF a) = parens a+ filepath :: String -> Doc filepath x
src/Render/Lib/Haddock.hs view
@@ -120,7 +120,7 @@ go (DocPic (Picture p t)) = return $ enclose (green "<<") (green ">>") (string $ p ++ maybe "" (" " ++) (unNl <$> t))- go x = error $ show x+ go x = error $ "Unhandled Haddock AST node: " ++ show x unNl = map (\x ->
src/StylishCabal.hs view
@@ -23,7 +23,6 @@ import Data.Default import Distribution.PackageDescription (GenericPackageDescription) import Prelude.Compat-import Render.Lib.Haddock import Text.PrettyPrint.ANSI.Leijen hiding (pretty) import Parse
src/Transform.hs view
@@ -68,7 +68,10 @@ , version "version" (pkgVersion package) , nonEmpty (stringField "synopsis") synopsis , desc description- , ffilter (/= UnspecifiedLicense) (licenseField "license") license+ , either+ (spdxLicenseField "license")+ (ffilter (/= UnspecifiedLicense) (licenseField "license"))+ licenseRaw , license' licenseFiles , nonEmpty (stringField "copyright") copyright , nonEmpty (stringField "author") author@@ -79,7 +82,7 @@ , nonEmpty (stringField "homepage") homepage , nonEmpty (stringField "package-url") pkgUrl , nonEmpty (stringField "bug-reports") bugReports- , stringField "build-type" . show =<< buildType+ , stringField "build-type" . show =<< buildTypeRaw , nonEmpty (longList "extra-tmp-files") extraTmpFiles , nonEmpty (longList "extra-source-files") extraSrcFiles , nonEmpty (longList "extra-doc-files") extraDocFiles@@ -206,8 +209,10 @@ in b1 : maybeToList b2 buildInfoToFields _ BuildInfo {..} =+ staticOptions `seq` -- staticOptions isn't in the parser yet [ nonEmpty (commas "other-languages" . map show) otherLanguages , nonEmpty (modules "other-modules") otherModules+ , nonEmpty (modules "virtual-modules") virtualModules , nonEmpty (mixins_ "mixins") mixins , nonEmpty (modules "autogen-modules") autogenModules , nonEmpty (commas "hs-source-dirs") hsSourceDirs@@ -216,20 +221,28 @@ , nonEmpty (extensions "default-extensions") defaultExtensions , nonEmpty (extensions "extensions") oldExtensions , nonEmpty (extensions "other-extensions") otherExtensions+ , nonEmpty (commas "extra-library-flavours") extraLibFlavours , nonEmpty (commas "extra-libraries") extraLibs , nonEmpty (commas "extra-ghci-libraries") extraGHCiLibs+ , nonEmpty (commas "extra-bundled-libraries") extraBundledLibs , nonEmpty (pcDepends "pkgconfig-depends") pkgconfigDepends , nonEmpty (commas "frameworks") frameworks , nonEmpty (commas "extra-framework-dirs") extraFrameworkDirs- , nonEmpty (spaces "cpp-options") cppOptions , nonEmpty (spaces "cc-options") ccOptions+ , nonEmpty (spaces "cxx-options") cxxOptions+ , nonEmpty (spaces "cmm-options") cmmOptions+ , nonEmpty (spaces "asm-options") asmOptions+ , nonEmpty (spaces "cpp-options") cppOptions , nonEmpty (spaces "ld-options") ldOptions+ , nonEmpty (commas "js-sources") jsSources+ , nonEmpty (commas "cxx-sources") cxxSources , nonEmpty (commas "c-sources") cSources+ , nonEmpty (commas "cmm-sources") cmmSources+ , nonEmpty (commas "asm-sources") asmSources , nonEmpty (commas "extra-lib-dirs") extraLibDirs , nonEmpty (commas "includes") includes , nonEmpty (commas "install-includes") installIncludes , nonEmpty (commas "include-dirs") includeDirs- , nonEmpty (commas "js-sources") jsSources , ffilter not (stringField "buildable" . show) buildable , nonEmpty (toolDepends "build-tool-depends") newTools , nonEmpty (oldToolDepends "build-tools") oldTools
src/Types/Field.hs view
@@ -24,6 +24,7 @@ , longList , testedField , licenseField+ , spdxLicenseField , dependencies , nonEmpty , stringField@@ -33,6 +34,7 @@ import Distribution.Compiler import Distribution.License import Distribution.ModuleName+import qualified Distribution.SPDX as SPDX import Distribution.Types.Dependency import Distribution.Types.ExeDependency import Distribution.Types.ForeignLibOption@@ -52,6 +54,7 @@ | Version Version | CabalVersion (Either Version VersionRange) | License License+ | SPDXLicense SPDX.LicenseExpression | Str String | File String | Spaces [String]@@ -94,6 +97,9 @@ licenseField n a = Just $ Field n (License a) +spdxLicenseField _ SPDX.NONE = Nothing+spdxLicenseField n (SPDX.License a) = Just $ Field n (SPDXLicense a)+ file n a = Just $ Field n (File a) spaces n as = Just $ Field n (Spaces as)@@ -106,8 +112,7 @@ version n a = Just $ Field n (Version a) -cabalVersion _ (Right x)- | x == anyVersion = Nothing+cabalVersion _ (Right vr) | vr == anyVersion = Nothing cabalVersion n a = Just $ Field n (CabalVersion a) modules n as = Just $ Field n (Modules as)
stylish-cabal.cabal view
@@ -1,5 +1,5 @@ name: stylish-cabal-version: 0.3.0.2+version: 0.4.0.0 synopsis: Format Cabal files description: A tool for nicely formatting your Cabal file. license: BSD3@@ -7,7 +7,7 @@ author: Jude Taylor maintainer: me@jude.xyz tested-with: GHC == 7.4.2, GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.2,- GHC == 8.2.2+ GHC == 8.2.2, GHC == 8.4.1, GHC == 8.5.* category: Language build-type: Simple extra-source-files: ChangeLog.md@@ -31,9 +31,8 @@ flag test-strictness default: False manual: True- description:- Run the strictness testsuite. This requires the StrictCheck package which is not yet- on Hackage, and thus is disabled by default.+ description: Run the strictness testsuite. This requires the StrictCheck package which+ is not yet on Hackage, and thus is disabled by default. library exposed-modules: StylishCabal@@ -46,13 +45,14 @@ Types.Block Types.Field hs-source-dirs: src- build-depends: base >= 4.4 && < 4.11- , Cabal ^>= 2.0.0+ build-depends: base == 4.*+ , Cabal == 2.2.* , ansi-wl-pprint , base-compat , data-default , deepseq- , haddock-library ^>= 1.4.0+ , haddock-library == 1.5.*+ , microlens , mtl , split default-language: Haskell2010@@ -79,12 +79,12 @@ , haddock-library , hspec , hspec-core- , hspec-expectations-pretty-diff , microlens , microlens-th , split , stylish-cabal , template-haskell+ , utf8-string default-language: Haskell2010 default-extensions: NoImplicitPrelude ghc-options: -Wall -fno-warn-missing-signatures@@ -94,7 +94,7 @@ executable stylish-cabal main-is: Main.hs- build-depends: base, base-compat, optparse-applicative, stylish-cabal+ build-depends: base, base-compat, bytestring, optparse-applicative, stylish-cabal default-language: Haskell2010 default-extensions: NoImplicitPrelude ghc-options: -Wall@@ -133,7 +133,7 @@ type: exitcode-stdio-1.0 main-is: Main.hs hs-source-dirs: tests/roundtrip- build-depends: base, base-compat, hspec, test-utils+ build-depends: base, base-compat, bytestring, hspec, test-utils default-language: Haskell2010 default-extensions: NoImplicitPrelude ghc-options: -Wall -fno-warn-missing-signatures@@ -148,6 +148,7 @@ build-depends: base , aeson , base-compat+ , bytestring , hspec , hspec-core , lens
tests/cabal-files/example-out.txt view
@@ -1,4 +1,4 @@--- vi: ft=cabal+Up to date name: example-package version: 1.2.3.4 synopsis: A short synopsis for this package@@ -31,10 +31,10 @@ data-files: "file1 with spaces" data/* data-dir: .-cabal-version: >= 1.8+cabal-version: 2.0 custom-setup- setup-depends: base >= 4.5 && < 4.11, Cabal == 1.25+ setup-depends: base >= 4.5 && < 4.11, Cabal >= 1.25 && <= 1.25 source-repository head type: git@@ -74,9 +74,9 @@ hs-source-dirs: src build-depends: base == 4.* , attoparsec- , bar == 3.4.*+ , bar ^>= 3.4 , foo >= 1.2.3 && < 1.4- , somelib >= 1.2.3.4 && < 1.3+ , somelib ^>= 1.2.3.4 default-extensions: NoMonomorphismRestriction other-extensions: OverloadedStrings extra-libraries: iconv@@ -84,17 +84,17 @@ pkgconfig-depends: cairo >= 1.0, gtk+-2.0 >= 2.10 frameworks: CoreAudio extra-framework-dirs: frameworks- cpp-options: -DFOO=1 cc-options: -compat+ cpp-options: -DFOO=1 ld-options: -static+ js-sources: jssource.js c-sources: csource.c extra-lib-dirs: lib, lib2 includes: example.h install-includes: output.h include-dirs: include- js-sources: jssource.js- build-tool-depends: cpphs:cpphs >= 4.0, foo:bar == 1.2.*, hsc2hs:hsc2hs- build-tools: unknown-build-tool+ build-tool-depends: cpphs:cpphs >= 4.0, foo:bar == 1.2.*+ build-tools: hsc2hs, unknown-build-tool ghc-options: -Wall ghc-prof-options: -fcaf-all ghc-shared-options: -fobject-code
tests/cabal-files/example.txt view
@@ -1,6 +1,6 @@+cabal-version: 2.0 name: example-package version: 1.2.3.4-cabal-version: >=1.8 build-type: Custom license: MIT license-files: LICENSE1, "license with spaces"
tests/roundtrip/Hackage.hs view
@@ -16,8 +16,15 @@ import System.IO import System.Random.MWC import System.Random.MWC.Distributions+import Data.ByteString.Lazy (toStrict)+import System.IO import Test.Hspec+import Prelude.Compat+import qualified Data.Vector as V import Test.Hspec.Core.Spec+import Expectations+import Test.Hspec+import Test.Hspec.Core.Spec import Text.Read (readMaybe) newtype GetPackage = GetPackage@@ -68,7 +75,7 @@ get $ "http://hackage.haskell.org/package/" ++ pname ++ "/revision/" ++ show (number recent) ++ ".cabal"- expectParse $ toString $ view responseBody cabalFile+ expectParse $ toStrict $ view responseBody cabalFile isProblematic _ = False
tests/roundtrip/Main.hs view
@@ -1,7 +1,6 @@-{-# OPTIONS_GHC -fno-warn-orphans -fno-warn-missing-signatures #-}- module Main where +import qualified Data.ByteString as B import Expectations import Prelude.Compat import Test.Hspec@@ -11,16 +10,16 @@ hspecColor $ describe "comprehensive check" $ do it "retains every attribute" $- expectParse =<< readFile "tests/cabal-files/example.txt"+ expectParse =<< B.readFile "tests/cabal-files/example.txt" it "codeblocks" $ do- expectParse =<< readFile "tests/cabal-files/hpc-coveralls.txt"- expectParse =<< readFile "tests/cabal-files/helics.txt"+ expectParse =<< B.readFile "tests/cabal-files/hpc-coveralls.txt"+ expectParse =<< B.readFile "tests/cabal-files/helics.txt" it "non-ghc compilers" $- expectParse =<< readFile "tests/cabal-files/exposed-containers.txt"+ expectParse =<< B.readFile "tests/cabal-files/exposed-containers.txt" it "baffling version constraints" $- expectParse =<< readFile "tests/cabal-files/deka-tests.txt"+ expectParse =<< B.readFile "tests/cabal-files/deka-tests.txt" it "markup" $ do- expectParse =<< readFile "tests/cabal-files/BiGUL.txt"- expectParse =<< readFile "tests/cabal-files/ChasingBottoms.txt"- expectParse =<< readFile "tests/cabal-files/OrPatterns.txt"- expectParse =<< readFile "tests/cabal-files/Cardinality.txt"+ expectParse =<< B.readFile "tests/cabal-files/BiGUL.txt"+ expectParse =<< B.readFile "tests/cabal-files/ChasingBottoms.txt"+ expectParse =<< B.readFile "tests/cabal-files/OrPatterns.txt"+ expectParse =<< B.readFile "tests/cabal-files/Cardinality.txt"
tests/strictness/Instances.hs view
@@ -1,7 +1,6 @@ {-# OPTIONS_GHC -fno-warn-orphans #-} {-# Language CPP #-} {-# Language DataKinds #-}-{-# Language DeriveAnyClass #-} {-# Language TemplateHaskell #-} {-# Language TypeFamilies #-} {-# Language StandaloneDeriving #-}@@ -14,24 +13,23 @@ render = prettyPrim #define DERIVE(c) deriveGeneric ''c; instance Shaped c-#define DERIVEN(c) DERIVE(c); deriving instance NFData c module Instances where import Data.ByteString.Short import Data.Word import Distribution.Compiler-import Control.DeepSeq import Distribution.License import Distribution.ModuleName-import Distribution.Types.Benchmark-import Distribution.Types.Condition+import qualified Distribution.SPDX as SPDX import Distribution.System+import Distribution.Types.Benchmark import Distribution.Types.BenchmarkInterface import Distribution.Types.BenchmarkType import Distribution.Types.BuildInfo import Distribution.Types.BuildType import Distribution.Types.CondTree+import Distribution.Types.Condition import Distribution.Types.Dependency import Distribution.Types.ExeDependency import Distribution.Types.Executable@@ -67,15 +65,40 @@ import Test.StrictCheck.Shaped DERIVE(Arch)+DERIVE(Benchmark)+DERIVE(BenchmarkInterface)+DERIVE(BenchmarkType)+DERIVE(BuildInfo) DERIVE(BuildType)+DERIVE(CompilerFlavor) DERIVE(ConfVar) DERIVE(Dependency) DERIVE(ExeDependency)+DERIVE(Executable)+DERIVE(ExecutableScope)+DERIVE(Extension) DERIVE(Flag) DERIVE(FlagName)+DERIVE(ForeignLib)+DERIVE(ForeignLibOption)+DERIVE(ForeignLibType) DERIVE(GenericPackageDescription)+DERIVE(IncludeRenaming)+DERIVE(KnownExtension)+DERIVE(Language) DERIVE(LegacyExeDependency)+DERIVE(LibVersionInfo)+DERIVE(Library) DERIVE(License)+DERIVE(SPDX.License)+DERIVE(SPDX.LicenseExpression)+DERIVE(SPDX.SimpleLicenseExpression)+DERIVE(SPDX.LicenseId)+DERIVE(SPDX.LicenseRef)+DERIVE(SPDX.LicenseExceptionId)+DERIVE(Mixin)+DERIVE(ModuleReexport)+DERIVE(ModuleRenaming) DERIVE(OS) DERIVE(PackageDescription) DERIVE(PackageIdentifier)@@ -87,32 +110,12 @@ DERIVE(SetupBuildInfo) DERIVE(ShortText) DERIVE(SourceRepo)+DERIVE(TestSuite)+DERIVE(TestSuiteInterface)+DERIVE(TestType) DERIVE(UnqualComponentName) DERIVE(Version) DERIVE(VersionRange)--DERIVEN(Benchmark)-DERIVEN(BenchmarkInterface)-DERIVEN(BenchmarkType)-DERIVEN(BuildInfo)-DERIVEN(CompilerFlavor)-DERIVEN(Executable)-DERIVEN(ExecutableScope)-DERIVEN(Extension)-DERIVEN(ForeignLib)-DERIVEN(ForeignLibOption)-DERIVEN(ForeignLibType)-DERIVEN(IncludeRenaming)-DERIVEN(KnownExtension)-DERIVEN(Language)-DERIVEN(LibVersionInfo)-DERIVEN(Library)-DERIVEN(Mixin)-DERIVEN(ModuleReexport)-DERIVEN(ModuleRenaming)-DERIVEN(TestSuite)-DERIVEN(TestSuiteInterface)-DERIVEN(TestType) deriveGeneric ''CondTree
tests/strictness/Main.hs view
@@ -2,9 +2,10 @@ {-# Language FlexibleContexts #-} import Control.DeepSeq+import qualified Data.ByteString as B import Distribution.PackageDescription import qualified Distribution.PackageDescription as C-import Distribution.PackageDescription.Parse+import Distribution.PackageDescription.Parsec import Instances () import Prelude.Compat import Pretty@@ -33,9 +34,10 @@ main :: IO () main = hspec $ do- ParseOk _ gpd <-+ ([], Right gpd) <- runIO $- parseGenericPackageDescription <$> readFile "tests/cabal-files/example"+ runParseResult . parseGenericPackageDescription <$>+ B.readFile "tests/cabal-files/example.txt" describe "pretty" $ it "should fully evaluate the package description" $ do let expected = nf gpd
tests/utils/Expectations.hs view
@@ -3,45 +3,33 @@ module Expectations where -import Control.Monad+import qualified Data.ByteString.UTF8 as U import Data.List.Compat-import Distribution.PackageDescription.Parse+import Distribution.PackageDescription.Parsec import Prelude.Compat import SortedPackageDescription import StylishCabal as S import Test.Hspec-import Test.Hspec.Core.Runner import Test.Hspec.Core.Spec--- import Test.Hspec.Expectations.Pretty--deriving instance Eq a => Eq (ParseResult a)+import Test.Hspec.Core.Runner hspecColor = hspecWith (defaultConfig {configColorMode = ColorAlways}) expectParse cabalStr = do- -- massive width limit is because:- --- -- edge case: a line ending in " ." will be word-wrapped to the next- -- line. unfortunately a "." on its own on a line means paragraph break- -- to the haddock parser. this case breaks tests on some hackage- -- packages, but is unlikely to be problematic in practice (because you- -- should just remove the leading space)- let proc = (`displayS` "") . render (maxBound `div` 10) . plain- doc = proc . pretty <$> S.parsePackageDescription cabalStr+ let doc =+ U.fromString . (`displayS` "") . render 80 . plain . pretty <$>+ S.parsePackageDescription cabalStr case doc of S.Success rendered -> do- let ParseOk _ (descrs, original) =- sortGenericPackageDescription <$> parse' cabalStr- ParseOk _ (descrs2, new) =- sortGenericPackageDescription <$> parse' rendered+ let ([], Right original) = fmap sortGenericPackageDescription <$> parse' cabalStr+ ([], Right new) = fmap sortGenericPackageDescription <$> parse' rendered shouldBe original new- forM_ (zip descrs descrs2) (uncurry shouldBe) Warn {} -> expectationFailure "SKIP Warnings generated from original file, cannot guarantee consistency of output" S.Error {} -> expectationFailure "SKIP Original cabal file does not parse" where- parse' = parseGenericPackageDescription+ parse' = runParseResult . parseGenericPackageDescription applySkips i = i
tests/utils/SortedPackageDescription.hs view
@@ -24,6 +24,7 @@ import Distribution.License import Distribution.ModuleName import Distribution.PackageDescription+import qualified Distribution.SPDX as SPDX import Distribution.System import Distribution.Types.CondTree import Distribution.Types.Dependency@@ -33,6 +34,8 @@ import Distribution.Types.ForeignLibOption import Distribution.Types.ForeignLibType import Distribution.Types.IncludeRenaming+import Lens.Micro.TH+import Lens.Micro import Distribution.Types.LegacyExeDependency import Distribution.Types.Mixin import Distribution.Types.PackageId@@ -40,26 +43,21 @@ import Distribution.Types.PkgconfigDependency import Distribution.Types.PkgconfigName import Distribution.Types.UnqualComponentName-import Distribution.Utils.ShortText-import Distribution.Version+import Distribution.Types.Version+import Distribution.Types.VersionRange+import Documentation.Haddock.Types hiding (Version) import Documentation.Haddock.Parser-import Documentation.Haddock.Types- ( DocH(..)- , Example(..)- , Header(..)- , Hyperlink(..)- , Picture(..)- , _doc- )+import Distribution.Utils.ShortText import Language.Haskell.Extension-import Lens.Micro-import Lens.Micro.TH import Prelude.Compat import SortedPackageDescription.TH deriving instance (Ord a, Ord b) => Ord (DocH a b) deriving instance Ord a => Ord (Header a)+deriving instance Ord a => Ord (Table a)+deriving instance Ord a => Ord (TableRow a)+deriving instance Ord a => Ord (TableCell a) deriving instance Ord Hyperlink @@ -126,6 +124,16 @@ unNl x = error $ show x prim [''ModuleName, ''ShortText, ''Char, ''Word64, ''PackageName, ''Int, ''Bool]++deriveSortable_+ "SPDX"+ [ ''SPDX.LicenseExceptionId+ , ''SPDX.LicenseRef+ , ''SPDX.LicenseId+ , ''SPDX.SimpleLicenseExpression+ , ''SPDX.LicenseExpression+ , ''SPDX.License+ ] deriveSortable [ ''BuildType
tests/utils/SortedPackageDescription/TH.hs view
@@ -1,23 +1,23 @@ {-# Language CPP #-}-{-# Language NoMonomorphismRestriction #-}-{-# Language TemplateHaskell #-}-{-# Language UndecidableInstances #-}+{-# Language DefaultSignatures #-} {-# Language FlexibleContexts #-} {-# Language FlexibleInstances #-}-{-# Language TypeSynonymInstances #-}-{-# Language DefaultSignatures #-}+{-# Language NoMonomorphismRestriction #-}+{-# Language TemplateHaskell #-} {-# Language TypeFamilies #-}+{-# Language TypeSynonymInstances #-}+{-# Language UndecidableInstances #-} -#if !MIN_VERSION_base(4,6,0)-{-# Language ConstraintKinds #-}+#if __GLASGOW_HASKELL__ < 706+{-# LANGUAGE ConstraintKinds #-} #endif module SortedPackageDescription.TH where import Control.Monad.Compat import Data.Char (toUpper)-import Language.Haskell.TH import MultiSet+import Language.Haskell.TH import Prelude.Compat class Sortable a where