{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
module Distribution.Types.LegacyExeDependency
  ( LegacyExeDependency(..)
  ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Parsec
import Distribution.Pretty
import Distribution.Version (VersionRange, anyVersion)

import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint                as Disp

-- | Describes a legacy `build-tools`-style dependency on an executable
--
-- It is "legacy" because we do not know what the build-tool referred to. It
-- could refer to a pkg-config executable (PkgconfigName), or an internal
-- executable (UnqualComponentName). Thus the name is stringly typed.
--
-- @since 2.0.0.2
data LegacyExeDependency = LegacyExeDependency
                           String
                           VersionRange
                         deriving ((forall x. LegacyExeDependency -> Rep LegacyExeDependency x)
-> (forall x. Rep LegacyExeDependency x -> LegacyExeDependency)
-> Generic LegacyExeDependency
forall x. Rep LegacyExeDependency x -> LegacyExeDependency
forall x. LegacyExeDependency -> Rep LegacyExeDependency x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LegacyExeDependency x -> LegacyExeDependency
$cfrom :: forall x. LegacyExeDependency -> Rep LegacyExeDependency x
Generic, ReadPrec [LegacyExeDependency]
ReadPrec LegacyExeDependency
Int -> ReadS LegacyExeDependency
ReadS [LegacyExeDependency]
(Int -> ReadS LegacyExeDependency)
-> ReadS [LegacyExeDependency]
-> ReadPrec LegacyExeDependency
-> ReadPrec [LegacyExeDependency]
-> Read LegacyExeDependency
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LegacyExeDependency]
$creadListPrec :: ReadPrec [LegacyExeDependency]
readPrec :: ReadPrec LegacyExeDependency
$creadPrec :: ReadPrec LegacyExeDependency
readList :: ReadS [LegacyExeDependency]
$creadList :: ReadS [LegacyExeDependency]
readsPrec :: Int -> ReadS LegacyExeDependency
$creadsPrec :: Int -> ReadS LegacyExeDependency
Read, Int -> LegacyExeDependency -> ShowS
[LegacyExeDependency] -> ShowS
LegacyExeDependency -> String
(Int -> LegacyExeDependency -> ShowS)
-> (LegacyExeDependency -> String)
-> ([LegacyExeDependency] -> ShowS)
-> Show LegacyExeDependency
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LegacyExeDependency] -> ShowS
$cshowList :: [LegacyExeDependency] -> ShowS
show :: LegacyExeDependency -> String
$cshow :: LegacyExeDependency -> String
showsPrec :: Int -> LegacyExeDependency -> ShowS
$cshowsPrec :: Int -> LegacyExeDependency -> ShowS
Show, LegacyExeDependency -> LegacyExeDependency -> Bool
(LegacyExeDependency -> LegacyExeDependency -> Bool)
-> (LegacyExeDependency -> LegacyExeDependency -> Bool)
-> Eq LegacyExeDependency
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LegacyExeDependency -> LegacyExeDependency -> Bool
$c/= :: LegacyExeDependency -> LegacyExeDependency -> Bool
== :: LegacyExeDependency -> LegacyExeDependency -> Bool
$c== :: LegacyExeDependency -> LegacyExeDependency -> Bool
Eq, Typeable, Typeable LegacyExeDependency
Typeable LegacyExeDependency
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LegacyExeDependency
    -> c LegacyExeDependency)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LegacyExeDependency)
-> (LegacyExeDependency -> Constr)
-> (LegacyExeDependency -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LegacyExeDependency))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LegacyExeDependency))
-> ((forall b. Data b => b -> b)
    -> LegacyExeDependency -> LegacyExeDependency)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LegacyExeDependency -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LegacyExeDependency -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LegacyExeDependency -> m LegacyExeDependency)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LegacyExeDependency -> m LegacyExeDependency)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LegacyExeDependency -> m LegacyExeDependency)
