arch-hs 0.12.3 → 0.13

raw patch · 12 files changed

+264/−189 lines, 12 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +10/−0
• README.md +25/−17
• app/Args.hs +5/−3
• arch-hs.cabal +1/−1
• diff/Args.hs +14/−0
• diff/Diff.hs +65/−8
• diff/Main.hs +13/−7
• src/Distribution/ArchHs/ExtraDB.hs +6/−10
• src/Distribution/ArchHs/FilesDB.hs +3/−3
• src/Distribution/ArchHs/Options.hs +73/−73
• src/Distribution/ArchHs/PkgBuild.hs +1/−1
• src/Distribution/ArchHs/PkgDesc.hs +48/−66

@@ -3,6 +3,16 @@ `arch-hs` uses [PVP Versioning][1]. The changelog is available [on GitHub][2]. +## 0.13++- Speed up the internal pacman database parser and restore the original explicit `--alpm` opt-in model for ALPM-enabled builds++- Make `arch-hs-diff` read revision 0 cabal files from the local Hackage index by default, with `--online` for Hackage downloads++- Include `--enable-debug-info` in generated PKGBUILD templates++- Update README documentation and remove the broken hackage-deps badge+ ## 0.12.3  - Teach `arch-hs-rdepcheck` to validate a candidate version against reverse dependency ranges

@@ -1,7 +1,6 @@ # arch-hs  [![Hackage](https://img.shields.io/hackage/v/arch-hs.svg?logo=haskell)](https://hackage.haskell.org/package/arch-hs)-[![Dependency](https://img.shields.io/hackage-deps/v/arch-hs)](https://packdeps.haskellers.com/feed?needle=arch-hs) [![MIT license](https://img.shields.io/badge/license-MIT-blue.svg)](LICENSE)  | Env              | CI                                                                                                                        |@@ -33,7 +32,7 @@ ## Installation  `arch-hs` is portable, which means it's not restricted to Arch Linux.-However, `arch-hs` can use libalpm to load pacman database on Arch Linux,+However, `arch-hs` can optionally use libalpm to load pacman database on Arch Linux, and if you want to run on other systems, you have to build it from source.  ### Install the latest release@@ -82,9 +81,9 @@ </summary>  ```-$ arch-hs -o ~/test --alpm gi-gdk +$ arch-hs -o ~/test gi-gdk ⓘ Loading hackage from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar-ⓘ Loading extra.db from libalpm+ⓘ Loading extra.db from /var/lib/pacman/sync/extra.db ⓘ Start running... ⓘ Solved: ...@@ -189,8 +188,8 @@ gi-pango:    pango.pc  ⓘ Now finding corresponding system package(s) using files db:-ⓘ Loading [core] files from libalpm-ⓘ Loading [extra] files from libalpm+ⓘ Loading [core] files from /var/lib/pacman/sync+ⓘ Loading [extra] files from /var/lib/pacman/sync ⓘ Done: gtk4.pc               ⇒   gtk4 gdk-pixbuf-2.0.pc     ⇒   gdk-pixbuf2@@ -415,14 +414,18 @@  `arch-hs` also provides a component called `arch-hs-diff`. `arch-hs-diff` can show the differences of package description between two versions of a package, and remind us if some required packages in extra repo can't satisfy the version constraints, or they are non-existent.+By default, `arch-hs-diff` reads revision 0 cabal files from the local Hackage index.+`-h`/`--hackage` can be used to specify the index tarball path.+Use `--online` to download revision 0 cabal files from Hackage instead. This is useful in the subsequent maintenance of a package. For example:  ```-$ arch-hs-diff --alpm comonad 5.0.6 5.0.7-ⓘ Loading extra.db from libalpm+$ arch-hs-diff comonad 5.0.6 5.0.7+ⓘ Loading extra.db from /var/lib/pacman/sync/extra.db+ⓘ Loading hackage from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar ⓘ Start running...-ⓘ Downloading cabal file from https://hackage.haskell.org/package/comonad-5.0.6/revision/0.cabal...-ⓘ Downloading cabal file from https://hackage.haskell.org/package/comonad-5.0.7/revision/0.cabal...+ⓘ Reading revision 0 cabal file from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar: comonad/5.0.6/comonad.cabal+ⓘ Reading revision 0 cabal file from /home/berberman/.cabal/packages/hackage.haskell.org/01-index.tar: comonad/5.0.7/comonad.cabal Package: comonad Version: 5.0.6  ⇒  5.0.7 Synopsis: Comonads@@ -511,8 +514,6 @@ ✔ Success! ``` -`arch-hs-diff` does not require hackage db, it downloads cabal files from hackage server instead.- ## Reverse dependency checks  `arch-hs-rdepcheck` lists Haskell reverse dependencies in [extra] and the Cabal version ranges they require:@@ -553,17 +554,24 @@ ## Alpm Support  [alpm](https://www.archlinux.org/pacman/libalpm.3.html) is Arch Linux Package Management library.-When running on Arch Linux, loading `extra.db` and files dbs through this library is slightly faster than using the internal parser of `arch-hs`.-Thus, `arch-hs` provides a flag `alpm` to enable this feature:+When running on Arch Linux, `arch-hs` can load `extra.db` and files dbs through this library instead of using its internal parser.+`arch-hs` provides a Cabal flag `alpm` to build this feature:  ``` cabal build -f alpm ```  This flag is enabled by default in `arch-hs` Arch Linux package.-Compiled with `alpm`, `arch-hs` uses alpm to load pacman databases by default.-In this case, the CLI flag `--no-alpm-extra` and `--no-alpm-files` can be used to disable this feature.-> When `alpm` is enabled, `arch-hs` will lose the capability of specifying the path of `extra.db` and directory of files db.+Compiled with `alpm`, `arch-hs` still reads pacman databases from `/var/lib/pacman/sync` by default.+Pass `--alpm` to load pacman databases through libalpm explicitly:++```+arch-hs --alpm -o ~/test gi-gdk+```++For commands that load only `extra.db`, such as `arch-hs-diff`, `arch-hs-sync`, and `arch-hs-rdepcheck`, `--alpm` applies to `extra.db`.+For `arch-hs`, `--alpm` applies to both `extra.db` and files dbs.+When `--alpm` is used, explicit `--extra` and `--files` paths are ignored.   ## Contributing

