{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# 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,
  )
where

import qualified Data.Map.Strict as Map
import Data.Void (Void)
import Distribution.ArchHs.Internal.Prelude
import Text.Megaparsec
import Text.Megaparsec.Char

-- | A parser takes 'String' as input, without user state.
type DescParser = Parsec Void String

-- | Package description file of a installed system package,
-- which lies in @repo.db@ file.
data PkgDesc = PkgDesc
  { PkgDesc -> String
_name :: String,
    PkgDesc -> String
_version :: String,
    PkgDesc -> String
_desc :: String,
    PkgDesc -> Maybe String
_url :: Maybe String,
    PkgDesc -> Maybe String
_license :: Maybe String,
    PkgDesc -> [String]
_provides :: [String],
    PkgDesc -> [String]
_optDepends :: [String],
    PkgDesc -> [String]
_replaces :: [String],
    PkgDesc -> [String]
_conflicts :: [String],
    PkgDesc -> [String]
_depends :: [String],
    PkgDesc -> [String]
_makeDepends :: [String]
  }
  deriving stock (Int -> PkgDesc -> ShowS
[PkgDesc] -> ShowS
PkgDesc -> String
(Int -> PkgDesc -> ShowS)
-> (PkgDesc -> String) -> ([PkgDesc] -> ShowS) -> Show PkgDesc
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PkgDesc] -> ShowS
$cshowList :: [PkgDesc] -> ShowS
show :: PkgDesc -> String
$cshow :: PkgDesc -> String
showsPrec :: Int -> PkgDesc -> ShowS
$cshowsPrec :: Int -> PkgDesc -> ShowS
Show, PkgDesc -> PkgDesc -> Bool
(PkgDesc -> PkgDesc -> Bool)
-> (PkgDesc -> PkgDesc -> Bool) -> Eq PkgDesc
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PkgDesc -> PkgDesc -> Bool
$c/= :: PkgDesc -> PkgDesc -> Bool
== :: PkgDesc -> PkgDesc -> Bool
$c== :: PkgDesc -> PkgDesc -> Bool
Eq, (forall x. PkgDesc -> Rep PkgDesc x)
-> (forall x. Rep PkgDesc x -> PkgDesc) -> Generic PkgDesc
forall x. Rep PkgDesc x -> PkgDesc
forall x. PkgDesc -> Rep PkgDesc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PkgDesc x -> PkgDesc
$cfrom :: forall x. PkgDesc -> Rep PkgDesc x
Generic)
  deriving anyclass (PkgDesc -> ()
(PkgDesc -> ()) -> NFData PkgDesc
forall a. (a -> ()) -> NFData a
rnf :: PkgDesc -> ()
$crnf :: PkgDesc -> ()
NFData)

-- Common fields
{- fieldList =
  [ "FILENAME",
    "NAME",
    "BASE",
    "VERSION",
    "DESC",
    "CSIZE",
    "ISIZE",
    "URL",
    "LICENSE",
    "ARCH",
    "BUILDDATE",
    "PACKAGER",
    "DEPENDS",
    "MAKEDEPENDS",
    "PROVIDES",
    "OPTDEPENDS",
    "REPLACES",
    "CONFLICTS"
  ] -}

-- | Parse fields of @desc@.
descFieldsParser :: DescParser (Map.Map String [String])
descFieldsParser :: DescParser (Map String [String])
descFieldsParser =
  [(String, [String])] -> Map String [String]
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
    ([(String, [String])] -> Map String [String])
