{-# LANGUAGE FlexibleContexts       #-}
{-# LANGUAGE FlexibleInstances      #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes             #-}
{-# LANGUAGE ScopedTypeVariables    #-}
{-# LANGUAGE TypeSynonymInstances   #-}
-- | This module provides @newtype@ wrappers to be used with "Distribution.FieldGrammar".
module Distribution.Parsec.Newtypes (
    -- * List
    alaList,
    alaList',
    -- ** Modifiers
    CommaVCat (..),
    CommaFSep (..),
    VCat (..),
    FSep (..),
    NoCommaFSep (..),
    Sep (..),
    -- ** Type
    List,
    -- * Set
    alaSet,
    alaSet',
    Set',
    -- * 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, VersionRange, anyVersion, asVersionIntervals, mkVersion)
import Text.PrettyPrint              (Doc, comma, fsep, punctuate, vcat, (<+>))

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]

instance Sep CommaVCat where
    prettySep :: Proxy CommaVCat -> [Doc] -> Doc
prettySep  Proxy CommaVCat
_ = [Doc] -> Doc
vcat ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
    parseSep :: Proxy CommaVCat -> m a -> m [a]
parseSep   Proxy CommaVCat
_ m a
p = do
        CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
        if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord CabalSpecVersion
>= CabalSpecVersion
CabalSpecV2_2 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecLeadingCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecCommaList m a
p
instance Sep CommaFSep where
    prettySep :: Proxy CommaFSep -> [Doc] -> Doc
prettySep Proxy CommaFSep
_ = [Doc] -> Doc
fsep ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Doc -> [Doc] -> [Doc]
punctuate Doc
comma
    parseSep :: Proxy CommaFSep -> m a -> m [a]
parseSep   Proxy CommaFSep
_ m a
p = do
        CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
        if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord CabalSpecVersion
>= CabalSpecVersion
CabalSpecV2_2 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecLeadingCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecCommaList m a
p
instance Sep VCat where
    prettySep :: Proxy VCat -> [Doc] -> Doc
prettySep Proxy VCat
_  = [Doc] -> Doc
vcat
    parseSep :: Proxy VCat -> m a -> m [a]
parseSep   Proxy VCat
_ m a
p = do
        CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
        if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord CabalSpecVersion
>= CabalSpecVersion
CabalSpecV3_0 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecLeadingOptCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecOptCommaList m a
p
instance Sep FSep where
    prettySep :: Proxy FSep -> [Doc] -> Doc
prettySep Proxy FSep
_  = [Doc] -> Doc
fsep
    parseSep :: Proxy FSep -> m a -> m [a]
parseSep   Proxy FSep
_ m a
p = do
        CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
        if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord CabalSpecVersion
>= CabalSpecVersion
CabalSpecV3_0 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecLeadingOptCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
parsecOptCommaList m a
p
instance Sep NoCommaFSep where
    prettySep :: Proxy NoCommaFSep -> [Doc] -> Doc
prettySep Proxy NoCommaFSep
_   = [Doc] -> Doc
fsep
    parseSep :: Proxy NoCommaFSep -> m a -> m [a]
parseSep  Proxy NoCommaFSep
_ m a
p = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
many (m a
p m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<* m ()
forall (m :: * -> *). CharParsing m => m ()
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing 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 { List sep b a -> [a]
_getList :: [a] }

-- | 'alaList' and 'alaList'' are simply 'List', with additional phantom
-- arguments to constraint 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 :: sep -> [a] -> List sep (Identity a) a
alaList sep
_ = [a] -> List sep (Identity a) a
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' :: sep -> (a -> b) -> [a] -> List sep b a
alaList' sep
_ a -> b
_ = [a] -> List sep b a
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 :: m (List sep b a)
parsec   = [a] -> List sep b a
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type forall a sep wrapper. Newtype [a] (List sep wrapper a)
pack ([a] -> List sep b a) -> ([b] -> [a]) -> [b] -> List sep b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b -> a
forall o n. Newtype o n => n -> o
Evidence bound by a type signature of the constraint type Newtype a b
unpack :: b -> a) ([b] -> List sep b a) -> m [b] -> m (List sep b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> Proxy sep -> m b -> m [b]
forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
Evidence bound by a type signature of the constraint type Sep sep
parseSep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) m b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Evidence bound by a type signature of the constraint type Parsec b
parsec

instance (Newtype a b, Sep sep, Pretty b) => Pretty (List sep b a) where
    pretty :: List sep b a -> Doc
pretty = Proxy sep -> [Doc] -> Doc
forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
Evidence bound by a type signature of the constraint type Sep sep
prettySep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) ([Doc] -> Doc) -> (List sep b a -> [Doc]) -> List sep b a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (b -> Doc
forall a. Pretty a => a -> Doc
Evidence bound by a type signature of the constraint type Pretty b
pretty (b -> Doc) -> (a -> b) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b
forall o n. Newtype o n => o -> n
Evidence bound by a type signature of the constraint type Newtype a b
pack :: a -> b)) ([a] -> [Doc]) -> (List sep b a -> [a]) -> List sep b a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. List sep b a -> [a]
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type forall a sep wrapper. Newtype [a] (List sep wrapper a)
unpack

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

-- | 'alaSet' and 'alaSet'' are simply 'Set'' constructor, with additional phantom
-- arguments to constraint 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 :: sep -> Set a -> Set' sep (Identity a) a
alaSet sep
_ = Set a -> Set' sep (Identity a) a
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' :: sep -> (a -> b) -> Set a -> Set' sep b a
alaSet' sep
_ a -> b
_ = Set a -> Set' sep b a
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 :: m (Set' sep b a)
parsec   = Set a -> Set' sep b a
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type forall a sep wrapper. Newtype (Set a) (Set' sep wrapper a)
pack (Set a -> Set' sep b a) -> ([b] -> Set a) -> [b] -> Set' sep b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [a] -> Set a
forall a. Ord a => [a] -> Set a
Evidence bound by a type signature of the constraint type Ord a
Set.fromList ([a] -> Set a) -> ([b] -> [a]) -> [b] -> Set a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> [b] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (b -> a
forall o n. Newtype o n => n -> o
Evidence bound by a type signature of the constraint type Newtype a b
unpack :: b -> a) ([b] -> Set' sep b a) -> m [b] -> m (Set' sep b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> Proxy sep -> m b -> m [b]
forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
Evidence bound by a type signature of the constraint type CabalParsing m
Evidence bound by a type signature of the constraint type Sep sep
parseSep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) m b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Evidence bound by a type signature of the constraint type Parsec b
parsec

instance (Newtype a b, Sep sep, Pretty b) => Pretty (Set' sep b a) where
    pretty :: Set' sep b a -> Doc
pretty = Proxy sep -> [Doc] -> Doc
forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
Evidence bound by a type signature of the constraint type Sep sep
prettySep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) ([Doc] -> Doc) -> (Set' sep b a -> [Doc]) -> Set' sep b a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> Doc) -> [a] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (b -> Doc
forall a. Pretty a => a -> Doc
Evidence bound by a type signature of the constraint type Pretty b
pretty (b -> Doc) -> (a -> b) -> a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (a -> b
forall o n. Newtype o n => o -> n
Evidence bound by a type signature of the constraint type Newtype a b
pack :: a -> b)) ([a] -> [Doc]) -> (Set' sep b a -> [a]) -> Set' sep b a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set a -> [a]
forall a. Set a -> [a]
Set.toList (Set a -> [a]) -> (Set' sep b a -> Set a) -> Set' sep b a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set' sep b a -> Set a
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type forall a sep wrapper. Newtype (Set a) (Set' sep wrapper a)
unpack

-- | Haskell string or @[^ ,]+@
newtype Token = Token { Token -> String
getToken :: String }

instance Newtype String Token

instance Parsec Token where
    parsec :: m Token
parsec = String -> Token
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type Newtype String Token
pack (String -> Token) -> m String -> m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m String
forall (m :: * -> *). CabalParsing m => m String
Evidence bound by a type signature of the constraint type CabalParsing m
parsecToken

instance Pretty Token where
    pretty :: Token -> Doc
pretty = String -> Doc
showToken (String -> Doc) -> (Token -> String) -> Token -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token -> String
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type Newtype String Token
unpack

-- | Haskell string or @[^ ]+@
newtype Token' = Token' { Token' -> String
getToken' :: String }

instance Newtype String Token'

instance Parsec Token' where
    parsec :: m Token'
parsec = String -> Token'
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type Newtype String Token'
pack (String -> Token') -> m String -> m Token'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m String
forall (m :: * -> *). CabalParsing m => m String
Evidence bound by a type signature of the constraint type CabalParsing m
parsecToken'

instance Pretty Token' where
    pretty :: Token' -> Doc
pretty = String -> Doc
showToken (String -> Doc) -> (Token' -> String) -> Token' -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Token' -> String
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type Newtype String Token'
unpack

-- | Either @"quoted"@ or @un-quoted@.
newtype MQuoted a = MQuoted { MQuoted a -> a
getMQuoted :: a }

instance Newtype a (MQuoted a)

instance Parsec a => Parsec (MQuoted a) where
    parsec :: m (MQuoted a)
parsec = a -> MQuoted a
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type forall a. Newtype a (MQuoted a)
pack (a -> MQuoted a) -> m a -> m (MQuoted a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m a -> m a
forall (m :: * -> *) a. CabalParsing m => m a -> m a
Evidence bound by a type signature of the constraint type CabalParsing m
parsecMaybeQuoted m a
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
Evidence bound by a type signature of the constraint type Parsec a
parsec

instance Pretty a => Pretty (MQuoted a)  where
    pretty :: MQuoted a -> Doc
pretty = a -> Doc
forall a. Pretty a => a -> Doc
Evidence bound by a type signature of the constraint type Pretty a
pretty (a -> Doc) -> (MQuoted a -> a) -> MQuoted a -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MQuoted a -> a
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type forall a. Newtype a (MQuoted a)
unpack

-- | 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>
--
newtype SpecVersion = SpecVersion { SpecVersion -> Either Version VersionRange
getSpecVersion :: Either Version VersionRange }

instance Newtype (Either Version VersionRange) SpecVersion

instance Parsec SpecVersion where
    parsec :: m SpecVersion
parsec = Either Version VersionRange -> SpecVersion
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type Newtype (Either Version VersionRange) SpecVersion
pack (Either Version VersionRange -> SpecVersion)
-> m (Either Version VersionRange) -> m SpecVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m (Either Version VersionRange)
parsecSpecVersion
      where
        parsecSpecVersion :: m (Either Version VersionRange)
parsecSpecVersion = Version -> Either Version VersionRange
forall a b. a -> Either a b
Left (Version -> Either Version VersionRange)
-> m Version -> m (Either Version VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m Version
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec Version
parsec m (Either Version VersionRange)
-> m (Either Version VersionRange)
-> m (Either Version VersionRange)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> VersionRange -> Either Version VersionRange
forall a b. b -> Either a b
Right (VersionRange -> Either Version VersionRange)
-> m VersionRange -> m (Either Version VersionRange)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m VersionRange
range
        range :: m VersionRange
range = do
            VersionRange
vr <- m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec VersionRange
parsec
            if VersionRange -> Version
specVersionFromRange VersionRange
vr Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Version
>= [Int] -> Version
mkVersion [Int
2,Int
1]
            then String -> m VersionRange
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadFail m
Evidence bound by a type signature of the constraint type CabalParsing m
fail String
"cabal-version higher than 2.2 cannot be specified as a range. See https://github.com/haskell/cabal/issues/4899"
            else VersionRange -> m VersionRange
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return VersionRange
vr

instance Pretty SpecVersion where
    pretty :: SpecVersion -> Doc
pretty = (Version -> Doc)
-> (VersionRange -> Doc) -> Either Version VersionRange -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty Version
pretty VersionRange -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty VersionRange
pretty (Either Version VersionRange -> Doc)
-> (SpecVersion -> Either Version VersionRange)
-> SpecVersion
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecVersion -> Either Version VersionRange
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type Newtype (Either Version VersionRange) SpecVersion
unpack

specVersionFromRange :: VersionRange -> Version
specVersionFromRange :: VersionRange -> Version
specVersionFromRange VersionRange
versionRange = case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
versionRange of
    []                            -> [Int] -> Version
mkVersion [Int
0]
    ((LowerBound Version
version Bound
_, UpperBound
_):[VersionInterval]
_) -> Version
version

-- | 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 :: m SpecLicense
parsec = do
        CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
        if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord CabalSpecVersion
>= CabalSpecVersion
CabalSpecV2_2
        then Either License License -> SpecLicense
SpecLicense (Either License License -> SpecLicense)
-> (License -> Either License License) -> License -> SpecLicense
forall b c a. (b -> c) -> (a -> b) -> a -> c
. License -> Either License License
forall a b. a -> Either a b
Left (License -> SpecLicense) -> m License -> m SpecLicense
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m License
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec License
parsec
        else Either License License -> SpecLicense
SpecLicense (Either License License -> SpecLicense)
-> (License -> Either License License) -> License -> SpecLicense
forall b c a. (b -> c) -> (a -> b) -> a -> c
. License -> Either License License
forall a b. b -> Either a b
Right (License -> SpecLicense) -> m License -> m SpecLicense
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m License
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec License
parsec

instance Pretty SpecLicense where
    pretty :: SpecLicense -> Doc
pretty = (License -> Doc)
-> (License -> Doc) -> Either License License -> Doc
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either License -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty License
pretty License -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty License
pretty (Either License License -> Doc)
-> (SpecLicense -> Either License License) -> SpecLicense -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpecLicense -> Either License License
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type Newtype (Either License License) SpecLicense
unpack

-- | Version range or just version
newtype TestedWith = TestedWith { TestedWith -> (CompilerFlavor, VersionRange)
getTestedWith :: (CompilerFlavor, VersionRange) }

instance Newtype (CompilerFlavor, VersionRange) TestedWith

instance Parsec TestedWith where
    parsec :: m TestedWith
parsec = (CompilerFlavor, VersionRange) -> TestedWith
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type Newtype (CompilerFlavor, VersionRange) TestedWith
pack ((CompilerFlavor, VersionRange) -> TestedWith)
-> m (CompilerFlavor, VersionRange) -> m TestedWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m (CompilerFlavor, VersionRange)
forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, VersionRange)
Evidence bound by a type signature of the constraint type CabalParsing m
parsecTestedWith

instance Pretty TestedWith where
    pretty :: TestedWith -> Doc
pretty TestedWith
x = case TestedWith -> (CompilerFlavor, VersionRange)
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type Newtype (CompilerFlavor, VersionRange) TestedWith
unpack TestedWith
x of
        (CompilerFlavor
compiler, VersionRange
vr) -> CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty CompilerFlavor
pretty CompilerFlavor
compiler Doc -> Doc -> Doc
<+> VersionRange -> Doc
forall a. Pretty a => a -> Doc
External instance of the constraint type Pretty VersionRange
pretty VersionRange
vr

-- | Filepath are parsed as 'Token'.
newtype FilePathNT = FilePathNT { FilePathNT -> String
getFilePathNT :: String }

instance Newtype String FilePathNT

instance Parsec FilePathNT where
    parsec :: m FilePathNT
parsec = String -> FilePathNT
forall o n. Newtype o n => o -> n
Instance of class: Newtype of the constraint type Newtype String FilePathNT
pack (String -> FilePathNT) -> m String -> m FilePathNT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type forall (f :: * -> *). Applicative f => Functor f
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<$> m String
forall (m :: * -> *). CabalParsing m => m String
Evidence bound by a type signature of the constraint type CabalParsing m
parsecToken

instance Pretty FilePathNT where
    pretty :: FilePathNT -> Doc
pretty = String -> Doc
showFilePath (String -> Doc) -> (FilePathNT -> String) -> FilePathNT -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePathNT -> String
forall o n. Newtype o n => n -> o
Instance of class: Newtype of the constraint type Newtype String FilePathNT
unpack

-------------------------------------------------------------------------------
-- Internal
-------------------------------------------------------------------------------

parsecTestedWith :: CabalParsing m => m (CompilerFlavor, VersionRange)
parsecTestedWith :: m (CompilerFlavor, VersionRange)
parsecTestedWith = do
    CompilerFlavor
name <- m CompilerFlavor
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
External instance of the constraint type Parsec CompilerFlavor
Evidence bound by a type signature of the constraint type CabalParsing m
lexemeParsec
    VersionRange
ver  <- m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
Evidence bound by a type signature of the constraint type CabalParsing m
External instance of the constraint type Parsec VersionRange
parsec m VersionRange -> m VersionRange -> m VersionRange
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
<|> VersionRange -> m VersionRange
forall (f :: * -> *) a. Applicative f => a -> f a
External instance of the constraint type forall (f :: * -> *). Alternative f => Applicative f
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
pure VersionRange
anyVersion
    (CompilerFlavor, VersionRange) -> m (CompilerFlavor, VersionRange)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (CompilerFlavor
name, VersionRange
ver)