{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Distribution.FieldGrammar.Newtypes (
alaList,
alaList',
CommaVCat (..),
CommaFSep (..),
VCat (..),
FSep (..),
NoCommaFSep (..),
Sep (..),
List,
alaSet,
alaSet',
Set',
alaNonEmpty,
alaNonEmpty',
NonEmpty',
SpecVersion (..),
TestedWith (..),
SpecLicense (..),
Token (..),
Token' (..),
MQuoted (..),
FilePathNT (..),
) where
import Distribution.Compat.Newtype
import Distribution.Compat.Prelude
import Prelude ()
import Distribution.CabalSpecVersion
import Distribution.Compiler (CompilerFlavor)
import Distribution.License (License)
import Distribution.Parsec
import Distribution.Pretty
import Distribution.Version
(LowerBound (..), Version, VersionInterval (..), VersionRange, VersionRangeF (..), anyVersion, asVersionIntervals, cataVersionRange, mkVersion,
version0, versionNumbers)
import Text.PrettyPrint (Doc, comma, fsep, punctuate, text, vcat)
import qualified Data.List.NonEmpty as NE
import qualified Data.Set as Set
import qualified Distribution.Compat.CharParsing as P
import qualified Distribution.SPDX as SPDX
data CommaVCat = CommaVCat
data CommaFSep = CommaFSep
data VCat = VCat
data FSep = FSep
data NoCommaFSep = NoCommaFSep
class Sep sep where
prettySep :: Proxy sep -> [Doc] -> Doc
parseSep :: CabalParsing m => Proxy sep -> m a -> m [a]
parseSepNE :: CabalParsing m => Proxy sep -> m a -> m (NonEmpty a)
instance Sep CommaVCat where
prettySep :: Proxy CommaVCat -> [Doc] -> Doc
prettySep Proxy CommaVCat
_ = [Doc] -> Doc
vcat forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
parseSep :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaVCat -> m a -> m [a]
parseSep Proxy CommaVCat
_ m a
p = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 then forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingCommaList m a
p else forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList m a
p
parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaVCat -> m a -> m (NonEmpty a)
parseSepNE Proxy CommaVCat
_ m a
p = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 then forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m a
p else forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecCommaNonEmpty m a
p
instance Sep CommaFSep where
prettySep :: Proxy CommaFSep -> [Doc] -> Doc
prettySep Proxy CommaFSep
_ = [Doc] -> Doc
fsep forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
parseSep :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaFSep -> m a -> m [a]
parseSep Proxy CommaFSep
_ m a
p = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 then forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingCommaList m a
p else forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList m a
p
parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaFSep -> m a -> m (NonEmpty a)
parseSepNE Proxy CommaFSep
_ m a
p = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 then forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecLeadingCommaNonEmpty m a
p else forall (m :: * -> *) a. CabalParsing m => m a -> m (NonEmpty a)
parsecCommaNonEmpty m a
p
instance Sep VCat where
prettySep :: Proxy VCat -> [Doc] -> Doc
prettySep Proxy VCat
_ = [Doc] -> Doc
vcat
parseSep :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy VCat -> m a -> m [a]
parseSep Proxy VCat
_ m a
p = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 then forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList m a
p else forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList m a
p
parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy VCat -> m a -> m (NonEmpty a)
parseSepNE Proxy VCat
_ m a
p = forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NE.some1 (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces)
instance Sep FSep where
prettySep :: Proxy FSep -> [Doc] -> Doc
prettySep Proxy FSep
_ = [Doc] -> Doc
fsep
parseSep :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy FSep -> m a -> m [a]
parseSep Proxy FSep
_ m a
p = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 then forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList m a
p else forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList m a
p
parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy FSep -> m a -> m (NonEmpty a)
parseSepNE Proxy FSep
_ m a
p = forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NE.some1 (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces)
instance Sep NoCommaFSep where
prettySep :: Proxy NoCommaFSep -> [Doc] -> Doc
prettySep Proxy NoCommaFSep
_ = [Doc] -> Doc
fsep
parseSep :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy NoCommaFSep -> m a -> m [a]
parseSep Proxy NoCommaFSep
_ m a
p = forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces)
parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy NoCommaFSep -> m a -> m (NonEmpty a)
parseSepNE Proxy NoCommaFSep
_ m a
p = forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NE.some1 (m a
p forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). CharParsing m => m ()
P.spaces)
newtype List sep b a = List { forall sep b a. List sep b a -> [a]
_getList :: [a] }
alaList :: sep -> [a] -> List sep (Identity a) a
alaList :: forall sep a. sep -> [a] -> List sep (Identity a) a
alaList sep
_ = forall sep b a. [a] -> List sep b a
List
alaList' :: sep -> (a -> b) -> [a] -> List sep b a
alaList' :: forall sep a b. sep -> (a -> b) -> [a] -> List sep b a
alaList' sep
_ a -> b
_ = forall sep b a. [a] -> List sep b a
List
instance Newtype [a] (List sep wrapper a)
instance (Newtype a b, Sep sep, Parsec b) => Parsec (List sep b a) where
parsec :: forall (m :: * -> *). CabalParsing m => m (List sep b a)
parsec = forall o n. Newtype o n => o -> n
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall o n. Newtype o n => n -> o
unpack :: b -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
parseSep (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance (Newtype a b, Sep sep, Pretty b) => Pretty (List sep b a) where
pretty :: List sep b a -> Doc
pretty = forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
prettySep (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall o n. Newtype o n => o -> n
pack :: a -> b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype Set' sep b a = Set' { forall sep b a. Set' sep b a -> Set a
_getSet :: Set a }
alaSet :: sep -> Set a -> Set' sep (Identity a) a
alaSet :: forall sep a. sep -> Set a -> Set' sep (Identity a) a
alaSet sep
_ = forall sep b a. Set a -> Set' sep b a
Set'
alaSet' :: sep -> (a -> b) -> Set a -> Set' sep b a
alaSet' :: forall sep a b. sep -> (a -> b) -> Set a -> Set' sep b a
alaSet' sep
_ a -> b
_ = forall sep b a. Set a -> Set' sep b a
Set'
instance Newtype (Set a) (Set' sep wrapper a)
instance (Newtype a b, Ord a, Sep sep, Parsec b) => Parsec (Set' sep b a) where
parsec :: forall (m :: * -> *). CabalParsing m => m (Set' sep b a)
parsec = forall o n. Newtype o n => o -> n
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Ord a => [a] -> Set a
Set.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall o n. Newtype o n => n -> o
unpack :: b -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
parseSep (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance (Newtype a b, Sep sep, Pretty b) => Pretty (Set' sep b a) where
pretty :: Set' sep b a -> Doc
pretty = forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
prettySep (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall o n. Newtype o n => o -> n
pack :: a -> b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Set a -> [a]
Set.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype NonEmpty' sep b a = NonEmpty' { forall sep b a. NonEmpty' sep b a -> NonEmpty a
_getNonEmpty :: NonEmpty a }
alaNonEmpty :: sep -> NonEmpty a -> NonEmpty' sep (Identity a) a
alaNonEmpty :: forall sep a. sep -> NonEmpty a -> NonEmpty' sep (Identity a) a
alaNonEmpty sep
_ = forall sep b a. NonEmpty a -> NonEmpty' sep b a
NonEmpty'
alaNonEmpty' :: sep -> (a -> b) -> NonEmpty a -> NonEmpty' sep b a
alaNonEmpty' :: forall sep a b. sep -> (a -> b) -> NonEmpty a -> NonEmpty' sep b a
alaNonEmpty' sep
_ a -> b
_ = forall sep b a. NonEmpty a -> NonEmpty' sep b a
NonEmpty'
instance Newtype (NonEmpty a) (NonEmpty' sep wrapper a)
instance (Newtype a b, Sep sep, Parsec b) => Parsec (NonEmpty' sep b a) where
parsec :: forall (m :: * -> *). CabalParsing m => m (NonEmpty' sep b a)
parsec = forall o n. Newtype o n => o -> n
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall o n. Newtype o n => n -> o
unpack :: b -> a) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m (NonEmpty a)
parseSepNE (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance (Newtype a b, Sep sep, Pretty b) => Pretty (NonEmpty' sep b a) where
pretty :: NonEmpty' sep b a -> Doc
pretty = forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
prettySep (forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall o n. Newtype o n => o -> n
pack :: a -> b)) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NE.toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype Token = Token { Token -> String
getToken :: String }
instance Newtype String Token
instance Parsec Token where
parsec :: forall (m :: * -> *). CabalParsing m => m Token
parsec = forall o n. Newtype o n => o -> n
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CabalParsing m => m String
parsecToken
instance Pretty Token where
pretty :: Token -> Doc
pretty = String -> Doc
showToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype Token' = Token' { Token' -> String
getToken' :: String }
instance Newtype String Token'
instance Parsec Token' where
parsec :: forall (m :: * -> *). CabalParsing m => m Token'
parsec = forall o n. Newtype o n => o -> n
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). CabalParsing m => m String
parsecToken'
instance Pretty Token' where
pretty :: Token' -> Doc
pretty = String -> Doc
showToken forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype MQuoted a = MQuoted { forall a. MQuoted a -> a
getMQuoted :: a }
instance Newtype a (MQuoted a)
instance Parsec a => Parsec (MQuoted a) where
parsec :: forall (m :: * -> *). CabalParsing m => m (MQuoted a)
parsec = forall o n. Newtype o n => o -> n
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecMaybeQuoted forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance Pretty a => Pretty (MQuoted a) where
pretty :: MQuoted a -> Doc
pretty = forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype FilePathNT = FilePathNT { FilePathNT -> String
getFilePathNT :: String }
instance Newtype String FilePathNT
instance Parsec FilePathNT where
parsec :: forall (m :: * -> *). CabalParsing m => m FilePathNT
parsec = do
String
token <- forall (m :: * -> *). CabalParsing m => m String
parsecToken
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
token
then forall (m :: * -> *) a. Parsing m => String -> m a
P.unexpected String
"empty FilePath"
else forall (m :: * -> *) a. Monad m => a -> m a
return (String -> FilePathNT
FilePathNT String
token)
instance Pretty FilePathNT where
pretty :: FilePathNT -> Doc
pretty = String -> Doc
showFilePath forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype SpecVersion = SpecVersion { SpecVersion -> CabalSpecVersion
getSpecVersion :: CabalSpecVersion }
deriving (SpecVersion -> SpecVersion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpecVersion -> SpecVersion -> Bool
$c/= :: SpecVersion -> SpecVersion -> Bool
== :: SpecVersion -> SpecVersion -> Bool
$c== :: SpecVersion -> SpecVersion -> Bool
Eq, Int -> SpecVersion -> ShowS
[SpecVersion] -> ShowS
SpecVersion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpecVersion] -> ShowS
$cshowList :: [SpecVersion] -> ShowS
show :: SpecVersion -> String
$cshow :: SpecVersion -> String
showsPrec :: Int -> SpecVersion -> ShowS
$cshowsPrec :: Int -> SpecVersion -> ShowS
Show)
instance Newtype CabalSpecVersion SpecVersion
instance Parsec SpecVersion where
parsec :: forall (m :: * -> *). CabalParsing m => m SpecVersion
parsec = do
Either Version VersionRange
e <- m (Either Version VersionRange)
parsecSpecVersion
let ver :: Version
ver :: Version
ver = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. a -> a
id VersionRange -> Version
specVersionFromRange Either Version VersionRange
e
digits :: [Int]
digits :: [Int]
digits = Version -> [Int]
versionNumbers Version
ver
case [Int] -> Maybe CabalSpecVersion
cabalSpecFromVersionDigits [Int]
digits of
Maybe CabalSpecVersion
Nothing -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall a b. (a -> b) -> a -> b
$ String
"Unknown cabal spec version specified: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ver
Just CabalSpecVersion
csv -> do
case Either Version VersionRange
e of
Left Version
_v | CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_12 -> forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTSpecVersion forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"With 1.10 or earlier, the 'cabal-version' field must use "
, String
"range syntax rather than a simple version number. Use "
, String
"'cabal-version: >= " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ver forall a. [a] -> [a] -> [a]
++ String
"'."
]
Right VersionRange
_vr | CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_12 -> forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTSpecVersion forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"Packages with 'cabal-version: 1.12' or later should specify a "
, String
"specific version of the Cabal spec of the form "
, String
"'cabal-version: x.y'. "
, String
"Use 'cabal-version: " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ver forall a. [a] -> [a] -> [a]
++ String
"'."
]
Right VersionRange
vr | CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_12
, Bool -> Bool
not (VersionRange -> Bool
simpleSpecVersionRangeSyntax VersionRange
vr) -> forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTSpecVersion forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ String
"It is recommended that the 'cabal-version' field only specify a "
, String
"version range of the form '>= x.y' for older cabal versions. Use "
, String
"'cabal-version: >= " forall a. [a] -> [a] -> [a]
++ forall a. Pretty a => a -> String
prettyShow Version
ver forall a. [a] -> [a] -> [a]
++ String
"'. "
, String
"Tools based on Cabal 1.10 and later will ignore upper bounds."
]
Either Version VersionRange
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
forall (m :: * -> *) a. Monad m => a -> m a
return (forall o n. Newtype o n => o -> n
pack CabalSpecVersion
csv)
where
parsecSpecVersion :: m (Either Version VersionRange)
parsecSpecVersion = forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m VersionRange
range
range :: m VersionRange
range = do
VersionRange
vr <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
if VersionRange -> Version
specVersionFromRange VersionRange
vr forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [Int
2,Int
1]
then forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"cabal-version higher than 2.2 cannot be specified as a range. See https://github.com/haskell/cabal/issues/4899"
else forall (m :: * -> *) a. Monad m => a -> m a
return VersionRange
vr
specVersionFromRange :: VersionRange -> Version
specVersionFromRange :: VersionRange -> Version
specVersionFromRange VersionRange
versionRange = case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
versionRange of
[] -> Version
version0
VersionInterval (LowerBound Version
version Bound
_) UpperBound
_ : [VersionInterval]
_ -> Version
version
simpleSpecVersionRangeSyntax :: VersionRange -> Bool
simpleSpecVersionRangeSyntax = forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange forall {a}. VersionRangeF a -> Bool
alg where
alg :: VersionRangeF a -> Bool
alg (OrLaterVersionF Version
_) = Bool
True
alg VersionRangeF a
_ = Bool
False
instance Pretty SpecVersion where
pretty :: SpecVersion -> Doc
pretty (SpecVersion CabalSpecVersion
csv)
| CabalSpecVersion
csv forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_12 = String -> Doc
text (CabalSpecVersion -> String
showCabalSpecVersion CabalSpecVersion
csv)
| Bool
otherwise = String -> Doc
text String
">=" Doc -> Doc -> Doc
<<>> String -> Doc
text (CabalSpecVersion -> String
showCabalSpecVersion CabalSpecVersion
csv)
newtype SpecLicense = SpecLicense { SpecLicense -> Either License License
getSpecLicense :: Either SPDX.License License }
instance Newtype (Either SPDX.License License) SpecLicense
instance Parsec SpecLicense where
parsec :: forall (m :: * -> *). CabalParsing m => m SpecLicense
parsec = do
CabalSpecVersion
v <- forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2
then Either License License -> SpecLicense
SpecLicense forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
else Either License License -> SpecLicense
SpecLicense forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance Pretty SpecLicense where
pretty :: SpecLicense -> Doc
pretty = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Pretty a => a -> Doc
pretty forall a. Pretty a => a -> Doc
pretty forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall o n. Newtype o n => n -> o
unpack
newtype TestedWith = TestedWith { TestedWith -> (CompilerFlavor, VersionRange)
getTestedWith :: (CompilerFlavor, VersionRange) }
instance Newtype (CompilerFlavor, VersionRange) TestedWith
instance Parsec TestedWith where
parsec :: forall (m :: * -> *). CabalParsing m => m TestedWith
parsec = forall o n. Newtype o n => o -> n
pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, VersionRange)
parsecTestedWith
instance Pretty TestedWith where
pretty :: TestedWith -> Doc
pretty TestedWith
x = case forall o n. Newtype o n => n -> o
unpack TestedWith
x of
(CompilerFlavor
compiler, VersionRange
vr) -> forall a. Pretty a => a -> Doc
pretty CompilerFlavor
compiler Doc -> Doc -> Doc
<+> forall a. Pretty a => a -> Doc
pretty VersionRange
vr
parsecTestedWith :: CabalParsing m => m (CompilerFlavor, VersionRange)
parsecTestedWith :: forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, VersionRange)
parsecTestedWith = do
CompilerFlavor
name <- forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec
VersionRange
ver <- forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionRange
anyVersion
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerFlavor
name, VersionRange
ver)