-> ParsecT Void String Identity [(String, [String])]
-> DescParser (Map String [String])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ( do
            ParsecT Void String Identity ()
sep
            String
field <- ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void String Identity ()
sep
            Char
_ <- ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
            [String]
content <- ParsecT Void String Identity String
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity [String]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String Identity String
line (ParsecT Void String Identity () -> ParsecT Void String Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void String Identity ()
sep ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
            (String, [String])
-> ParsecT Void String Identity (String, [String])
forall (m :: * -> *) a. Monad m => a -> m a
return (String
field, (String -> Bool) -> [String] -> [String]
forall a. (a -> Bool) -> [a] -> [a]
filter (String -> String -> Bool
forall a. Eq a => a -> a -> Bool
/= String
"") [String]
content)
        )
    ParsecT Void String Identity (String, [String])
-> ParsecT Void String Identity ()
-> ParsecT Void String Identity [(String, [String])]
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
`manyTill` ParsecT Void String Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  where
    sep :: ParsecT Void String Identity ()
sep = () ()
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Token String -> ParsecT Void String Identity (Token String)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token String
'%'
    line :: ParsecT Void String Identity String
line = ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity String
forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m [a]
manyTill ParsecT Void String Identity Char
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle ParsecT Void String Identity Char
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
    DescParser (Map String [String])
-> (Map String [String] -> DescParser PkgDesc)
-> DescParser PkgDesc
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ( \Map String [String]
fields -> do
            String
_name <- Map String [String]
-> String -> ParsecT Void String Identity String
forall (m :: * -> *) a.
MonadFail m =>
Map String [a] -> String -> m a
lookupSingle Map String [String]
fields String
"NAME"
            String
_version <- Map String [String]
-> String -> ParsecT Void String Identity String
forall (m :: * -> *) a.
MonadFail m =>
Map String [a] -> String -> m a
lookupSingle Map String [String]
fields String
"VERSION"
            String
_desc <- Map String [String]
-> String -> ParsecT Void String Identity String
forall (m :: * -> *) a.
MonadFail m =>
Map String [a] -> String -> m a
lookupSingle Map String [String]
fields String
"DESC"
            Maybe String
_url <- Map String [String]
-> String -> ParsecT Void String Identity (Maybe String)
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m (Maybe a)
lookupSingleMaybe Map String [String]
fields String
"URL"
            Maybe String
_license <- Map String [String]
-> String -> ParsecT Void String Identity (Maybe String)
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m (Maybe a)
lookupSingleMaybe Map String [String]
fields String
"LICENSE"
            [String]
_depends <- Map String [String]
-> String -> ParsecT Void String Identity [String]
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"DEPENDS"
            [String]
_makeDepends <- Map String [String]
-> String -> ParsecT Void String Identity [String]
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"MAKEDEPENDS"
            [String]
_provides <- Map String [String]
-> String -> ParsecT Void String Identity [String]
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"PROVIDES"
            [String]
_optDepends <- Map String [String]
-> String -> ParsecT Void String Identity [String]
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"OPTDEPENDS"
            [String]
_replaces <- Map String [String]
-> String -> ParsecT Void String Identity [String]
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"REPLACES"
            [String]
_conflicts <- Map String [String]
-> String -> ParsecT Void String Identity [String]
forall (m :: * -> *) k a.
(Monad m, Ord k) =>
Map k [a] -> k -> m [a]
lookupList Map String [String]
fields String
"CONFLICTS"
            PkgDesc -> DescParser PkgDesc
forall (m :: * -> *) a. Monad m => a -> m a
return PkgDesc :: String
-> String
-> String
-> Maybe String
-> Maybe String
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> [String]
-> PkgDesc
PkgDesc {String
[String]
Maybe String
_conflicts :: [String]
_replaces :: [String]
_optDepends :: [String]
_provides :: [String]
_makeDepends :: [String]
_depends :: [String]
_license :: Maybe String
_url :: Maybe String
_desc :: String
_version :: String
_name :: String
_makeDepends :: [String]
_depends :: [String]
_conflicts :: [String]
_replaces :: [String]
_optDepends :: [String]
_provides :: [String]
_license :: Maybe String
_url :: Maybe String
_desc :: String
_version :: String
_name :: String
..}
        )
  where
    lookupSingle :: Map String [a] -> String -> m a
lookupSingle Map String [a]
fields String
f = case String -> Map String [a] -> Maybe [a]
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]
_) -> a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
e
        [a]
_ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Expect a singleton " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f
      Maybe [a]
_ -> String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m a) -> String -> m a
forall a b. (a -> b) -> a -> b
$ String
"Unable to find field " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
f
    lookupSingleMaybe :: Map k [a] -> k -> m (Maybe a)
lookupSingleMaybe Map k [a]
fields k
f = Maybe a -> m (Maybe a)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a -> m (Maybe a)) -> Maybe a -> m (Maybe a)
forall a b. (a -> b) -> a -> b
$ case k -> Map k [a] -> Maybe [a]
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]
_) -> a -> Maybe a
forall a. a -> Maybe a
Just a
e
        [a]
_ -> Maybe a
forall a. Maybe a
Nothing
      Maybe [a]
_ -> Maybe a
forall a. Maybe a
Nothing
    lookupList :: Map k [a] -> k -> m [a]
lookupList Map k [a]
fields k
f = [a] -> m [a]
forall (m :: * -> *) a. Monad m => a -> m a
return ([a] -> m [a]) -> [a] -> m [a]
forall a b. (a -> b) -> a -> b
$ case k -> Map k [a] -> Maybe [a]
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 = DescParser (Map String [String])
-> String
-> String
-> Either (ParseErrorBundle String Void) (Map String [String])
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 = DescParser PkgDesc
-> String
-> String
-> Either (ParseErrorBundle String Void) PkgDesc
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
parse DescParser PkgDesc
descParser