{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE OverloadedStrings      #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
-- | This module provides @newtype@ wrappers to be used with "Distribution.FieldGrammar".
module Distribution.FieldGrammar.Newtypes (
    -- * List
    alaList,
    alaList',
    -- ** Modifiers
    CommaVCat (..),
    CommaFSep (..),
    VCat (..),
    FSep (..),
    NoCommaFSep (..),
    Sep (..),
    -- ** Type
    List,
    -- ** Set
    alaSet,
    alaSet',
    Set',
    -- ** NonEmpty
    alaNonEmpty,
    alaNonEmpty',
    NonEmpty',
    -- * Version & License
    SpecVersion (..),
    TestedWith (..),
    SpecLicense (..),
    -- * Identifiers
    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

-- | Vertical list with commas. Displayed with 'vcat'
data CommaVCat = CommaVCat

-- | Paragraph fill list with commas. Displayed with 'fsep'
data CommaFSep = CommaFSep

-- | Vertical list with optional commas. Displayed with 'vcat'.
data VCat = VCat

-- | Paragraph fill list with optional commas. Displayed with 'fsep'.
data FSep = FSep

-- | Paragraph fill list without commas. Displayed with '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)

-- | List separated with optional commas. Displayed with @sep@, arguments of
-- type @a@ are parsed and pretty-printed as @b@.
newtype List sep b a = List { forall sep b a. List sep b a -> [a]
_getList :: [a] }

-- | 'alaList' and 'alaList'' are simply 'List', with additional phantom
-- arguments to constrain the resulting type
--
-- >>> :t alaList VCat
-- alaList VCat :: [a] -> List VCat (Identity a) a
--
-- >>> :t alaList' FSep Token
-- alaList' FSep Token :: [String] -> List FSep Token String
--
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

-- | More general version of 'alaList'.
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

--
-- | Like 'List', but for 'Set'.
--
-- @since 3.2.0.0
newtype Set' sep b a = Set' { forall sep b a. Set' sep b a -> Set a
_getSet :: Set a }

-- | 'alaSet' and 'alaSet'' are simply 'Set'' constructor, with additional phantom
-- arguments to constrain the resulting type
--
-- >>> :t alaSet VCat
-- alaSet VCat :: Set a -> Set' VCat (Identity a) a
--
-- >>> :t alaSet' FSep Token
-- alaSet' FSep Token :: Set String -> Set' FSep Token String
--
-- >>> unpack' (alaSet' FSep Token) <$> eitherParsec "foo bar foo"
-- Right (fromList ["bar","foo"])
--
-- @since 3.2.0.0
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'

-- | More general version of 'alaSet'.
--
-- @since 3.2.0.0
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

--
-- | Like 'List', but for 'NonEmpty'.
--
-- @since 3.2.0.0
newtype NonEmpty' sep b a = NonEmpty' { forall sep b a. NonEmpty' sep b a -> NonEmpty a
_getNonEmpty :: NonEmpty a }

-- | 'alaNonEmpty' and 'alaNonEmpty'' are simply 'NonEmpty'' constructor, with additional phantom
-- arguments to constrain the resulting type
--
-- >>> :t alaNonEmpty VCat
-- alaNonEmpty VCat :: NonEmpty a -> NonEmpty' VCat (Identity a) a
--
-- >>> unpack' (alaNonEmpty' FSep Token) <$> eitherParsec "foo bar foo"
-- Right ("foo" :| ["bar","foo"])
--
-- @since 3.2.0.0
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'

-- | More general version of 'alaNonEmpty'.
--
-- @since 3.2.0.0
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

-------------------------------------------------------------------------------
-- Identifiers
-------------------------------------------------------------------------------

-- | Haskell string or @[^ ,]+@
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

-- | Haskell string or @[^ ]+@
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

-- | Either @"quoted"@ or @un-quoted@.
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

-- | Filepath are parsed as 'Token'.
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

-------------------------------------------------------------------------------
-- SpecVersion
-------------------------------------------------------------------------------

-- | Version range or just version, i.e. @cabal-version@ field.
--
-- There are few things to consider:
--
-- * Starting with 2.2 the cabal-version field should be the first field in the
--   file and only exact version is accepted. Therefore if we get e.g.
--   @>= 2.2@, we fail.
--   See <https://github.com/haskell/cabal/issues/4899>
--
-- We have this newtype, as writing Parsec and Pretty instances
-- for CabalSpecVersion would cause cycle in modules:
--     Version -> CabalSpecVersion -> Parsec -> ...
--
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) -- instances needed for tests

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
                -- Check some warnings:
                case Either Version VersionRange
e of
                    -- example:   cabal-version: 1.10
                    -- should be  cabal-version: >=1.10
                    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
"'."
                        ]

                    -- example:   cabal-version: >=1.12
                    -- should be  cabal-version: 1.12
                    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
"'."
                        ]

                    -- example:   cabal-version: >=1.10 && <1.12
                    -- should be  cabal-version: >=1.10
                    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."
                        ]

                    -- otherwise no warnings
                    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)

-------------------------------------------------------------------------------
-- SpecLicense
-------------------------------------------------------------------------------

-- | SPDX License expression or legacy license
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

-------------------------------------------------------------------------------
-- TestedWith
-------------------------------------------------------------------------------

-- | Version range or just version
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)