{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE RecordWildCards #-} -- | Copyright: (c) 2020-2021 berberman -- SPDX-License-Identifier: MIT -- Maintainer: berberman -- Stability: experimental -- Portability: portable -- This module provides parser of @desc@ file in pacman db. module Distribution.ArchHs.PkgDesc ( PkgDesc (..), DescParser, descParser, descFieldsParser, runDescFieldsParser, runDescParser, promoteDependent, containsDep, ) where import Control.Monad (void) import qualified Data.Map.Strict as Map import Data.Void (Void) 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", "NAME", "BASE", "VERSION", "DESC", "CSIZE", "ISIZE", "URL", "LICENSE", "ARCH", "BUILDDATE", "PACKAGER", "DEPENDS", "MAKEDEPENDS", "PROVIDES", "OPTDEPENDS", "REPLACES", "CONFLICTS" ] -} -- | Promote a versioned dependent to package description promoteDependent :: PkgDependent -> Maybe PkgDesc promoteDependent PkgDependent {..} = ( \ver -> PkgDesc { _name = _pdName, _version = ver, _desc = "", _url = Nothing, _provides = [], _optDepends = [], _replaces = [], _conflicts = [], _makeDepends = [], _depends = [], _checkDepends = [] } ) <$> _pdVersion -- | Check if a name is in 'PkgDependentList' 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 where sep = void $ char '%' line = manyTill anySingle newline -- | 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 {..} ) 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 _ -> 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 -- | Run the desc parser. runDescParser :: String -> String -> Either (ParseErrorBundle String Void) PkgDesc runDescParser = parse descParser