@@ -33,10 +33,9 @@  cmdOptions :: Parser Options cmdOptions =-  Options+  mkOptions     <$> hackageDBOptionsParser-      <*> extraDBOptionsParser-      <*> filesDBOptionsParser+      <*> pacmanDBOptionsParser       <*> strOption         ( long "output"             <> metavar "PATH"@@ -99,6 +98,9 @@             <> help "Try to package if the dependent of this package exist whereas this package does not"         )       <*> argument optPackageNameReader (metavar "TARGET")+  where+    mkOptions hackage (extra, files) =+      Options hackage extra files  runArgsParser :: IO Options runArgsParser = do

@@ -1,6 +1,6 @@ cabal-version:      2.4 name:               arch-hs-version:            0.12.3+version:            0.13 synopsis:           Distribute hackage packages to archlinux description:   @arch-hs@ is a command-line program, which simplifies the process of producing

@@ -13,6 +13,8 @@ data Options = Options   { optFlags :: FlagAssignments,     optExtraDB :: ExtraDBOptions,+    optHackagePath :: FilePath,+    optOnline :: Bool,     optPackageName :: PackageName,     optVersionA :: Version,     optVersionB :: Version@@ -23,6 +25,18 @@   Options     <$> optFlagAssignmentParser     <*> extraDBOptionsParser+    <*> strOption+      ( long "hackage"+          <> metavar "PATH"+          <> short 'h'+          <> help "Path to hackage index tarball"+          <> showDefault+          <> value ""+      )+    <*> switch+      ( long "online"+          <> help "Download cabal files from Hackage instead of reading the local Hackage index"+      )     <*> argument optPackageNameReader (metavar "TARGET")     <*> argument optVersionReader (metavar "VERSION_A")     <*> argument optVersionReader (metavar "VERSION_B")

@@ -2,16 +2,23 @@ {-# LANGUAGE TypeApplications #-}  module Diff-  ( diffCabal,+  ( CabalSource (..),+    diffCabal,   ) where  import Data.Algorithm.Diff+import Control.Monad (unless)+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as LBS+import qualified Data.Conduit.Tar as Tar+import Data.IORef (modifyIORef', newIORef, readIORef)+import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromJust)-import Distribution.ArchHs.ExtraDB (versionInExtra)+import Conduit import Distribution.ArchHs.Core import Distribution.ArchHs.Exception+import Distribution.ArchHs.ExtraDB (versionInExtra) import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.PP import Distribution.ArchHs.Types@@ -22,20 +29,71 @@  type VersionedList = [(PackageName, VersionRange)] +data CabalSource+  = Online Manager+  | Offline FilePath+ ----------------------------------------------------------------------------- -getCabalFromHackage :: Members [Embed IO, WithMyErr, Reader Manager] r => PackageName -> Version -> Sem r GenericPackageDescription-getCabalFromHackage name version = do+getCabalFromHackage :: Members [Embed IO, WithMyErr] r => Manager -> PackageName -> Version -> Sem r GenericPackageDescription+getCabalFromHackage manager name version = do   let urlPath = unPackageName name <> "-" <> prettyShow version       s = "https://hackage.haskell.org/package/" <> urlPath <> "/revision/0.cabal"   req <- interceptHttpException $ parseRequest s   printInfo $ "Downloading cabal file from" <+> pretty s-  manager <- ask @Manager   response <- interceptHttpException $ httpLbs req manager   case parseGenericPackageDescriptionMaybe . LBS.toStrict $ responseBody response of     Just x -> return x     _ -> error "Failed to parse .cabal file" +getCabalsFromIndex :: Members [Embed IO, WithMyErr] r => FilePath -> PackageName -> [Version] -> Sem r (Map.Map Version GenericPackageDescription)+getCabalsFromIndex hackagePath name versions = do+  let pkg = unPackageName name+      cabalPaths = Map.fromList [(pkg </> prettyShow version </> (pkg <> ".cabal"), version) | version <- nub versions]+  mapM_ (\cabalPath -> printInfo $ "Reading revision 0 cabal file from" <+> pretty hackagePath <> colon <+> pretty cabalPath) $ Map.keys cabalPaths+  cabalFiles <- embed $ findCabalFilesInIndex hackagePath cabalPaths+  Map.fromList <$> traverse (parseCabal cabalFiles) (nub versions)+  where+    parseCabal cabalFiles version =+      case parseGenericPackageDescriptionMaybe =<< Map.lookup version cabalFiles of+        Just cabal -> return (version, cabal)+        Nothing -> throw $ VersionNotFound name version++findCabalFilesInIndex :: FilePath -> Map.Map FilePath Version -> IO (Map.Map Version BS.ByteString)+findCabalFilesInIndex hackagePath cabalPaths = do+  foundRef <- newIORef Map.empty+  Map.fromList+    <$> runConduitRes+      ( sourceFileBS hackagePath+          .| Tar.untarChunks+          .| Tar.withEntries (action foundRef)+          .| takeC (Map.size cabalPaths)+          .| sinkList+      )+  where+    action foundRef header+      | Tar.FTNormal <- Tar.headerFileType header,+        Just version <- Map.lookup (Tar.headerFilePath header) cabalPaths = do+        found <- liftIO $ readIORef foundRef+        unless (Map.member version found) $ do+          cabalFile <- mconcat <$> sinkList+          liftIO $ modifyIORef' foundRef (Map.insert version ())+          yield (version, cabalFile)+      | otherwise = return ()++getCabalsFromSource :: Members [Embed IO, WithMyErr, Reader CabalSource] r => PackageName -> Version -> Version -> Sem r (GenericPackageDescription, GenericPackageDescription)+getCabalsFromSource name a b =+  ask @CabalSource >>= \case+    Online manager -> (,) <$> getCabalFromHackage manager name a <*> getCabalFromHackage manager name b+    Offline hackagePath -> do+      cabals <- getCabalsFromIndex hackagePath name [a, b]+      (,) <$> lookupCabal cabals a <*> lookupCabal cabals b+  where+    lookupCabal cabals version =+      case Map.lookup version cabals of+        Just cabal -> return cabal+        Nothing -> throw $ VersionNotFound name version+ directDependencies ::   Members [KnownGHCVersion, FlagAssignmentsEnv, Trace, DependencyRecord] r =>   GenericPackageDescription ->@@ -65,10 +123,9 @@  ----------------------------------------------------------------------------- -diffCabal :: Members [KnownGHCVersion, ExtraEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord, Reader Manager, Embed IO] r => PackageName -> Version -> Version -> Sem r ()+diffCabal :: Members [KnownGHCVersion, ExtraEnv, FlagAssignmentsEnv, WithMyErr, Trace, DependencyRecord, Reader CabalSource, Embed IO] r => PackageName -> Version -> Version -> Sem r () diffCabal name a b = do-  ga <- getCabalFromHackage name a-  gb <- getCabalFromHackage name b+  (ga, gb) <- getCabalsFromSource name a b   let pa = packageDescription ga       pb = packageDescription gb       fa = genPackageFlags ga

@@ -10,12 +10,12 @@ import Diff import Distribution.ArchHs.Core (subsumeGHCVersion) import Distribution.ArchHs.Exception+import Distribution.ArchHs.Hackage (lookupHackagePath) import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Options import Distribution.ArchHs.PP import Distribution.ArchHs.Types import GHC.IO.Encoding (setLocaleEncoding, utf8)-import Network.HTTP.Client (Manager) import Network.HTTP.Client.TLS (newTlsManager)  main :: IO ()@@ -31,23 +31,29 @@      extra <- loadExtraDBFromOptions optExtraDB -    manager <- newTlsManager+    cabalSource <-+      if optOnline+        then Online <$> newTlsManager+        else do+          hackagePath <- if null optHackagePath then lookupHackagePath else pure optHackagePath+          printInfo $ "Loading hackage from" <+> pretty hackagePath+          pure $ Offline hackagePath      printInfo "Start running..."-    runDiff extra optFlags manager (subsumeGHCVersion $ diffCabal optPackageName optVersionA optVersionB) & printAppResult+    runDiff extra optFlags cabalSource (subsumeGHCVersion $ diffCabal optPackageName optVersionA optVersionB) & printAppResult  runDiff ::   ExtraDB ->   FlagAssignments ->-  Manager ->-  Sem '[ExtraEnv, FlagAssignmentsEnv, Reader Manager, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->+  CabalSource ->+  Sem '[ExtraEnv, FlagAssignmentsEnv, Reader CabalSource, Trace, DependencyRecord, WithMyErr, Embed IO, Final IO] a ->   IO (Either MyException a)-runDiff extra flags manager =+runDiff extra flags cabalSource =   runFinal     . embedToFinal     . errorToIOFinal     . evalState Map.empty     . ignoreTrace-    . runReader manager+    . runReader cabalSource     . runReader flags     . runReader extra

@@ -1,4 +1,5 @@ {-# LANGUAGE CPP #-}+{-# LANGUAGE ForeignFunctionInterface #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeApplications #-} @@ -24,19 +25,16 @@ import qualified Data.Conduit.Tar as Tar import qualified Data.Conduit.Zlib as Zlib import qualified Data.Map.Strict as Map-import qualified Data.Text as T+import Data.Maybe (mapMaybe) import Distribution.ArchHs.Exception import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Name import Distribution.ArchHs.PkgDesc import Distribution.ArchHs.Types-import Data.Maybe (mapMaybe)  -----------------------------------------------------------------------------  #ifdef ALPM-{-# LANGUAGE ForeignFunctionInterface #-}- import Data.IORef (IORef, modifyIORef', newIORef, readIORef) import Distribution.ArchHs.Utils (extractFromEVR) import Foreign.C.String (CString, peekCString)@@ -120,10 +118,8 @@     action header =       when (Tar.headerFileType header == Tar.FTNormal) $ do         x <- mconcat <$> sinkList-        let txt = T.unpack . decodeUtf8 $ x-            parsed = runDescParser (Tar.headerFilePath header) txt-            result = case parsed of-              Right desc ->+        let result = case parseDescEntry . decodeUtf8 $ x of+              Just desc ->                 desc                   : ( if _name desc == ArchLinuxName "ghc"                         || _name desc == ArchLinuxName "ghc-libs"@@ -131,11 +127,11 @@                         else []                     )               -- Drop it if failed to parse-              Left _ -> []+              Nothing -> []         yieldMany $ (\desc -> (_name desc, desc)) <$> result  -- | Load @extra.db@ from @path@.--- @desc@ files in the db will be parsed by @descParser@.+-- @desc@ files in the db will be parsed by 'parseDescEntry'. loadExtraDB :: FilePath -> IO ExtraDB loadExtraDB path = Map.fromList <$> runConduitRes (loadExtraDBC path .| sinkList) 

@@ -28,7 +28,7 @@ import qualified Data.Map.Strict as Map import qualified Data.Text as T import Distribution.ArchHs.Internal.Prelude-import Distribution.ArchHs.PkgDesc (runDescFieldsParser)+import Distribution.ArchHs.PkgDesc (parseDescFields) import Distribution.ArchHs.Types  #ifdef ALPM@@ -83,8 +83,8 @@           let txt = decodeUtf8 x           case t of             "files" -> yield . Files fp $ [T.unpack fname | (extract -> Just fname) <- tail $ T.lines txt]-            "desc" -> case runDescFieldsParser fp (T.unpack txt) of-              Right r | [name] <- r Map.! "NAME" -> yield . Desc fp $ ArchLinuxName name+            "desc" -> case parseDescFields txt Map.!? "NAME" of+              Just [name] -> yield . Desc fp $ ArchLinuxName $ T.unpack name               _ -> return ()             _ -> return ()       | otherwise = return ()

@@ -16,6 +16,7 @@     -- * Load files DB     FilesDBOptions (..),     filesDBOptionsParser,+    pacmanDBOptionsParser,      -- * Load Hackage DB     HackageDBOptions (..),@@ -50,47 +51,35 @@  -- | CLI options parser of 'ExtraDBOptions' ----- When alpm is enabled, it reads a flag @no-alpm-extra@;--- otherwise it reads a string option @extra@.+-- When alpm is enabled, it also reads a flag @alpm@. extraDBOptionsParser :: Parser ExtraDBOptions--#ifndef ALPM extraDBOptionsParser =+  mkExtraDBOptions <$> alpmOptionsParser <*> extraDBPathParser++extraDBPathParser :: Parser FilePath+extraDBPathParser =+  strOption $+    long "extra"+      <> metavar "PATH"+      <> short 'c'+      <> help "Path to extra.db"+      <> showDefault+      <> value defaultExtraDBPath++mkExtraDBOptions :: Bool -> FilePath -> ExtraDBOptions+mkExtraDBOptions useAlpm path =   ExtraDBOptions-    <$> fmap-      ( \s ->-          do-            printInfo $ "Loading extra.db from" <+> pretty s-            loadExtraDB s-      )-      ( strOption $-          long "extra"-            <> metavar "PATH"-            <> short 'c'-            <> help "Path to extra.db"-            <> showDefault-            <> value defaultExtraDBPath-      )+    ( do+        let src = if useAlpm then "libalpm" else path+        printInfo $ "Loading extra.db from" <+> pretty src+#ifdef ALPM+        if useAlpm+          then loadExtraDBFFI+          else loadExtraDB path #else-extraDBOptionsParser =-  ExtraDBOptions-    <$> fmap-      ( \b ->-          do-            let src = if b then "libalpm" else defaultExtraDBPath-            printInfo $ "Loading extra.db from" <+> pretty src-            if b-              then loadExtraDBFFI-              else loadExtraDB defaultExtraDBPath-      )-      ( flag-          True-          False-          ( long "no-alpm-extra"-              <> help "Do not use libalpm to parse extra db"-          )-      )+        loadExtraDB path #endif+    ) -----------------------------------------------------------------------------  -- | Parsed options for loading 'FilesDB'@@ -100,47 +89,58 @@  -- | CLI options parser of 'ExtraDBOptions' ----- When alpm is enabled, it reads a flag @no-alpm-files@;--- otherwise it reads a string option @files@.+-- When alpm is enabled, it also reads a flag @alpm@. filesDBOptionsParser :: Parser FilesDBOptions--#ifndef ALPM filesDBOptionsParser =+  mkFilesDBOptions <$> alpmOptionsParser <*> filesDBPathParser++filesDBPathParser :: Parser FilePath+filesDBPathParser =+  strOption $+    long "files"+      <> metavar "PATH"+      <> short 'f'+      <> help+        "Path of dir that includes core.files, extra.files and extra.files"+      <> showDefault+      <> value defaultFilesDBDir++mkFilesDBOptions :: Bool -> FilePath -> FilesDBOptions+mkFilesDBOptions useAlpm path =   FilesDBOptions-    <$> fmap-      ( \s db ->-          do-            printInfo $-              "Loading" <+> ppDBKind db <+> "files from" <+> pretty s-            loadFilesDB db s-      )-      ( strOption $-          long "files"-            <> metavar "PATH"-            <> short 'f'-            <> help-              "Path of dir that includes core.files, extra.files and extra.files"-            <> showDefault-            <> value defaultFilesDBDir-      )+    ( \db ->+        do+          let src = if useAlpm then "libalpm" else path+          printInfo $+            "Loading" <+> ppDBKind db <+> "files from" <+> pretty src+#ifdef ALPM+          if useAlpm then loadFilesDBFFI db else loadFilesDB db path #else-filesDBOptionsParser =-  FilesDBOptions-    <$> fmap-      ( \b db ->-          do-            let src = if b then "libalpm" else defaultFilesDBDir-            printInfo $-              "Loading" <+> ppDBKind db <+> "files from" <+> pretty src-            if b then loadFilesDBFFI db else loadFilesDB db defaultFilesDBDir-      )-      ( flag-          True-          False-          ( long "no-alpm-files"-              <> help "Do not use libalpm to parse files db"-          )-      )+          loadFilesDB db path+#endif+    )++-- | CLI options parser for commands that need both pacman database loaders.+--+-- When alpm is enabled, it reads @alpm@ once and applies it to both loaders.+pacmanDBOptionsParser :: Parser (ExtraDBOptions, FilesDBOptions)+pacmanDBOptionsParser =+  mkPacmanDBOptions+    <$> alpmOptionsParser+    <*> extraDBPathParser+    <*> filesDBPathParser+  where+    mkPacmanDBOptions useAlpm extraPath filesPath =+      (mkExtraDBOptions useAlpm extraPath, mkFilesDBOptions useAlpm filesPath)++alpmOptionsParser :: Parser Bool+#ifndef ALPM+alpmOptionsParser = pure False+#else+alpmOptionsParser =+  switch $+    long "alpm"+      <> help "Use libalpm to load pacman databases" #endif ----------------------------------------------------------------------------- 

@@ -589,7 +589,7 @@   build() {     cd $$_hkgname-$$pkgver -    runhaskell Setup configure -O --enable-shared --enable-executable-dynamic --disable-library-vanilla \+    runhaskell Setup configure -O --enable-shared --enable-debug-info --enable-executable-dynamic --disable-library-vanilla \       --prefix=/usr --docdir=/usr/share/doc/$$pkgname --datasubdir=$$pkgname --enable-tests \       --dynlibdir=/usr/lib --libsubdir=\$$compiler/site-local/\$$pkgid \       --ghc-option=-optl-Wl\,-z\,relro\,-z\,now \

@@ -1,4 +1,5 @@ {-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-}  -- | Copyright: (c) 2020-2021 berberman@@ -9,28 +10,20 @@ -- This module provides parser of @desc@ file in pacman db. module Distribution.ArchHs.PkgDesc   ( PkgDesc (..),-    DescParser,-    descParser,-    descFieldsParser,-    runDescFieldsParser,-    runDescParser,+    parseDescEntry,+    parseDescFields,     promoteDependent,     containsDep,   ) where -import Control.Monad (void) import qualified Data.Map.Strict as Map-import Data.Void (Void)+import Data.Maybe (isJust)+import qualified Data.Text as T import Distribution.ArchHs.Internal.Prelude import Distribution.ArchHs.Types import Distribution.ArchHs.Utils (extractFromEVR)-import Text.Megaparsec-import Text.Megaparsec.Char --- | A parser takes 'String' as input, without user state.-type DescParser = Parsec Void String- -- Common fields {- fieldList =   [ "FILENAME",@@ -77,63 +70,52 @@ containsDep :: PkgDependentList -> ArchLinuxName -> Bool containsDep deps name = name `elem` (_pdName <$> deps) --- | Parse fields of @desc@.-descFieldsParser :: DescParser (Map.Map String [String])-descFieldsParser =-  Map.fromList-    <$> ( do-            sep-            field <- manyTill anySingle sep-            _ <- newline-            content <- manyTill line (lookAhead sep <|> eof)-            return (field, filter (/= "") content)-        )-    `manyTill` eof+-- | Parse fields of a pacman @desc@ file.+parseDescFields :: T.Text -> Map.Map T.Text [T.Text]+parseDescFields = go Map.empty . dropWhile T.null . T.lines   where-    sep = void $ char '%'-    line = manyTill anySingle newline+    go acc [] = acc+    go acc (line : rest)+      | Just field <- fieldName line =+        let (content, rest') = break (isJust . fieldName) rest+         in go (Map.insert field (filter (not . T.null) content) acc) (dropWhile T.null rest')+      | otherwise = go acc rest --- | Parse a desc file.-descParser :: DescParser PkgDesc-descParser =-  descFieldsParser-    >>= ( \fields -> do-            _name <- ArchLinuxName <$> lookupSingle fields "NAME"-            _version <- extractFromEVR <$> lookupSingle fields "VERSION"-            _desc <- lookupSingle fields "DESC"-            _url <- lookupSingleMaybe fields "URL"-            _depends <- toDepList =<< lookupList fields "DEPENDS"-            _makeDepends <- toDepList =<< lookupList fields "MAKEDEPENDS"-            _provides <- toDepList =<< lookupList fields "PROVIDES"-            _optDepends <- toDepList =<< lookupList fields "OPTDEPENDS"-            _replaces <- toDepList =<< lookupList fields "REPLACES"-            _conflicts <- toDepList =<< lookupList fields "CONFLICTS"-            _checkDepends <- toDepList =<< lookupList fields "CHECKDEPENDS"-            return PkgDesc {..}-        )+    fieldName line+      | Just rest <- T.stripPrefix "%" line,+        Just field <- T.stripSuffix "%" rest =+        Just field+      | otherwise = Nothing++-- | Parse a pacman @desc@ file into a package description.+parseDescEntry :: T.Text -> Maybe PkgDesc+parseDescEntry txt = do+  _name <- ArchLinuxName . T.unpack <$> lookupSingle "NAME"+  _version <- extractFromEVR . T.unpack <$> lookupSingle "VERSION"+  _desc <- T.unpack <$> lookupSingle "DESC"+  _depends <- toDepList $ lookupList "DEPENDS"+  _makeDepends <- toDepList $ lookupList "MAKEDEPENDS"+  _provides <- toDepList $ lookupList "PROVIDES"+  _optDepends <- toDepList $ lookupList "OPTDEPENDS"+  _replaces <- toDepList $ lookupList "REPLACES"+  _conflicts <- toDepList $ lookupList "CONFLICTS"+  _checkDepends <- toDepList $ lookupList "CHECKDEPENDS"+  let _url = T.unpack <$> lookupSingleMaybe "URL"+  pure PkgDesc {..}   where-    toDepList = mapM $ \t -> case splitOn "=" t of-      [name, version] -> pure $ PkgDependent (ArchLinuxName name) (Just version)-      [name] -> pure $ PkgDependent (ArchLinuxName name) Nothing-      _ -> fail $ "Unable to parse dep list " <> t-    lookupSingle fields f = case Map.lookup f fields of-      (Just x) -> case x of-        (e : _) -> return e-        _ -> fail $ "Expect a singleton " <> f-      _ -> fail $ "Unable to find field " <> f-    lookupSingleMaybe fields f = return $ case Map.lookup f fields of-      (Just x) -> case x of-        (e : _) -> Just e-        _ -> Nothing+    fields = parseDescFields txt++    lookupSingle field = case Map.lookup field fields of+      Just (x : _) -> Just x       _ -> Nothing-    lookupList fields f = return $ case Map.lookup f fields of-      (Just x) -> x-      _ -> [] --- | Run the desc fields parser.-runDescFieldsParser :: String -> String -> Either (ParseErrorBundle String Void) (Map.Map String [String])-runDescFieldsParser = parse descFieldsParser+    lookupSingleMaybe field = case Map.lookup field fields of+      Just (x : _) -> Just x+      _ -> Nothing --- | Run the desc parser.-runDescParser :: String -> String -> Either (ParseErrorBundle String Void) PkgDesc-runDescParser = parse descParser+    lookupList field = Map.findWithDefault [] field fields++    toDepList = traverse $ \t -> case splitOn "=" $ T.unpack t of+      [name, version] -> Just $ PkgDependent (ArchLinuxName name) (Just version)+      [name] -> Just $ PkgDependent (ArchLinuxName name) Nothing+      _ -> Nothing