{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE RecordWildCards #-}

-- | Copyright: (c) 2020-2021 berberman
-- SPDX-License-Identifier: MIT
-- Maintainer: berberman <berberman@yandex.com>
-- 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 -> Maybe PkgDesc
promoteDependent PkgDependent {Maybe String
ArchLinuxName
_pdVersion :: PkgDependent -> Maybe String
_pdName :: PkgDependent -> ArchLinuxName
_pdVersion :: Maybe String
_pdName :: ArchLinuxName
..} =
  ( \String
ver ->
      PkgDesc
        { _name :: ArchLinuxName
_name = ArchLinuxName
_pdName,
          _version :: String
_version = String
ver,
          _desc :: String
_desc = String
"",
          _url :: Maybe String
_url = forall a. Maybe a
Nothing,
          _provides :: PkgDependentList
_provides = [],
          _optDepends :: PkgDependentList
_optDepends = [],
          _replaces :: PkgDependentList
_replaces = [],
          _conflicts :: PkgDependentList
_conflicts = [],
          _makeDepends :: PkgDependentList
_makeDepends = [],
          _depends :: PkgDependentList
_depends = [],
          _checkDepends :: PkgDependentList
_checkDepends = []
        }
  )
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
_pdVersion

-- | Check if a name is in 'PkgDependentList'
containsDep :: PkgDependentList -> ArchLinuxName -> Bool
containsDep :: PkgDependentList -> ArchLinuxName -> Bool
containsDep PkgDependentList
deps ArchLinuxName
name = ArchLinuxName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (PkgDependent -> ArchLinuxName
_pdName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> PkgDependentList
deps)

-- | Parse fields of @desc@.
descFieldsParser :: DescParser (Map.Map String [String])
descFieldsParser :: DescParser (Map String [String])
descFieldsParser =
  forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( do
            ParsecT Void String Identity ()
sep
            String
field <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void String Identity ()
sep
            Token String
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
            [String]
content <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String Identity [Token String]
line (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void String Identity ()
sep forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
            forall (m :: * -> *) a. Monad m => a -> m a
return (String
field, forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
"") [String]
content)
        )
    forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  where
    sep :: ParsecT Void String Identity ()
sep = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'%'
    line :: ParsecT Void String Identity [Token String]
line = forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

-- | Parse a desc file.
descParser :: DescParser PkgDesc
descParser :: DescParser PkgDesc
descParser =
  DescParser (Map String [String])
descFieldsParser
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \Map String [String]
fields -> do
            ArchLinuxName
_name <- String -> ArchLinuxName
ArchLinuxName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {a}.
MonadFail m =>
Map String [a] -> String -> m a
lookupSingle Map String [String]
fields String
"NAME"
            String
_version <- String -> String
extractFromEVR forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {m :: * -> *} {a}.
MonadFail m =>
Map String [a] -> String -> m a
lookupSingle Map String [String]
fields String
"VERSION"
            String
_desc <- forall {m :: * -> *} {a}.
MonadFail m =>
Map String [a] -> String -> m a
lookupSingle Map String [String]
fields String
"DESC"
            Maybe String
_url <- forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m (Maybe a)
lookupSingleMaybe Map String [String]
fields String
"URL"
            PkgDependentList
_depends <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"DEPENDS"
            PkgDependentList
_makeDepends <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"MAKEDEPENDS"
            PkgDependentList
_provides <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"PROVIDES"
            PkgDependentList
_optDepends <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"OPTDEPENDS"
            PkgDependentList
_replaces <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"REPLACES"
            PkgDependentList
_conflicts <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"CONFLICTS"
            PkgDependentList
_checkDepends <- [String] -> ParsecT Void String Identity PkgDependentList
toDepList forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall {m :: * -> *} {k} {a}.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"CHECKDEPENDS"
            forall (m :: * -> *) a. Monad m => a -> m a
return PkgDesc {String
PkgDependentList
Maybe String
ArchLinuxName
_checkDepends :: PkgDependentList
_conflicts :: PkgDependentList
_replaces :: PkgDependentList
_optDepends :: PkgDependentList
_provides :: PkgDependentList
_makeDepends :: PkgDependentList
_depends :: PkgDependentList
_url :: Maybe String
_desc :: String
_version :: String
_name :: ArchLinuxName
_checkDepends :: PkgDependentList
_depends :: PkgDependentList
_makeDepends :: PkgDependentList
_conflicts :: PkgDependentList
_replaces :: PkgDependentList
_optDepends :: PkgDependentList
_provides :: PkgDependentList
_url :: Maybe String
_desc :: String
_version :: String
_name :: ArchLinuxName
..}
        )
  where
    toDepList :: [String] -> ParsecT Void String Identity PkgDependentList
toDepList = forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall a b. (a -> b) -> a -> b
$ \String
t -> case forall a. Eq a => [a] -> [a] -> [[a]]
splitOn String
"=" String
t of
      [String
name, String
version] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ArchLinuxName -> Maybe String -> PkgDependent
PkgDependent (String -> ArchLinuxName
ArchLinuxName String
name) (forall a. a -> Maybe a
Just String
version)
      [String
name] -> forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ArchLinuxName -> Maybe String -> PkgDependent
PkgDependent (String -> ArchLinuxName
ArchLinuxName String
name) forall a. Maybe a
Nothing
      [String]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unable to parse dep list " forall a. Semigroup a => a -> a -> a
<> String
t
    lookupSingle :: Map String [a] -> String -> m a
lookupSingle Map String [a]
fields String
f = case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup String
f Map String [a]
fields of
      (Just [a]
x) -> case [a]
x of
        (a
e : [a]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return a
e
        [a]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Expect a singleton " forall a. Semigroup a => a -> a -> a
<> String
f
      Maybe [a]
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unable to find field " forall a. Semigroup a => a -> a -> a
<> String
f
    lookupSingleMaybe :: Map k [a] -> k -> m (Maybe a)
lookupSingleMaybe Map k [a]
fields k
f = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
f Map k [a]
fields of
      (Just [a]
x) -> case [a]
x of
        (a
e : [a]
_) -> forall a. a -> Maybe a
Just a
e
        [a]
_ -> forall a. Maybe a
Nothing
      Maybe [a]
_ -> forall a. Maybe a
Nothing
    lookupList :: Map k [a] -> k -> m [a]
lookupList Map k [a]
fields k
f = forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup k
f Map k [a]
fields of
      (Just [a]
x) -> [a]
x
      Maybe [a]
_ -> []

-- | Run the desc fields parser.
runDescFieldsParser :: String -> String -> Either (ParseErrorBundle String Void) (Map.Map String [String])
runDescFieldsParser :: String
-> String
-> Either (ParseErrorBundle String Void) (Map String [String])
runDescFieldsParser = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse DescParser (Map String [String])
descFieldsParser

-- | Run the desc parser.
runDescParser :: String -> String -> Either (ParseErrorBundle String Void) PkgDesc
runDescParser :: String -> String -> Either (ParseErrorBundle String Void) PkgDesc
runDescParser = forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse DescParser PkgDesc
descParser