{-# LANGUAGE OverloadedStrings #-}
module Distribution.Fields.ConfVar (parseConditionConfVar) where
import Distribution.Compat.CharParsing (char, integral)
import Distribution.Compat.Prelude
import Distribution.Fields.Field (SectionArg (..))
import Distribution.Fields.ParseResult
import Distribution.Parsec (Parsec (..), Position (..), runParsecParser)
import Distribution.Parsec.FieldLineStream (fieldLineStreamFromBS)
import Distribution.Types.Condition
import Distribution.Types.ConfVar (ConfVar (..))
import Distribution.Version
(anyVersion, earlierVersion, intersectVersionRanges, laterVersion, majorBoundVersion,
mkVersion, noVersion, orEarlierVersion, orLaterVersion, thisVersion, unionVersionRanges,
withinVersion)
import Prelude ()
import qualified Text.Parsec as P
import qualified Text.Parsec.Error as P
parseConditionConfVar :: [SectionArg Position] -> ParseResult (Condition ConfVar)
parseConditionConfVar :: [SectionArg Position] -> ParseResult (Condition ConfVar)
parseConditionConfVar [SectionArg Position]
args =
case forall s t u a.
Stream s Identity t =>
Parsec s u a -> u -> SourceName -> s -> Either ParseError a
P.runParser (ParsecT [SectionArg Position] () Identity (Condition ConfVar)
parser forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
P.eof) () SourceName
"<condition>" [SectionArg Position]
args of
Right Condition ConfVar
x -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Condition ConfVar
x
Left ParseError
err -> do
let ppos :: SourcePos
ppos = ParseError -> SourcePos
P.errorPos ParseError
err
let epos :: Position
epos = Int -> Int -> Position
Position (SourcePos -> Int
P.sourceLine SourcePos
ppos) (SourcePos -> Int
P.sourceColumn SourcePos
ppos)
let msg :: SourceName
msg = SourceName
-> SourceName
-> SourceName
-> SourceName
-> SourceName
-> [Message]
-> SourceName
P.showErrorMessages
SourceName
"or" SourceName
"unknown parse error" SourceName
"expecting" SourceName
"unexpected" SourceName
"end of input"
(ParseError -> [Message]
P.errorMessages ParseError
err)
Position -> SourceName -> ParseResult ()
parseFailure Position
epos SourceName
msg
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall c. Bool -> Condition c
Lit Bool
True
type Parser = P.Parsec [SectionArg Position] ()
sepByNonEmpty :: Parser a -> Parser sep -> Parser (NonEmpty a)
sepByNonEmpty :: forall a sep. Parser a -> Parser sep -> Parser (NonEmpty a)
sepByNonEmpty Parser a
p Parser sep
sep = forall a. a -> [a] -> NonEmpty a
(:|) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (Parser sep
sep forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
p)
parser :: Parser (Condition ConfVar)
parser :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
parser = ParsecT [SectionArg Position] () Identity (Condition ConfVar)
condOr
where
condOr :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
condOr = forall a sep. Parser a -> Parser sep -> Parser (NonEmpty a)
sepByNonEmpty ParsecT [SectionArg Position] () Identity (Condition ConfVar)
condAnd (forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"||") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 forall c. Condition c -> Condition c -> Condition c
COr
condAnd :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
condAnd = forall a sep. Parser a -> Parser sep -> Parser (NonEmpty a)
sepByNonEmpty ParsecT [SectionArg Position] () Identity (Condition ConfVar)
cond (forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"&&") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 forall c. Condition c -> Condition c -> Condition c
CAnd
cond :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
cond = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P.choice
[ forall {u} {c}.
ParsecT [SectionArg Position] u Identity (Condition c)
boolLiteral, forall {u} {a}.
ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens ParsecT [SectionArg Position] () Identity (Condition ConfVar)
condOr, ParsecT [SectionArg Position] () Identity (Condition ConfVar)
notCond, ParsecT [SectionArg Position] () Identity (Condition ConfVar)
osCond, ParsecT [SectionArg Position] () Identity (Condition ConfVar)
archCond, ParsecT [SectionArg Position] () Identity (Condition ConfVar)
flagCond, ParsecT [SectionArg Position] () Identity (Condition ConfVar)
implCond ]
notCond :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
notCond = forall c. Condition c -> Condition c
CNot forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"!" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT [SectionArg Position] () Identity (Condition ConfVar)
cond
boolLiteral :: ParsecT [SectionArg Position] u Identity (Condition c)
boolLiteral = forall c. Bool -> Condition c
Lit forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {u}. ParsecT [SectionArg Position] u Identity Bool
boolLiteral'
osCond :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
osCond = forall c. c -> Condition c
Var forall b c a. (b -> c) -> (a -> b) -> a -> c
. OS -> ConfVar
OS forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
"os" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u} {a}.
ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens forall a. Parsec a => Parser a
fromParsec
flagCond :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
flagCond = forall c. c -> Condition c
Var forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagName -> ConfVar
PackageFlag forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
"flag" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u} {a}.
ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens forall a. Parsec a => Parser a
fromParsec
archCond :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
archCond = forall c. c -> Condition c
Var forall b c a. (b -> c) -> (a -> b) -> a -> c
. Arch -> ConfVar
Arch forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
"arch" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u} {a}.
ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens forall a. Parsec a => Parser a
fromParsec
implCond :: ParsecT [SectionArg Position] () Identity (Condition ConfVar)
implCond = forall c. c -> Condition c
Var forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
"impl" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u} {a}.
ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens ParsecT [SectionArg Position] () Identity ConfVar
implCond'
implCond' :: ParsecT [SectionArg Position] () Identity ConfVar
implCond' = CompilerFlavor -> VersionRange -> ConfVar
Impl
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parsec a => Parser a
fromParsec
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
P.option VersionRange
anyVersion ParsecT [SectionArg Position] () Identity VersionRange
versionRange
version :: Parser Version
version = forall a. Parsec a => Parser a
fromParsec
versionStar :: ParsecT [SectionArg Position] u Identity Version
versionStar = [Int] -> Version
mkVersion forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall {b} {u}.
ParsecParser b -> ParsecT [SectionArg Position] u Identity b
fromParsec' ParsecParser [Int]
versionStar' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"*"
versionStar' :: ParsecParser [Int]
versionStar' = forall (f :: * -> *) a. Alternative f => f a -> f [a]
some (forall (m :: * -> *) a. (CharParsing m, Integral a) => m a
integral forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => Char -> m Char
char Char
'.')
versionRange :: ParsecT [SectionArg Position] () Identity VersionRange
versionRange = ParsecT [SectionArg Position] () Identity VersionRange
expr
where
expr :: ParsecT [SectionArg Position] () Identity VersionRange
expr = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 VersionRange -> VersionRange -> VersionRange
unionVersionRanges forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a sep. Parser a -> Parser sep -> Parser (NonEmpty a)
sepByNonEmpty ParsecT [SectionArg Position] () Identity VersionRange
term (forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"||")
term :: ParsecT [SectionArg Position] () Identity VersionRange
term = forall a. (a -> a -> a) -> NonEmpty a -> a
foldl1 VersionRange -> VersionRange -> VersionRange
intersectVersionRanges forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a sep. Parser a -> Parser sep -> Parser (NonEmpty a)
sepByNonEmpty ParsecT [SectionArg Position] () Identity VersionRange
factor (forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"&&")
factor :: ParsecT [SectionArg Position] () Identity VersionRange
factor = forall s (m :: * -> *) t u a.
Stream s m t =>
[ParsecT s u m a] -> ParsecT s u m a
P.choice
forall a b. (a -> b) -> a -> b
$ forall {u} {a}.
ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens ParsecT [SectionArg Position] () Identity VersionRange
expr
forall a. a -> [a] -> [a]
: forall {u}. ParsecT [SectionArg Position] u Identity VersionRange
parseAnyVersion
forall a. a -> [a] -> [a]
: forall {u}. ParsecT [SectionArg Position] u Identity VersionRange
parseNoVersion
forall a. a -> [a] -> [a]
: forall {u}. ParsecT [SectionArg Position] u Identity VersionRange
parseWildcardRange
forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall {a}.
(ByteString, Version -> a)
-> ParsecT [SectionArg Position] () Identity a
parseRangeOp [(ByteString, Version -> VersionRange)]
rangeOps
parseAnyVersion :: ParsecT [SectionArg Position] u Identity VersionRange
parseAnyVersion = VersionRange
anyVersion forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
"-any"
parseNoVersion :: ParsecT [SectionArg Position] u Identity VersionRange
parseNoVersion = VersionRange
noVersion forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
"-none"
parseWildcardRange :: ParsecT [SectionArg Position] u Identity VersionRange
parseWildcardRange = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try forall a b. (a -> b) -> a -> b
$ Version -> VersionRange
withinVersion forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"==" forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall {u}. ParsecT [SectionArg Position] u Identity Version
versionStar
parseRangeOp :: (ByteString, Version -> a)
-> ParsecT [SectionArg Position] () Identity a
parseRangeOp (ByteString
s,Version -> a
f) = forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
P.try (Version -> a
f forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Version
version)
rangeOps :: [(ByteString, Version -> VersionRange)]
rangeOps = [ (ByteString
"<", Version -> VersionRange
earlierVersion),
(ByteString
"<=", Version -> VersionRange
orEarlierVersion),
(ByteString
">", Version -> VersionRange
laterVersion),
(ByteString
">=", Version -> VersionRange
orLaterVersion),
(ByteString
"^>=", Version -> VersionRange
majorBoundVersion),
(ByteString
"==", Version -> VersionRange
thisVersion) ]
identBS :: ParsecT [SectionArg Position] u Identity ByteString
identBS = forall {a} {u}.
(SectionArg Position -> Maybe a)
-> ParsecT [SectionArg Position] u Identity a
tokenPrim forall a b. (a -> b) -> a -> b
$ \SectionArg Position
t -> case SectionArg Position
t of
SecArgName Position
_ ByteString
s -> forall a. a -> Maybe a
Just ByteString
s
SectionArg Position
_ -> forall a. Maybe a
Nothing
boolLiteral' :: ParsecT [SectionArg Position] u Identity Bool
boolLiteral' = forall {a} {u}.
(SectionArg Position -> Maybe a)
-> ParsecT [SectionArg Position] u Identity a
tokenPrim forall a b. (a -> b) -> a -> b
$ \SectionArg Position
t -> case SectionArg Position
t of
SecArgName Position
_ ByteString
s
| ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
"True" -> forall a. a -> Maybe a
Just Bool
True
| ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
"true" -> forall a. a -> Maybe a
Just Bool
True
| ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
"False" -> forall a. a -> Maybe a
Just Bool
False
| ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
"false" -> forall a. a -> Maybe a
Just Bool
False
SectionArg Position
_ -> forall a. Maybe a
Nothing
string :: ByteString -> ParsecT [SectionArg Position] u Identity ()
string ByteString
s = forall {a} {u}.
(SectionArg Position -> Maybe a)
-> ParsecT [SectionArg Position] u Identity a
tokenPrim forall a b. (a -> b) -> a -> b
$ \SectionArg Position
t -> case SectionArg Position
t of
SecArgName Position
_ ByteString
s' | ByteString
s forall a. Eq a => a -> a -> Bool
== ByteString
s' -> forall a. a -> Maybe a
Just ()
SectionArg Position
_ -> forall a. Maybe a
Nothing
oper :: ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
o = forall {a} {u}.
(SectionArg Position -> Maybe a)
-> ParsecT [SectionArg Position] u Identity a
tokenPrim forall a b. (a -> b) -> a -> b
$ \SectionArg Position
t -> case SectionArg Position
t of
SecArgOther Position
_ ByteString
o' | ByteString
o forall a. Eq a => a -> a -> Bool
== ByteString
o' -> forall a. a -> Maybe a
Just ()
SectionArg Position
_ -> forall a. Maybe a
Nothing
parens :: ParsecT [SectionArg Position] u Identity a
-> ParsecT [SectionArg Position] u Identity a
parens = forall s (m :: * -> *) t u open close a.
Stream s m t =>
ParsecT s u m open
-> ParsecT s u m close -> ParsecT s u m a -> ParsecT s u m a
P.between (forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
"(") (forall {u}.
ByteString -> ParsecT [SectionArg Position] u Identity ()
oper ByteString
")")
tokenPrim :: (SectionArg Position -> Maybe a)
-> ParsecT [SectionArg Position] u Identity a
tokenPrim = forall s (m :: * -> *) t a u.
Stream s m t =>
(t -> SourceName)
-> (SourcePos -> t -> s -> SourcePos)
-> (t -> Maybe a)
-> ParsecT s u m a
P.tokenPrim SectionArg Position -> SourceName
prettySectionArg forall {p} {p} {p}. p -> p -> p -> p
updatePosition
updatePosition :: p -> p -> p -> p
updatePosition p
x p
_ p
_ = p
x
prettySectionArg :: SectionArg Position -> SourceName
prettySectionArg = forall a. Show a => a -> SourceName
show
fromParsec :: Parsec a => Parser a
fromParsec :: forall a. Parsec a => Parser a
fromParsec = forall {b} {u}.
ParsecParser b -> ParsecT [SectionArg Position] u Identity b
fromParsec' forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
fromParsec' :: ParsecParser b -> ParsecT [SectionArg Position] u Identity b
fromParsec' ParsecParser b
p = do
ByteString
bs <- forall {u}. ParsecT [SectionArg Position] u Identity ByteString
identBS
let fls :: FieldLineStream
fls = ByteString -> FieldLineStream
fieldLineStreamFromBS ByteString
bs
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => SourceName -> m a
fail forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> SourceName
show) forall (f :: * -> *) a. Applicative f => a -> f a
pure (forall a.
ParsecParser a
-> SourceName -> FieldLineStream -> Either ParseError a
runParsecParser ParsecParser b
p SourceName
"<fromParsec'>" FieldLineStream
fls)