-> Data LegacyExeDependency
LegacyExeDependency -> DataType
LegacyExeDependency -> Constr
(forall b. Data b => b -> b)
-> LegacyExeDependency -> LegacyExeDependency
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LegacyExeDependency -> u
forall u.
(forall d. Data d => d -> u) -> LegacyExeDependency -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LegacyExeDependency
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LegacyExeDependency
-> c LegacyExeDependency
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LegacyExeDependency)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LegacyExeDependency)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LegacyExeDependency -> m LegacyExeDependency
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LegacyExeDependency -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LegacyExeDependency -> u
gmapQ :: forall u.
(forall d. Data d => d -> u) -> LegacyExeDependency -> [u]
$cgmapQ :: forall u.
(forall d. Data d => d -> u) -> LegacyExeDependency -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LegacyExeDependency -> r
gmapT :: (forall b. Data b => b -> b)
-> LegacyExeDependency -> LegacyExeDependency
$cgmapT :: (forall b. Data b => b -> b)
-> LegacyExeDependency -> LegacyExeDependency
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LegacyExeDependency)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LegacyExeDependency)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LegacyExeDependency)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LegacyExeDependency)
dataTypeOf :: LegacyExeDependency -> DataType
$cdataTypeOf :: LegacyExeDependency -> DataType
toConstr :: LegacyExeDependency -> Constr
$ctoConstr :: LegacyExeDependency -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LegacyExeDependency
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LegacyExeDependency
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LegacyExeDependency
-> c LegacyExeDependency
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LegacyExeDependency
-> c LegacyExeDependency
Data)

instance Binary LegacyExeDependency
instance Structured LegacyExeDependency
instance NFData LegacyExeDependency where rnf :: LegacyExeDependency -> ()
rnf = LegacyExeDependency -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf

instance Pretty LegacyExeDependency where
    pretty :: LegacyExeDependency -> Doc
pretty (LegacyExeDependency String
name VersionRange
ver) =
        String -> Doc
Disp.text String
name Doc -> Doc -> Doc
<+> VersionRange -> Doc
forall a. Pretty a => a -> Doc
pretty VersionRange
ver

instance Parsec LegacyExeDependency where
    parsec :: forall (m :: * -> *). CabalParsing m => m LegacyExeDependency
parsec = do
        String
name <- m String -> m String
forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecMaybeQuoted m String
nameP
        m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces
        VersionRange
verRange <- m VersionRange -> m VersionRange
forall (m :: * -> *) a. CabalParsing m => m a -> m a
parsecMaybeQuoted m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m VersionRange -> m VersionRange -> m VersionRange
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> VersionRange -> m VersionRange
forall (f :: * -> *) a. Applicative f => a -> f a
pure VersionRange
anyVersion
        LegacyExeDependency -> m LegacyExeDependency
forall (f :: * -> *) a. Applicative f => a -> f a
pure (LegacyExeDependency -> m LegacyExeDependency)
-> LegacyExeDependency -> m LegacyExeDependency
forall a b. (a -> b) -> a -> b
$ String -> VersionRange -> LegacyExeDependency
LegacyExeDependency String
name VersionRange
verRange
      where
        nameP :: m String
nameP = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"-" ([String] -> String)
-> (NonEmpty String -> [String]) -> NonEmpty String -> String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NonEmpty String -> [String]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (NonEmpty String -> String) -> m (NonEmpty String) -> m String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String -> m Char -> m (NonEmpty String)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
P.sepByNonEmpty m String
component (Char -> m Char
forall (m :: * -> *). CharParsing m => Char -> m Char
P.char Char
'-')
        component :: m String
component = do
            String
cs <- (Char -> Bool) -> m String
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m String
P.munch1 (\Char
c -> Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
            if (Char -> Bool) -> String -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isDigit String
cs then String -> m String
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"invalid component" else String -> m String
forall (m :: * -> *) a. Monad m => a -> m a
return String
cs