diff --git a/Changelog.md b/Changelog.md --- a/Changelog.md +++ b/Changelog.md @@ -1,3 +1,16 @@ +## 0.3 + +- Require `Cabal-3.2`. +- Rename `prjOrigFields` to `prjOtherFields` to reflect its intended purpose: + contain all fields of a `cabal.project` file that are not already covered by + a different field of `Project`, such as `prjPackages`, `prjOptPackages`, + `prjSourceRepos`, etc. The semantics of `parseProject` have also been changed + accordingly, so `Project`s produced by `parseProject` will no longer have + `prjOtherFields` entries that overlap with other `Project` fields. +- `ParseError` from `Cabal.Parse` now parameterizes the list type used in + `peErrors`. Most of the time, this will be instantiated to `NonEmpty`. +- Add `NFData` instances + ## 0.2 Add `repoSecure` field to `Repo` in `Cabal.Config`. diff --git a/bench/Bench.hs b/bench/Bench.hs new file mode 100644 --- /dev/null +++ b/bench/Bench.hs @@ -0,0 +1,14 @@ +module Main (main) where + +import Criterion.Main (defaultMain, bench, nf, env) + +import qualified Cabal.Project as C +import qualified Data.ByteString as BS + +main :: IO () +main = defaultMain + [ env (BS.readFile path ) $ \contents -> + bench "haskell-ci.project" $ nf (C.parseProject path) contents + ] + where + path = "fixtures/haskell-ci.project" diff --git a/cabal-install-parsers.cabal b/cabal-install-parsers.cabal --- a/cabal-install-parsers.cabal +++ b/cabal-install-parsers.cabal @@ -1,6 +1,6 @@ cabal-version: 2.2 name: cabal-install-parsers -version: 0.2 +version: 0.3 synopsis: Utilities to work with cabal-install files description: @cabal-install-parsers@ provides parsers for @cabal-install@ files: @@ -20,7 +20,7 @@ maintainer: hvr@gnu.org, oleg.grenrus@iki.fi category: Development build-type: Simple -tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.1 +tested-with: GHC ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.3 || ==8.10.1 extra-source-files: Changelog.md fixtures/*.project @@ -49,11 +49,12 @@ -- GHC-boot libraries build-depends: - , base >=4.10 && <4.14 + , base >=4.10 && <4.15 , binary ^>=0.8.5 , bytestring ^>=0.10.8.1 - , Cabal ^>=3.0.0.0 + , Cabal ^>=3.2.0.0 , containers ^>=0.5.7.1 || ^>=0.6.0.1 + , deepseq ^>=1.4.2.0 , directory ^>=1.3.0.0 , filepath ^>=1.4.1.1 , parsec ^>=3.1.13.0 @@ -108,6 +109,7 @@ , containers , directory , filepath + , pretty -- dependencies needing explicit constraints build-depends: @@ -115,3 +117,23 @@ , tasty ^>=1.2.3 , tasty-golden ^>=2.3.1.1 , tree-diff ^>=0.1 + +benchmark cabal-parsers-bench + default-language: Haskell2010 + type: exitcode-stdio-1.0 + main-is: Bench.hs + hs-source-dirs: bench + + -- inherited constraints + build-depends: + , base + , bytestring + , Cabal + , cabal-install-parsers + , containers + , directory + , filepath + + -- dependencies needing explicit constraints + build-depends: + , criterion ^>=1.5.6.1 diff --git a/fixtures/haskell-ci.golden b/fixtures/haskell-ci.golden --- a/fixtures/haskell-ci.golden +++ b/fixtures/haskell-ci.golden @@ -2,9 +2,15 @@ {prjAllowNewer = [], prjConstraints = [], prjMaxBackjumps = Nothing, - prjOptPackages = [], + prjOptPackages = ["cabal-parsers"], prjOptimization = OptimizationOn, - prjPackages = [".", "cabal-parsers"], + prjOtherFields = [PrettyField "tests" "true", + PrettySection + "package" + ["haskell-ci"] + [PrettyField "ghc-options" "-Wall", + PrettyField "ghc-options" "-Werror"]], + prjPackages = ["."], prjReorderGoals = False, prjSourceRepos = [], prjUriPackages = []} diff --git a/fixtures/haskell-ci.project b/fixtures/haskell-ci.project --- a/fixtures/haskell-ci.project +++ b/fixtures/haskell-ci.project @@ -2,7 +2,7 @@ -- Consult http://cabal.readthedocs.io/en/latest/nix-local-build.html for more information packages: . -packages: cabal-parsers +optional-packages: cabal-parsers tests: true diff --git a/src/Cabal/Config.hs b/src/Cabal/Config.hs --- a/src/Cabal/Config.hs +++ b/src/Cabal/Config.hs @@ -17,11 +17,13 @@ hackageHaskellOrg, ) where +import Control.DeepSeq (NFData (..)) import Control.Exception (throwIO) import Data.ByteString (ByteString) import Data.Function ((&)) import Data.Functor.Identity (Identity (..)) import Data.List (foldl') +import Data.List.NonEmpty (NonEmpty) import Data.Map (Map) import Data.Maybe (fromMaybe) import Distribution.Compat.Lens (LensLike', over) @@ -91,6 +93,9 @@ deriving instance Show (f FilePath) => Show (Config f) +-- | @since 0.2.1 +instance NFData (f FilePath) => NFData (Config f) + -- | Repository. -- -- missing @root-keys@, @key-threshold@ which we don't need now. @@ -99,11 +104,14 @@ { repoURL :: URI , repoSecure :: Bool -- ^ @since 0.2 } - deriving (Show) + deriving (Show, Generic) -- | Repository name, bare 'String'. type RepoName = String +-- | @since 0.2.1 +instance NFData Repo + ------------------------------------------------------------------------------- -- Finding index ------------------------------------------------------------------------------- @@ -127,7 +135,7 @@ ------------------------------------------------------------------------------- -- | Parse @~\/.cabal\/config@ file. -parseConfig :: FilePath -> ByteString -> Either ParseError (Config Maybe) +parseConfig :: FilePath -> ByteString -> Either (ParseError NonEmpty) (Config Maybe) parseConfig = parseWith $ \fields0 -> do let (fields1, sections) = C.partitionFields fields0 let fields2 = M.filterWithKey (\k _ -> k `elem` knownFields) fields1 diff --git a/src/Cabal/Optimization.hs b/src/Cabal/Optimization.hs --- a/src/Cabal/Optimization.hs +++ b/src/Cabal/Optimization.hs @@ -7,6 +7,7 @@ ) where import Control.Applicative (Alternative (..)) +import Control.DeepSeq (NFData (..)) import GHC.Generics (Generic) import qualified Distribution.Compat.CharParsing as C @@ -34,3 +35,6 @@ pretty OptimizationOn = C.pretty True pretty OptimizationOff = C.pretty False pretty (OptimizationLevel l) = PP.int l + +-- | @since 0.2.1 +instance NFData Optimization diff --git a/src/Cabal/Package.hs b/src/Cabal/Package.hs --- a/src/Cabal/Package.hs +++ b/src/Cabal/Package.hs @@ -5,6 +5,7 @@ import Control.Exception (throwIO) import Data.ByteString (ByteString) +import Data.List.NonEmpty (NonEmpty) import qualified Data.ByteString as BS import qualified Distribution.Fields as C @@ -23,7 +24,7 @@ either throwIO return (parsePackage fp contents) -- | Parse @.cabal@ file. -parsePackage :: FilePath -> ByteString -> Either ParseError C.GenericPackageDescription +parsePackage :: FilePath -> ByteString -> Either (ParseError NonEmpty) C.GenericPackageDescription parsePackage fp contents = case C.runParseResult $ C.parseGenericPackageDescription contents of (ws, Left (_mv, errs)) -> Left $ ParseError fp contents errs ws (_, Right gpd) -> Right gpd diff --git a/src/Cabal/Parse.hs b/src/Cabal/Parse.hs --- a/src/Cabal/Parse.hs +++ b/src/Cabal/Parse.hs @@ -1,3 +1,6 @@ +{-# LANGUAGE DeriveGeneric #-} +{-# LANGUAGE StandaloneDeriving #-} +{-# LANGUAGE UndecidableInstances #-} -- | License: GPL-3.0-or-later AND BSD-3-Clause -- -- @.cabal@ and a like file parsing helpers. @@ -7,10 +10,14 @@ renderParseError, ) where +import Control.DeepSeq (NFData (..)) import Control.Exception (Exception (..)) import Data.ByteString (ByteString) import Data.Foldable (for_) +import Data.List.NonEmpty (NonEmpty) +import Data.Typeable (Typeable) import Distribution.Simple.Utils (fromUTF8BS) +import GHC.Generics (Generic) import System.FilePath (normalise) import qualified Data.ByteString.Char8 as BS8 @@ -28,7 +35,7 @@ :: ([C.Field C.Position] -> C.ParseResult a) -- ^ parse -> FilePath -- ^ filename -> ByteString -- ^ contents - -> Either ParseError a + -> Either (ParseError NonEmpty) a parseWith parser fp bs = case C.runParseResult result of (_, Right x) -> return x (ws, Left (_, es)) -> Left $ ParseError fp bs es ws @@ -44,19 +51,24 @@ parser fields -- | Parse error. -data ParseError = ParseError +data ParseError f = ParseError { peFilename :: FilePath , peContents :: ByteString - , peErrors :: [C.PError] + , peErrors :: f C.PError , peWarnings :: [C.PWarning] } - deriving (Show) + deriving (Generic) -instance Exception ParseError where +deriving instance (Show (f C.PError)) => Show (ParseError f) + +instance (Foldable f, Show (f C.PError), Typeable f) => Exception (ParseError f) where displayException = renderParseError +-- | @since 0.2.1 +instance (NFData (f C.PError)) => NFData (ParseError f) + -- | Render parse error highlighting the part of the input file. -renderParseError :: ParseError -> String +renderParseError :: Foldable f => ParseError f -> String renderParseError (ParseError filepath contents errors warnings) | null errors && null warnings = "" | null errors = unlines $ diff --git a/src/Cabal/Project.hs b/src/Cabal/Project.hs --- a/src/Cabal/Project.hs +++ b/src/Cabal/Project.hs @@ -22,6 +22,7 @@ readPackagesOfProject ) where +import Control.DeepSeq (NFData (..)) import Control.Exception (Exception (..), throwIO) import Control.Monad.IO.Class (liftIO) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) @@ -34,6 +35,7 @@ import Data.Function ((&)) import Data.Functor (void) import Data.List (foldl') +import Data.List.NonEmpty (NonEmpty) import Data.Traversable (for) import Data.Void (Void) import Distribution.Compat.Lens (LensLike', over) @@ -77,11 +79,11 @@ , prjMaxBackjumps :: Maybe Int , prjOptimization :: Optimization , prjSourceRepos :: [SourceRepositoryPackage Maybe] - , prjOrigFields :: [C.PrettyField ()] -- ^ original fields + , prjOtherFields :: [C.PrettyField ()] -- ^ other fields } deriving (Functor, Foldable, Traversable, Generic) --- | Doesn't compare prjOrigFields +-- | Doesn't compare prjOtherFields instance (Eq uri, Eq opt, Eq pkg) => Eq (Project uri opt pkg) where x == y = and [ eqOn prjPackages @@ -120,6 +122,24 @@ emptyProject :: Project c b a emptyProject = Project [] [] [] [] [] False Nothing OptimizationOn [] [] +-- | @since 0.2.1 +instance (NFData c, NFData b, NFData a) => NFData (Project c b a) where + rnf (Project x1 x2 x3 x4 x5 x6 x7 x8 x9 x10) = + rnf x1 `seq` rnf x2 `seq` rnf x3 `seq` + rnf x4 `seq` rnf x5 `seq` rnf x6 `seq` + rnf x7 `seq` rnf x8 `seq` rnf x9 `seq` + rnfList rnfPrettyField x10 + where + rnfList :: (a -> ()) -> [a] -> () + rnfList _ [] = () + rnfList f (x:xs) = f x `seq` rnfList f xs + + rnfPrettyField :: NFData x => C.PrettyField x -> () + rnfPrettyField (C.PrettyField ann fn d) = + rnf ann `seq` rnf fn `seq` rnf d + rnfPrettyField (C.PrettySection ann fn ds fs) = + rnf ann `seq` rnf fn `seq` rnf ds `seq` rnfList rnfPrettyField fs + ------------------------------------------------------------------------------- -- Initial parsing ------------------------------------------------------------------------------- @@ -141,7 +161,7 @@ -- >>> fmap prjPackages $ parseProject "cabal.project" "packages: foo bar/*.cabal" -- Right ["foo","bar/*.cabal"] -- -parseProject :: FilePath -> ByteString -> Either ParseError (Project Void String String) +parseProject :: FilePath -> ByteString -> Either (ParseError NonEmpty) (Project Void String String) parseProject = parseWith $ \fields0 -> do let (fields1, sections) = C.partitionFields fields0 let fields2 = M.filterWithKey (\k _ -> k `elem` knownFields) fields1 @@ -149,9 +169,9 @@ where knownFields = C.fieldGrammarKnownFieldList $ grammar [] - parse origFields fields sections = do - let prettyOrigFields = map void $ C.fromParsecFields $ filter notPackages origFields - prj <- C.parseFieldGrammar C.cabalSpecLatest fields $ grammar prettyOrigFields + parse otherFields fields sections = do + let prettyOtherFields = map void $ C.fromParsecFields $ filter otherFieldName otherFields + prj <- C.parseFieldGrammar C.cabalSpecLatest fields $ grammar prettyOtherFields foldl' (&) prj <$> traverse parseSec (concat sections) parseSec :: C.Section C.Position -> C.ParseResult (Project Void String String -> Project Void String String) @@ -162,12 +182,12 @@ parseSec _ = return id -notPackages :: C.Field ann -> Bool -notPackages (C.Field (C.Name _ "packages") _) = False -notPackages _ = True +otherFieldName :: C.Field ann -> Bool +otherFieldName (C.Field (C.Name _ fn) _) = fn `notElem` C.fieldGrammarKnownFieldList (grammar []) +otherFieldName _ = True grammar :: [C.PrettyField ()] -> C.ParsecFieldGrammar (Project Void String String) (Project Void String String) -grammar origFields = Project +grammar otherFields = Project <$> C.monoidalFieldAla "packages" (C.alaList' C.FSep PackageLocation) prjPackagesL <*> C.monoidalFieldAla "optional-packages" (C.alaList' C.FSep PackageLocation) prjOptPackagesL <*> pure [] @@ -177,7 +197,7 @@ <*> C.optionalFieldAla "max-backjumps" Int' prjMaxBackjumpsL <*> C.optionalFieldDef "optimization" prjOptimizationL OptimizationOn <*> pure [] - <*> pure origFields + <*> pure otherFields ------------------------------------------------------------------------------- -- Lenses @@ -293,7 +313,7 @@ -- -- May throw 'IOException'. -- -readPackagesOfProject :: Project uri opt FilePath -> IO (Either ParseError (Project uri opt (FilePath, C.GenericPackageDescription))) +readPackagesOfProject :: Project uri opt FilePath -> IO (Either (ParseError NonEmpty) (Project uri opt (FilePath, C.GenericPackageDescription))) readPackagesOfProject prj = runExceptT $ for prj $ \fp -> do contents <- liftIO $ BS.readFile fp either throwE (\gpd -> return (fp, gpd)) (parsePackage fp contents) diff --git a/src/Cabal/SourceRepo.hs b/src/Cabal/SourceRepo.hs --- a/src/Cabal/SourceRepo.hs +++ b/src/Cabal/SourceRepo.hs @@ -20,6 +20,7 @@ sourceRepositoryPackageGrammar, ) where +import Control.DeepSeq (NFData (..)) import Data.List.NonEmpty (NonEmpty (..)) import Data.Proxy (Proxy (..)) import GHC.Generics (Generic) @@ -43,6 +44,9 @@ deriving instance (Eq (f FilePath)) => Eq (SourceRepositoryPackage f) deriving instance (Ord (f FilePath)) => Ord (SourceRepositoryPackage f) deriving instance (Show (f FilePath)) => Show (SourceRepositoryPackage f) + +-- | @since 0.2.1 +instance NFData (f FilePath) => NFData (SourceRepositoryPackage f) -- | Read from @cabal.project@ type SourceRepoList = SourceRepositoryPackage [] diff --git a/test/Golden.hs b/test/Golden.hs --- a/test/Golden.hs +++ b/test/Golden.hs @@ -6,10 +6,12 @@ import System.FilePath ((-<.>), ()) import Test.Tasty (TestName, TestTree, defaultMain, testGroup) import Test.Tasty.Golden.Advanced (goldenTest) +import Text.PrettyPrint (Doc, render) import qualified Data.ByteString as BS import qualified Data.Map.Strict as Map +import Distribution.Fields (PrettyField(..)) import Distribution.Types.SourceRepo (RepoKind, RepoType, SourceRepo) import Cabal.Optimization @@ -33,7 +35,6 @@ -- orphans ------------------------------------------------------------------------------- --- skip orig fields instance (ToExpr uri, ToExpr opt, ToExpr pkg) => ToExpr (Project uri opt pkg) where toExpr prj = Rec "Project" $ Map.fromList [ field "prjPackages" prjPackages @@ -45,6 +46,7 @@ , field "prjMaxBackjumps" prjMaxBackjumps , field "prjOptimization" prjOptimization , field "prjSourceRepos" prjSourceRepos + , field "prjOtherFields" prjOtherFields ] where field name f = (name, toExpr (f prj)) @@ -55,3 +57,10 @@ instance ToExpr RepoKind instance ToExpr RepoType instance ToExpr (f FilePath) => ToExpr (SourceRepositoryPackage f) + +instance ToExpr Doc where + toExpr = toExpr . render + +instance ToExpr (PrettyField ann) where + toExpr (PrettyField _ fn d) = App "PrettyField" [toExpr fn, toExpr d] + toExpr (PrettySection _ fn ds ps) = App "PrettySection" [toExpr fn, toExpr ds, toExpr ps]