cabal-install-parsers 0.6.3 → 0.7

raw patch · 8 files changed

+167/−46 lines, 8 filesdep −ansi-terminaldep ~Cabal-syntaxdep ~aesondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies removed: ansi-terminal

Dependency ranges changed: Cabal-syntax, aeson, base, binary, bytestring, containers, deepseq, directory, filepath, tar, text, time, tree-diff

API changes (from Hackage documentation)

Files

• Changelog.md +10/−0
• cabal-install-parsers.cabal +20/−30
• src/Cabal/Config.hs +1/−1
• src/Cabal/Index.hs +1/−1
• src/Cabal/Package.hs +1/−1
• src/Cabal/Parse.hs +4/−4
• src/Cabal/Project.hs +129/−9
• test/Golden.hs +1/−0

@@ -1,3 +1,13 @@+## 0.7++- Use `Cabal-syntax-3.18`.+  The breaking changes from `Cabal-syntax` unfortunately leak into public interface of `cabal-install-parsers` in this update, therefore the major update to `cabal-install-parsers.+- Drop support for GHC prior 9.4.8++## 0.6.4++- Add support for reading project files with conditionals.+ ## 0.6.3  - Drop support for GHC prior 8.8.4

@@ -1,6 +1,6 @@ cabal-version:      2.2 name:               cabal-install-parsers-version:            0.6.3+version:            0.7 synopsis:           Utilities to work with cabal-install files description:   @cabal-install-parsers@ provides parsers for @cabal-install@ files:@@ -25,15 +25,12 @@ category:           Development build-type:         Simple tested-with:-  GHC ==8.8.4-   || ==8.10.7-   || ==9.0.2-   || ==9.2.8-   || ==9.4.8+  GHC ==9.4.8    || ==9.6.7    || ==9.8.4-   || ==9.10.2-   || ==9.12.2+   || ==9.10.3+   || ==9.12.4+   || ==9.14.1  extra-source-files:   Changelog.md@@ -66,29 +63,29 @@    -- GHC-boot libraries   build-depends:-    , base          >=4.13.0.0   && <4.22-    , binary        ^>=0.8.7.0-    , bytestring    ^>=0.10.10.1 || ^>=0.11.1.0 || ^>=0.12.0.2-    , Cabal-syntax  ^>=3.14.2.0-    , containers    ^>=0.6.2.1   || ^>=0.7-    , deepseq       ^>=1.4.4.0   || ^>=1.5.0.0+    , base          >=4.17.2.1  && <4.23+    , binary        ^>=0.8.9.1+    , bytestring    ^>=0.11.5.3 || ^>=0.12.0.2+    , Cabal-syntax  ^>=3.18.1.0+    , containers    ^>=0.6.7    || ^>=0.7      || ^>=0.8+    , deepseq       ^>=1.4.8.0  || ^>=1.5.0.0     , directory     ^>=1.3.6.0-    , filepath      ^>=1.4.2.1   || ^>=1.5.2.0+    , filepath      ^>=1.4.2.1  || ^>=1.5.2.0     , parsec        ^>=3.1.14.0     , pretty        ^>=1.1.3.6-    , text          ^>=1.2.4.0   || ^>=2.0.1    || ^>=2.1-    , time          ^>=1.9.3     || ^>=1.11.1.1 || ^>=1.12.2   || ^>=1.14-    , transformers  ^>=0.5.6.2   || ^>=0.6.1.0+    , text          ^>=2.0.2    || ^>=2.1+    , time          ^>=1.12.2   || ^>=1.14     || ^>=1.15+    , transformers  ^>=0.5.6.2  || ^>=0.6.1.0    -- extra dependencies   build-depends:-    , aeson              ^>=2.1.0.0    || ^>=2.2.0.0+    , aeson              ^>=2.1.0.0    || ^>=2.2.0.0 || ^>=2.3.0.0     , base16-bytestring  ^>=1.0.0.0     , binary-instances   ^>=1     , cryptohash-sha256  ^>=0.11.101.0     , lukko              ^>=0.1.1     , network-uri        ^>=2.6.1.0-    , tar                ^>=0.5.1.1    || ^>=0.6.0.0+    , tar                ^>=0.5.1.1    || ^>=0.6.0.0 || ^>=0.7.2.0  test-suite cabal-parsers-index   default-language: Haskell2010@@ -123,17 +120,14 @@     , bytestring     , cabal-install-parsers     , Cabal-syntax-    , containers-    , directory     , filepath     , pretty    -- dependencies needing explicit constraints   build-depends:-    , ansi-terminal  >=1.0      && <1.2-    , tasty          ^>=1.4     || ^>=1.5-    , tasty-golden   ^>=2.3.1.1-    , tree-diff      >=0.2      && <0.4+    , tasty         ^>=1.4     || ^>=1.5+    , tasty-golden  ^>=2.3.1.1+    , tree-diff     ^>=0.4.1  benchmark cabal-parsers-bench   default-language: Haskell2010@@ -146,10 +140,6 @@     , base     , bytestring     , cabal-install-parsers-    , Cabal-syntax-    , containers-    , directory-    , filepath    -- dependencies needing explicit constraints   build-depends:    criterion ^>=1.6.0.0

