{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE InstanceSigs #-}
{-# 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 (..)
  , SymbolicPathNT (..)
  , RelativePathNT (..)
  ) 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.Utils.Path
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 ([Doc] -> Doc) -> ([Doc] -> [Doc]) -> [Doc] -> Doc
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
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p
  parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaVCat -> m a -> m (NonEmpty a)
parseSepNE Proxy CommaVCat
_ m a
p = do
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV2_2 then parsecLeadingCommaNonEmpty p else parsecCommaNonEmpty 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 :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaFSep -> m a -> m [a]
parseSep Proxy CommaFSep
_ m a
p = do
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p
  parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy CommaFSep -> m a -> m (NonEmpty a)
parseSepNE Proxy CommaFSep
_ m a
p = do
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV2_2 then parsecLeadingCommaNonEmpty p else parsecCommaNonEmpty 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
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p
  parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy VCat -> m a -> m (NonEmpty a)
parseSepNE Proxy VCat
_ m a
p = m a -> m (NonEmpty a)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NE.some1 (m a
p m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
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
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV3_0 then parsecLeadingOptCommaList p else parsecOptCommaList p
  parseSepNE :: forall (m :: * -> *) a.
CabalParsing m =>
Proxy FSep -> m a -> m (NonEmpty a)
parseSepNE Proxy FSep
_ m a
p = m a -> m (NonEmpty a)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NE.some1 (m a
p m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
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 = m a -> m [a]
forall a. m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m a
p m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
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 = m a -> m (NonEmpty a)
forall (f :: * -> *) a. Alternative f => f a -> f (NonEmpty a)
NE.some1 (m a
p m a -> m () -> m a
forall a b. m a -> m b -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
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
_ = [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' :: forall sep a b. 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 :: forall (m :: * -> *). CabalParsing m => m (List sep b a)
parsec = [a] -> List sep b a
forall o n. Newtype o n => o -> n
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
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
<$> Proxy sep -> m b -> m [b]
forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => Proxy sep -> m a -> m [a]
parseSep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) m b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m 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
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
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
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
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
_ = 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' :: forall sep a b. 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 :: forall (m :: * -> *). CabalParsing m => m (Set' sep b a)
parsec = Set a -> Set' sep b a
forall o n. Newtype o n => o -> n
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
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
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
<$> Proxy sep -> m b -> m [b]
forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => Proxy sep -> m a -> m [a]
parseSep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) m b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m 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
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
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
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
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
_ = NonEmpty a -> NonEmpty' sep (Identity a) a
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
_ = NonEmpty a -> NonEmpty' sep b a
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 = NonEmpty a -> NonEmpty' sep b a
forall o n. Newtype o n => o -> n
pack (NonEmpty a -> NonEmpty' sep b a)
-> (NonEmpty b -> NonEmpty a) -> NonEmpty b -> NonEmpty' sep b a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (b -> a) -> NonEmpty b -> NonEmpty a
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (b -> a
forall o n. Newtype o n => n -> o
unpack :: b -> a) (NonEmpty b -> NonEmpty' sep b a)
-> m (NonEmpty b) -> m (NonEmpty' sep b a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Proxy sep -> m b -> m (NonEmpty b)
forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
Proxy sep -> m a -> m (NonEmpty a)
forall (m :: * -> *) a.
CabalParsing m =>
Proxy sep -> m a -> m (NonEmpty a)
parseSepNE (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) m b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m b
parsec

instance (Newtype a b, Sep sep, Pretty b) => Pretty (NonEmpty' sep b a) where
  pretty :: NonEmpty' sep b a -> Doc
pretty = Proxy sep -> [Doc] -> Doc
forall sep. Sep sep => Proxy sep -> [Doc] -> Doc
prettySep (Proxy sep
forall {k} (t :: k). Proxy t
Proxy :: Proxy sep) ([Doc] -> Doc)
-> (NonEmpty' sep b a -> [Doc]) -> NonEmpty' 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
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
pack :: a -> b)) ([a] -> [Doc])
-> (NonEmpty' sep b a -> [a]) -> NonEmpty' sep b a -> [Doc]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty a -> [a]
forall a. NonEmpty a -> [a]
NE.toList (NonEmpty a -> [a])
-> (NonEmpty' sep b a -> NonEmpty a) -> NonEmpty' sep b a -> [a]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty' sep b a -> NonEmpty a
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 = String -> Token
forall o n. Newtype o n => o -> n
pack (String -> Token) -> m String -> m Token
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
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
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 = String -> Token'
forall o n. Newtype o n => o -> n
pack (String -> Token') -> m String -> m Token'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
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
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 = a -> MQuoted a
forall o n. Newtype o n => o -> n
pack (a -> MQuoted a) -> m a -> m (MQuoted a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m a -> m a
forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecMaybeQuoted m a
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m a
parsec

instance Pretty a => Pretty (MQuoted a) where
  pretty :: MQuoted a -> Doc
pretty = a -> Doc
forall a. Pretty a => a -> Doc
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
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
    token <- m String
forall (m :: * -> *). CabalParsing m => m String
parsecToken
    if null token
      then P.unexpected "empty FilePath"
      else return (FilePathNT token)

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
unpack

-- | Newtype for 'SymbolicPath', with a different 'Parsec' instance
-- to disallow empty paths.
newtype SymbolicPathNT from to = SymbolicPathNT {forall from (to :: FileOrDir).
SymbolicPathNT from to -> SymbolicPath from to
getSymbolicPathNT :: SymbolicPath from to}

instance Newtype (SymbolicPath from to) (SymbolicPathNT from to)

instance Parsec (SymbolicPathNT from to) where
  parsec :: forall (m :: * -> *). CabalParsing m => m (SymbolicPathNT from to)
parsec = do
    token <- m String
forall (m :: * -> *). CabalParsing m => m String
parsecToken
    if null token
      then P.unexpected "empty FilePath"
      else return (SymbolicPathNT $ makeSymbolicPath token)

instance Pretty (SymbolicPathNT from to) where
  pretty :: SymbolicPathNT from to -> Doc
pretty = String -> Doc
showFilePath (String -> Doc)
-> (SymbolicPathNT from to -> String)
-> SymbolicPathNT from to
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'AllowAbsolute from to -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath (SymbolicPathX 'AllowAbsolute from to -> String)
-> (SymbolicPathNT from to -> SymbolicPathX 'AllowAbsolute from to)
-> SymbolicPathNT from to
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathNT from to -> SymbolicPathX 'AllowAbsolute from to
forall from (to :: FileOrDir).
SymbolicPathNT from to -> SymbolicPath from to
getSymbolicPathNT

-- | Newtype for 'RelativePath', with a different 'Parsec' instance
-- to disallow empty paths but allow non-relative paths (which get rejected
-- later with a different error message, see 'Distribution.PackageDescription.Check.Paths.checkPath')
newtype RelativePathNT from to = RelativePathNT {forall from (to :: FileOrDir).
RelativePathNT from to -> RelativePath from to
getRelativePathNT :: RelativePath from to}

instance Newtype (RelativePath from to) (RelativePathNT from to)

-- NB: we don't reject non-relative paths here; we allow them here and reject
-- later (see 'Distribution.PackageDescription.Check.Paths.checkPath').
instance Parsec (RelativePathNT from to) where
  parsec :: forall (m :: * -> *). CabalParsing m => m (RelativePathNT from to)
parsec = do
    token <- m String
forall (m :: * -> *). CabalParsing m => m String
parsecToken
    if null token
      then P.unexpected "empty FilePath"
      else return (RelativePathNT $ unsafeMakeSymbolicPath token)

instance Pretty (RelativePathNT from to) where
  pretty :: RelativePathNT from to -> Doc
pretty = String -> Doc
showFilePath (String -> Doc)
-> (RelativePathNT from to -> String)
-> RelativePathNT from to
-> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SymbolicPathX 'OnlyRelative from to -> String
forall (allowAbsolute :: AllowAbsolute) from (to :: FileOrDir).
SymbolicPathX allowAbsolute from to -> String
getSymbolicPath (SymbolicPathX 'OnlyRelative from to -> String)
-> (RelativePathNT from to -> SymbolicPathX 'OnlyRelative from to)
-> RelativePathNT from to
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RelativePathNT from to -> SymbolicPathX 'OnlyRelative from to
forall from (to :: FileOrDir).
RelativePathNT from to -> RelativePath from to
getRelativePathNT

-------------------------------------------------------------------------------
-- 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
(SpecVersion -> SpecVersion -> Bool)
-> (SpecVersion -> SpecVersion -> Bool) -> Eq SpecVersion
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecVersion -> SpecVersion -> Bool
== :: SpecVersion -> SpecVersion -> Bool
$c/= :: SpecVersion -> SpecVersion -> Bool
/= :: SpecVersion -> SpecVersion -> Bool
Eq, Int -> SpecVersion -> ShowS
[SpecVersion] -> ShowS
SpecVersion -> String
(Int -> SpecVersion -> ShowS)
-> (SpecVersion -> String)
-> ([SpecVersion] -> ShowS)
-> Show SpecVersion
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecVersion -> ShowS
showsPrec :: Int -> SpecVersion -> ShowS
$cshow :: SpecVersion -> String
show :: SpecVersion -> String
$cshowList :: [SpecVersion] -> ShowS
showList :: [SpecVersion] -> ShowS
Show) -- instances needed for tests

instance Newtype CabalSpecVersion SpecVersion

instance Parsec SpecVersion where
  parsec :: forall (m :: * -> *). CabalParsing m => m SpecVersion
parsec = do
    e <- m (Either Version VersionRange)
parsecSpecVersion
    let ver :: Version
        ver = (Version -> Version)
-> (VersionRange -> Version)
-> Either Version VersionRange
-> Version
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either Version -> Version
forall a. a -> a
id VersionRange -> Version
specVersionFromRange Either Version VersionRange
e

        digits :: [Int]
        digits = Version -> [Int]
versionNumbers Version
ver

    case cabalSpecFromVersionDigits digits of
      Maybe CabalSpecVersion
Nothing -> String -> m SpecVersion
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m SpecVersion) -> String -> m SpecVersion
forall a b. (a -> b) -> a -> b
$ String
"Unknown cabal spec version specified: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
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 CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_12 ->
                PWarnType -> String -> m ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTSpecVersion (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
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: >= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
ver String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
                    ]
          -- example:   cabal-version: >=1.12
          -- should be  cabal-version: 1.12
          Right VersionRange
_vr
            | CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV1_12 ->
                PWarnType -> String -> m ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTSpecVersion (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
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: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
ver String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
"'."
                    ]
          -- example:   cabal-version: >=1.10 && <1.12
          -- should be  cabal-version: >=1.10
          Right VersionRange
vr
            | CabalSpecVersion
csv CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
< CabalSpecVersion
CabalSpecV1_12
            , Bool -> Bool
not (VersionRange -> Bool
simpleSpecVersionRangeSyntax VersionRange
vr) ->
                PWarnType -> String -> m ()
forall (m :: * -> *). CabalParsing m => PWarnType -> String -> m ()
parsecWarning PWarnType
PWTSpecVersion (String -> m ()) -> String -> m ()
forall a b. (a -> b) -> a -> b
$
                  [String] -> String
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: >= " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
prettyShow Version
ver String -> ShowS
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
_ -> () -> m ()
forall a. a -> m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

        SpecVersion -> m SpecVersion
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (CabalSpecVersion -> SpecVersion
forall o n. Newtype o n => o -> n
pack CabalSpecVersion
csv)
    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
<$> m Version
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m Version
parsec m (Either Version VersionRange)
-> m (Either Version VersionRange)
-> m (Either Version VersionRange)
forall a. m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> 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
<$> m VersionRange
range

      range :: m VersionRange
range = do
        vr <- m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
forall (m :: * -> *). CabalParsing m => m VersionRange
parsec
        if specVersionFromRange vr >= mkVersion [2, 1]
          then fail "cabal-version higher than 2.2 cannot be specified as a range. See https://github.com/haskell/cabal/issues/4899"
          else return 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 = (VersionRangeF Bool -> Bool) -> VersionRange -> Bool
forall a. (VersionRangeF a -> a) -> VersionRange -> a
cataVersionRange VersionRangeF Bool -> Bool
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 CabalSpecVersion -> CabalSpecVersion -> Bool
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}
  deriving (Int -> SpecLicense -> ShowS
[SpecLicense] -> ShowS
SpecLicense -> String
(Int -> SpecLicense -> ShowS)
-> (SpecLicense -> String)
-> ([SpecLicense] -> ShowS)
-> Show SpecLicense
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpecLicense -> ShowS
showsPrec :: Int -> SpecLicense -> ShowS
$cshow :: SpecLicense -> String
show :: SpecLicense -> String
$cshowList :: [SpecLicense] -> ShowS
showList :: [SpecLicense] -> ShowS
Show, SpecLicense -> SpecLicense -> Bool
(SpecLicense -> SpecLicense -> Bool)
-> (SpecLicense -> SpecLicense -> Bool) -> Eq SpecLicense
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpecLicense -> SpecLicense -> Bool
== :: SpecLicense -> SpecLicense -> Bool
$c/= :: SpecLicense -> SpecLicense -> Bool
/= :: SpecLicense -> SpecLicense -> Bool
Eq)

instance Newtype (Either SPDX.License License) SpecLicense

instance Parsec SpecLicense where
  parsec :: forall (m :: * -> *). CabalParsing m => m SpecLicense
parsec = do
    v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
    if v >= CabalSpecV2_2
      then SpecLicense . Left <$> parsec
      else SpecLicense . Right <$> 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
pretty License -> Doc
forall a. Pretty a => a -> Doc
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
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 = (CompilerFlavor, VersionRange) -> TestedWith
forall o n. Newtype o n => o -> n
pack ((CompilerFlavor, VersionRange) -> TestedWith)
-> m (CompilerFlavor, VersionRange) -> m TestedWith
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m (CompilerFlavor, VersionRange)
forall (m :: * -> *).
CabalParsing m =>
m (CompilerFlavor, VersionRange)
parsecTestedWith

instance Pretty TestedWith where
  pretty :: TestedWith -> Doc
pretty TestedWith
x = case TestedWith -> (CompilerFlavor, VersionRange)
forall o n. Newtype o n => n -> o
unpack TestedWith
x of
    (CompilerFlavor
compiler, VersionRange
vr) -> CompilerFlavor -> Doc
forall a. Pretty a => a -> Doc
pretty CompilerFlavor
compiler Doc -> Doc -> Doc
<+> VersionRange -> 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
  name <- m CompilerFlavor
forall (m :: * -> *) a. (CabalParsing m, Parsec a) => m a
lexemeParsec
  ver <- parsec <|> pure anyVersion
  return (name, ver)