{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeSynonymInstances #-}
module Distribution.Parsec.Newtypes (
alaList,
alaList',
CommaVCat (..),
CommaFSep (..),
VCat (..),
FSep (..),
NoCommaFSep (..),
List,
SpecVersion (..),
TestedWith (..),
SpecLicense (..),
Token (..),
Token' (..),
MQuoted (..),
FreeText (..),
FilePathNT (..),
) where
import Distribution.Compat.Newtype
import Distribution.Compat.Prelude
import Prelude ()
import Data.Functor.Identity (Identity (..))
import Data.List (dropWhileEnd)
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 Distribution.Compat.CharParsing as P
import qualified Distribution.SPDX as SPDX
data CommaVCat = CommaVCat
data CommaFSep = CommaFSep
data VCat = VCat
data FSep = FSep
data NoCommaFSep = NoCommaFSep
data P sep = P
class Sep sep where
prettySep :: P sep -> [Doc] -> Doc
parseSep :: CabalParsing m => P sep -> m a -> m [a]
instance Sep CommaVCat where
prettySep :: P CommaVCat -> [Doc] -> Doc
prettySep _ = [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 :: P CommaVCat -> m a -> m [a]
parseSep _ p :: m a
p = do
CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList m a
p
instance Sep CommaFSep where
prettySep :: P CommaFSep -> [Doc] -> Doc
prettySep _ = [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 :: P CommaFSep -> m a -> m [a]
parseSep _ p :: m a
p = do
CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV2_2 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecCommaList m a
p
instance Sep VCat where
prettySep :: P VCat -> [Doc] -> Doc
prettySep _ = [Doc] -> Doc
vcat
parseSep :: P VCat -> m a -> m [a]
parseSep _ p :: m a
p = do
CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList m a
p
instance Sep FSep where
prettySep :: P FSep -> [Doc] -> Doc
prettySep _ = [Doc] -> Doc
fsep
parseSep :: P FSep -> m a -> m [a]
parseSep _ p :: m a
p = do
CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= CabalSpecVersion
CabalSpecV3_0 then m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecLeadingOptCommaList m a
p else m a -> m [a]
forall (m :: * -> *) a. CabalParsing m => m a -> m [a]
parsecOptCommaList m a
p
instance Sep NoCommaFSep where
prettySep :: P NoCommaFSep -> [Doc] -> Doc
prettySep _ = [Doc] -> Doc
fsep
parseSep :: P NoCommaFSep -> m a -> m [a]
parseSep _ p :: m a
p = m a -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many (m a
p m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces)
newtype List sep b a = List { List sep b a -> [a]
getList :: [a] }
alaList :: sep -> [a] -> List sep (Identity a) a
alaList :: sep -> [a] -> List sep (Identity a) a
alaList _ = [a] -> List sep (Identity a) a
forall sep b a. [a] -> List sep b a
List
alaList' :: sep -> (a -> b) -> [a] -> List sep b a
alaList' :: sep -> (a -> b) -> [a] -> List sep b a
alaList' _ _ = [a] -> List sep b a
forall sep b a. [a] -> List sep b a
List
instance Newtype (List sep wrapper a) [a] where
pack :: [a] -> List sep wrapper a
pack = [a] -> List sep wrapper a
forall sep b a. [a] -> List sep b a
List
unpack :: List sep wrapper a -> [a]
unpack = List sep wrapper a -> [a]
forall sep wrapper a. List sep wrapper a -> [a]
getList
instance (Newtype b a, Sep sep, Parsec b) => Parsec (List sep b a) where
parsec :: m (List sep b a)
parsec = [a] -> List sep b a
forall n o. Newtype n o => 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 n o. Newtype n o => 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
<$> P sep -> m b -> m [b]
forall sep (m :: * -> *) a.
(Sep sep, CabalParsing m) =>
P sep -> m a -> m [a]
parseSep (P sep
forall sep. P sep
P :: P sep) m b
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
instance (Newtype b a, Sep sep, Pretty b) => Pretty (List sep b a) where
pretty :: List sep b a -> Doc
pretty = P sep -> [Doc] -> Doc
forall sep. Sep sep => P sep -> [Doc] -> Doc
prettySep (P sep
forall sep. P sep
P :: P 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 n o. Newtype n o => 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 n o. Newtype n o => n -> o
unpack
newtype Token = Token { Token -> String
getToken :: String }
instance Newtype Token String where
pack :: String -> Token
pack = String -> Token
Token
unpack :: Token -> String
unpack = Token -> String
getToken
instance Parsec Token where
parsec :: m Token
parsec = String -> Token
forall n o. Newtype n o => 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 n o. Newtype n o => n -> o
unpack
newtype Token' = Token' { Token' -> String
getToken' :: String }
instance Newtype Token' String where
pack :: String -> Token'
pack = String -> Token'
Token'
unpack :: Token' -> String
unpack = Token' -> String
getToken'
instance Parsec Token' where
parsec :: m Token'
parsec = String -> Token'
forall n o. Newtype n o => 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 n o. Newtype n o => n -> o
unpack
newtype MQuoted a = MQuoted { MQuoted a -> a
getMQuoted :: a }
instance Newtype (MQuoted a) a where
pack :: a -> MQuoted a
pack = a -> MQuoted a
forall a. a -> MQuoted a
MQuoted
unpack :: MQuoted a -> a
unpack = MQuoted a -> a
forall a. MQuoted a -> a
getMQuoted
instance Parsec a => Parsec (MQuoted a) where
parsec :: m (MQuoted a)
parsec = a -> MQuoted a
forall n o. Newtype n o => 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
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 n o. Newtype n o => n -> o
unpack
newtype SpecVersion = SpecVersion { SpecVersion -> Either Version VersionRange
getSpecVersion :: Either Version VersionRange }
instance Newtype SpecVersion (Either Version VersionRange) where
pack :: Either Version VersionRange -> SpecVersion
pack = Either Version VersionRange -> SpecVersion
SpecVersion
unpack :: SpecVersion -> Either Version VersionRange
unpack = SpecVersion -> Either Version VersionRange
getSpecVersion
instance Parsec SpecVersion where
parsec :: m SpecVersion
parsec = Either Version VersionRange -> SpecVersion
forall n o. Newtype n o => o -> n
pack (Either Version VersionRange -> SpecVersion)
-> m (Either Version VersionRange) -> m SpecVersion
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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
<$> m Version
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec m (Either Version VersionRange)
-> m (Either Version VersionRange)
-> m (Either Version VersionRange)
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
VersionRange
vr <- m VersionRange
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
parsec
if VersionRange -> Version
specVersionFromRange VersionRange
vr Version -> Version -> Bool
forall a. Ord a => a -> a -> Bool
>= [Int] -> Version
mkVersion [2,1]
then String -> m VersionRange
forall (m :: * -> *) a. MonadFail m => String -> m a
fail "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
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
pretty VersionRange -> Doc
forall a. Pretty a => a -> Doc
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 n o. Newtype n o => n -> o
unpack
specVersionFromRange :: VersionRange -> Version
specVersionFromRange :: VersionRange -> Version
specVersionFromRange versionRange :: VersionRange
versionRange = case VersionRange -> [VersionInterval]
asVersionIntervals VersionRange
versionRange of
[] -> [Int] -> Version
mkVersion [0]
((LowerBound version :: Version
version _, _):_) -> Version
version
newtype SpecLicense = SpecLicense { SpecLicense -> Either License License
getSpecLicense :: Either SPDX.License License }
instance Newtype SpecLicense (Either SPDX.License License) where
pack :: Either License License -> SpecLicense
pack = Either License License -> SpecLicense
SpecLicense
unpack :: SpecLicense -> Either License License
unpack = SpecLicense -> Either License License
getSpecLicense
instance Parsec SpecLicense where
parsec :: m SpecLicense
parsec = do
CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
askCabalSpecVersion
if CabalSpecVersion
v CabalSpecVersion -> CabalSpecVersion -> Bool
forall a. Ord a => a -> a -> Bool
>= 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
<$> m License
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
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
<$> m License
forall a (m :: * -> *). (Parsec a, CabalParsing m) => m a
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 n o. Newtype n o => n -> o
unpack
newtype TestedWith = TestedWith { TestedWith -> (CompilerFlavor, VersionRange)
getTestedWith :: (CompilerFlavor, VersionRange) }
instance Newtype TestedWith (CompilerFlavor, VersionRange) where
pack :: (CompilerFlavor, VersionRange) -> TestedWith
pack = (CompilerFlavor, VersionRange) -> TestedWith
TestedWith
unpack :: TestedWith -> (CompilerFlavor, VersionRange)
unpack = TestedWith -> (CompilerFlavor, VersionRange)
getTestedWith
instance Parsec TestedWith where
parsec :: m TestedWith
parsec = (CompilerFlavor, VersionRange) -> TestedWith
forall n o. Newtype n o => 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 x :: TestedWith
x = case TestedWith -> (CompilerFlavor, VersionRange)
forall n o. Newtype n o => n -> o
unpack TestedWith
x of
(compiler :: CompilerFlavor
compiler, vr :: 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
newtype FreeText = FreeText { FreeText -> String
getFreeText :: String }
instance Newtype FreeText String where
pack :: String -> FreeText
pack = String -> FreeText
FreeText
unpack :: FreeText -> String
unpack = FreeText -> String
getFreeText
instance Parsec FreeText where
parsec :: m FreeText
parsec = String -> FreeText
forall n o. Newtype n o => o -> n
pack (String -> FreeText) -> (String -> String) -> String -> FreeText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
dropDotLines (String -> FreeText) -> m () -> m (String -> FreeText)
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ m ()
forall (m :: * -> *). CharParsing m => m ()
P.spaces m (String -> FreeText) -> m String -> m FreeText
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many m Char
forall (m :: * -> *). CharParsing m => m Char
P.anyChar
where
dropDotLines :: String -> String
dropDotLines "." = "."
dropDotLines x :: String
x = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate "\n" ([String] -> String) -> (String -> [String]) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map String -> String
dotToEmpty ([String] -> [String])
-> (String -> [String]) -> String -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
lines (String -> String) -> String -> String
forall a b. (a -> b) -> a -> b
$ String
x
dotToEmpty :: String -> String
dotToEmpty x :: String
x | String -> String
trim' String
x String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== "." = ""
dotToEmpty x :: String
x = String -> String
trim String
x
trim' :: String -> String
trim' :: String -> String
trim' = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd (Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (" \t" :: String))
trim :: String -> String
trim :: String -> String
trim = (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhileEnd Char -> Bool
isSpace
instance Pretty FreeText where
pretty :: FreeText -> Doc
pretty = String -> Doc
showFreeText (String -> Doc) -> (FreeText -> String) -> FreeText -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FreeText -> String
forall n o. Newtype n o => n -> o
unpack
newtype FilePathNT = FilePathNT { FilePathNT -> String
getFilePathNT :: String }
instance Newtype FilePathNT String where
pack :: String -> FilePathNT
pack = String -> FilePathNT
FilePathNT
unpack :: FilePathNT -> String
unpack = FilePathNT -> String
getFilePathNT
instance Parsec FilePathNT where
parsec :: m FilePathNT
parsec = String -> FilePathNT
forall n o. Newtype n o => o -> n
pack (String -> FilePathNT) -> m String -> m FilePathNT
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m String
forall (m :: * -> *). CabalParsing m => m String
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 n o. Newtype n o => n -> o
unpack
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
lexemeParsec
VersionRange
ver <- 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
(CompilerFlavor, VersionRange) -> m (CompilerFlavor, VersionRange)
forall (m :: * -> *) a. Monad m => a -> m a
return (CompilerFlavor
name, VersionRange
ver)