@@ -156,7 +156,7 @@         cfg <- C.parseFieldGrammar C.cabalSpecLatest fields grammar         foldl' (&) cfg <$> traverse parseSec (concat sections) -    parseSec :: C.Section C.Position -> C.ParseResult (Config f -> Config f)+    parseSec :: C.Section C.Position -> C.ParseResult src (Config f -> Config f)     parseSec (C.MkSection (C.Name _pos name) [C.SecArgName _pos' secName] fields) | name == "repository" = do         let repoName = C.fromUTF8BS secName         let fields' = fst $ C.partitionFields fields

@@ -399,7 +399,7 @@                  f :: Maybe TmpPackageInfo -> Maybe TmpPackageInfo                 f Nothing = Just TmpPackageInfo-                    { tmpPiVersions  = Map.singleton ver TmpReleaseInfo +                    { tmpPiVersions  = Map.singleton ver TmpReleaseInfo                         { tmpRiRevision    = 0                         , tmpRiTarOffset   = offset                         , tmpRiCabalHash   = Just digest

@@ -26,5 +26,5 @@ -- | Parse @.cabal@ file. 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+    (ws, Left (_mv, errs)) -> Left $ ParseError fp contents (fmap C.perror errs) (fmap C.pwarning ws)     (_, Right gpd)         -> Right gpd

@@ -32,13 +32,13 @@ -- This variant doesn't return any warnings in the successful case. -- parseWith-    :: ([C.Field C.Position] -> C.ParseResult a)  -- ^ parse-    -> FilePath                                   -- ^ filename-    -> ByteString                                 -- ^ contents+    :: ([C.Field C.Position] -> C.ParseResult src a)  -- ^ parse+    -> FilePath                                       -- ^ filename+    -> ByteString                                     -- ^ contents     -> 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+    (ws, Left (_, es)) -> Left $ ParseError fp bs (fmap C.perror es) (fmap C.pwarning ws)   where     result = case C.readFields' bs of         Left perr -> C.parseFatalFailure pos (show perr) where

@@ -1,10 +1,11 @@-{-# LANGUAGE CPP               #-}-{-# LANGUAGE DeriveFoldable    #-}-{-# LANGUAGE DeriveFunctor     #-}-{-# LANGUAGE DeriveGeneric     #-}-{-# LANGUAGE DeriveTraversable #-}-{-# LANGUAGE MultiWayIf        #-}-{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE CPP                 #-}+{-# LANGUAGE DeriveFoldable      #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE DeriveGeneric       #-}+{-# LANGUAGE DeriveTraversable   #-}+{-# LANGUAGE MultiWayIf          #-}+{-# LANGUAGE OverloadedStrings   #-}+{-# LANGUAGE ScopedTypeVariables #-} -- | License: GPL-3.0-or-later AND BSD-3-Clause -- module Cabal.Project (@@ -15,6 +16,8 @@     -- * Parse project     readProject,     parseProject,+    readProjectWithConditionals,+    parseProjectWithConditionals,     -- * Resolve project     resolveProject,     ResolveError (..),@@ -25,6 +28,7 @@  import Control.DeepSeq            (NFData (..)) import Control.Exception          (Exception (..), throwIO)+import Control.Monad              (unless) import Control.Monad.IO.Class     (liftIO) import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE) import Data.Bifoldable            (Bifoldable (..))@@ -55,6 +59,7 @@ import qualified Distribution.CabalSpecVersion   as C import qualified Distribution.FieldGrammar       as C import qualified Distribution.Fields             as C+import qualified Distribution.Fields.ConfVar     as C import qualified Distribution.PackageDescription as C import qualified Distribution.Parsec             as C @@ -71,6 +76,12 @@  -- $setup -- >>> :set -XOverloadedStrings+-- >>> import Data.String (fromString)+-- >>> import qualified Distribution.PackageDescription as C+-- >>> import Text.Show (showListWith)+-- >>> import Data.Functor.Classes (liftShowsPrec)+-- >>> let sB (C.CondBranch c t f) = showString "CondBranch _ " . showParen True (sT t) . showChar ' ' . liftShowsPrec (\_ -> sT) undefined 11 f; sT (C.CondNode x xs) = showString "CondTree " . showsPrec 11 x . showChar ' ' . showListWith sB xs+-- >>> pp x = putStrLn (either show (flip sT "") x)  -- | @cabal.project@ file data Project uri opt pkg = Project@@ -152,7 +163,7 @@         rnf x7 `seq` rnf x8 `seq` rnf x9 `seq`         rnfList rnfPrettyField x10       where-        rnfList :: (a -> ()) -> [a] -> ()+        rnfList :: (x -> ()) -> [x] -> ()         rnfList _ []     = ()         rnfList f (x:xs) = f x `seq` rnfList f xs @@ -179,6 +190,13 @@     prj1 <- resolveProject fp prj0 >>= either throwIO return     readPackagesOfProject prj1 >>= either throwIO return +readProjectWithConditionals :: FilePath -> IO (C.CondTree C.ConfVar (Project URI Void (FilePath, C.GenericPackageDescription)))+readProjectWithConditionals fp = do+    contents <- BS.readFile fp+    prj0 <- either throwIO return (parseProjectWithConditionals fp contents)+    prj1 <- traverse (\p -> resolveProject fp p >>= either throwIO return) prj0+    traverse (\p -> readPackagesOfProject p >>= either throwIO return) prj1+ -- | Parse project file. Extracts only few fields. -- -- >>> fmap prjPackages $ parseProject "cabal.project" "packages: foo bar/*.cabal"@@ -199,7 +217,7 @@      -- Special case for source-repository-package. If you add another such     -- special case, make sure to update otherFieldName appropriately.-    parseSec :: C.Section C.Position -> C.ParseResult (Project Void String String -> Project Void String String)+    parseSec :: C.Section C.Position -> C.ParseResult src (Project Void String String -> Project Void String String)     parseSec (C.MkSection (C.Name _pos name) [] fields) | name == sourceRepoSectionName = do         let fields' = fst $ C.partitionFields fields         repos <- C.parseFieldGrammar C.cabalSpecLatest fields' sourceRepositoryPackageGrammar@@ -207,6 +225,46 @@      parseSec _ = return id +-- | Parse project files with conditionals.+--+-- >>> pp $ fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" "packages: foo bar/*.cabal"+-- CondTree ["foo","bar/*.cabal"] []+--+-- >>> pp $ fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" $ fromString $ unlines [ "packages: foo bar/*.cabal", "if impl(ghc >=9)", "  packages: quu" ]+-- CondTree ["foo","bar/*.cabal"] [CondBranch _ (CondTree ["quu"] []) Nothing]+--+-- >>> pp $ fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" $ fromString $ unlines [ "packages: foo bar/*.cabal", "if impl(ghc >=9)", "  packages: quu", "if impl(ghc >=10)", "  packages: zoo" ]+-- CondTree ["foo","bar/*.cabal"] [CondBranch _ (CondTree ["quu"] []) Nothing,CondBranch _ (CondTree ["zoo"] []) Nothing]+--+-- >>> pp $ fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" $ fromString $ unlines [ "packages: foo bar/*.cabal", "if impl(ghc >=9)", "  packages: quu", "else", "  packages: zoo" ]+-- CondTree ["foo","bar/*.cabal"] [CondBranch _ (CondTree ["quu"] []) (Just CondTree ["zoo"] [])]+--+-- >>> pp $ fmap (fmap prjPackages) $ parseProjectWithConditionals "cabal.project" $ fromString $ unlines [ "packages: foo bar/*.cabal", "if impl(ghc >=9)", "  packages: quu", "elif impl(ghc >=10)", "  packages: zoo", "else", "  packages: yyz" ]+-- CondTree ["foo","bar/*.cabal"] [CondBranch _ (CondTree ["quu"] []) (Just CondTree [] [CondBranch _ (CondTree ["zoo"] []) (Just CondTree ["yyz"] [])])]+--+parseProjectWithConditionals :: FilePath -> ByteString -> Either (ParseError NonEmpty) (C.CondTree C.ConfVar (Project Void String String))+parseProjectWithConditionals = parseWith $ \fields0 -> flip parseCondTree fields0 $ \fields1 sections -> do+    let fields2  = M.filterWithKey (\k _ -> k `elem` knownFields) fields1+    parse fields0 fields2 sections+  where+    knownFields = C.fieldGrammarKnownFieldList $ grammar []++    parse :: [C.Field a] -> C.Fields C.Position -> [[C.Section C.Position]] -> C.ParseResult src (Project Void String String)+    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)++    -- Special case for source-repository-package. If you add another such+    -- special case, make sure to update otherFieldName appropriately.+    parseSec :: C.Section C.Position -> C.ParseResult src (Project Void String String -> Project Void String String)+    parseSec (C.MkSection (C.Name _pos name) [] fields) | name == sourceRepoSectionName = do+        let fields' = fst $ C.partitionFields fields+        repos <- C.parseFieldGrammar C.cabalSpecLatest fields' sourceRepositoryPackageGrammar+        return $ over prjSourceReposL (++ toList (srpFanOut repos))++    parseSec _ = return id+ -- | Returns 'True' if a field should be a part of 'prjOtherFields'. This -- excludes any field that is a part of 'grammar' as well as -- @source-repository-package@ (see 'parseProject', which has a special case@@ -377,3 +435,65 @@ readPackagesOfProject prj = runExceptT $ for prj $ \fp -> do     contents <- liftIO $ BS.readFile fp     either throwE (\gpd -> return (fp, gpd)) (parsePackage fp contents)++-------------------------------------------------------------------------------+-- Read package files+-------------------------------------------------------------------------------++parseCondTree+  :: forall a src. (C.Fields C.Position -> [[C.Section C.Position]] -> C.ParseResult src a)  -- ^ parse+  -> [C.Field C.Position]+  -> C.ParseResult src (C.CondTree C.ConfVar a)+parseCondTree subparse = go+  where+    go fields = do+        let (fs, ss) = C.partitionFields fields+        (ss', branches) <- second concat . unzip <$> traverse (goIfs id id) ss+        x <- subparse fs ss'+        return $ C.CondNode x branches++    goIfs+        :: ([C.Section C.Position] -> [C.Section C.Position])+        -> ([C.CondBranch C.ConfVar a] -> [C.CondBranch C.ConfVar a])+        -> [C.Section C.Position]+        -> C.ParseResult src ([C.Section C.Position], [C.CondBranch C.ConfVar a])+    goIfs accS accB [] = do+        return (accS [], accB [])+    goIfs accS accB (C.MkSection (C.Name pos name) args fields : sections)+        | name == "if" = do+            test' <- C.parseConditionConfVar (wrong pos) args+            fields' <- go fields+            goElse (C.CondBranch test' fields') accS accB sections+        | name == "else" = do+            C.parseFailure pos "standalone else"+            return ([], [])+        | name == "elif" = do+            C.parseFailure pos "standalone elif"+            goIfs accS accB sections+    goIfs accS accB (section : sections) = do+        goIfs (accS . (section :)) accB sections++    goElse+        :: (Maybe (C.CondTree C.ConfVar a) -> C.CondBranch C.ConfVar a)+        -> ([C.Section C.Position] -> [C.Section C.Position])+        -> ([C.CondBranch C.ConfVar a] -> [C.CondBranch C.ConfVar a])+        -> [C.Section C.Position]+        -> C.ParseResult src ([C.Section C.Position], [C.CondBranch C.ConfVar a])+    goElse make accS accB (C.MkSection (C.Name pos name) args fields : sections)+        | name == "else" = do+            unless (null args) $ C.parseFailure pos "arguments passed to else"+            fields' <- go fields+            let condTree = make (Just fields')+            goIfs accS (accB . (condTree :)) sections+        | name == "elif" = do+            test' <- C.parseConditionConfVar (wrong pos) args+            fields' <- go fields+            emptyA <- subparse mempty []+            goElse (make . Just . C.CondNode emptyA . pure .  C.CondBranch test' fields') accS accB sections+    goElse make accS accB sections = do+        let condTree = make Nothing+        goIfs accS (accB . (condTree :)) sections++-- | I don't know which location to pass to parseConditionConfVar, so I just pass some.+wrong :: C.Position -> C.Position+wrong = id

@@ -65,3 +65,4 @@ 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]+  toExpr PrettyEmpty                = App "PrettyEmpty"   []