{-# LANGUAGE RecordWildCards #-}
module Distribution.ArchHs.PkgDesc
( PkgDesc (..),
DescParser,
descParser,
descFieldsParser,
runDescParser,
)
where
import qualified Data.Map.Strict as Map
import Data.Void (Void)
import Text.Megaparsec
import Text.Megaparsec.Char
type DescParser = Parsec Void String
data PkgDesc = PkgDesc
{ PkgDesc -> String
name :: String,
PkgDesc -> String
version :: String,
PkgDesc -> String
desc :: String,
PkgDesc -> String
url :: String,
PkgDesc -> String
license :: String,
PkgDesc -> [String]
depends :: [String],
PkgDesc -> [String]
makeDepends :: [String]
}
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 String
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
upperChar ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
-> ParsecT Void String Identity Char
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void String Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar)
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 String
-> ParsecT Void String Identity ()
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void String Identity String
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Tokens s)
eol 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]
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
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"
String
url <- 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
"URL"
String
license <- 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
"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"
PkgDesc -> DescParser PkgDesc
forall (m :: * -> *) a. Monad m => a -> m a
return PkgDesc :: String
-> String
-> String
-> String
-> String
-> [String]
-> [String]
-> PkgDesc
PkgDesc {String
[String]
makeDepends :: [String]
depends :: [String]
license :: String
url :: String
desc :: String
version :: String
name :: String
makeDepends :: [String]
depends :: [String]
license :: String
url :: 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 -> String -> String
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 -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
f
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]
_ -> []
runDescParser :: String -> Either (ParseErrorBundle String Void) PkgDesc
runDescParser :: 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 String
"Desc"