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.Class
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 _ = vcat . punctuate comma
parseSep _ p = do
v <- askCabalSpecVersion
if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p
instance Sep CommaFSep where
prettySep _ = fsep . punctuate comma
parseSep _ p = do
v <- askCabalSpecVersion
if v >= CabalSpecV2_2 then parsecLeadingCommaList p else parsecCommaList p
instance Sep VCat where
prettySep _ = vcat
parseSep _ = parsecOptCommaList
instance Sep FSep where
prettySep _ = fsep
parseSep _ = parsecOptCommaList
instance Sep NoCommaFSep where
prettySep _ = fsep
parseSep _ p = many (p <* P.spaces)
newtype List sep b a = List { getList :: [a] }
alaList :: sep -> [a] -> List sep (Identity a) a
alaList _ = List
alaList' :: sep -> (a -> b) -> [a] -> List sep b a
alaList' _ _ = List
instance Newtype (List sep wrapper a) [a] where
pack = List
unpack = getList
instance (Newtype b a, Sep sep, Parsec b) => Parsec (List sep b a) where
parsec = pack . map (unpack :: b -> a) <$> parseSep (P :: P sep) parsec
instance (Newtype b a, Sep sep, Pretty b) => Pretty (List sep b a) where
pretty = prettySep (P :: P sep) . map (pretty . (pack :: a -> b)) . unpack
newtype Token = Token { getToken :: String }
instance Newtype Token String where
pack = Token
unpack = getToken
instance Parsec Token where
parsec = pack <$> parsecToken
instance Pretty Token where
pretty = showToken . unpack
newtype Token' = Token' { getToken' :: String }
instance Newtype Token' String where
pack = Token'
unpack = getToken'
instance Parsec Token' where
parsec = pack <$> parsecToken'
instance Pretty Token' where
pretty = showToken . unpack
newtype MQuoted a = MQuoted { getMQuoted :: a }
instance Newtype (MQuoted a) a where
pack = MQuoted
unpack = getMQuoted
instance Parsec a => Parsec (MQuoted a) where
parsec = pack <$> parsecMaybeQuoted parsec
instance Pretty a => Pretty (MQuoted a) where
pretty = pretty . unpack
newtype SpecVersion = SpecVersion { getSpecVersion :: Either Version VersionRange }
instance Newtype SpecVersion (Either Version VersionRange) where
pack = SpecVersion
unpack = getSpecVersion
instance Parsec SpecVersion where
parsec = pack <$> parsecSpecVersion
where
parsecSpecVersion = Left <$> parsec <|> Right <$> range
range = do
vr <- 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
instance Pretty SpecVersion where
pretty = either pretty pretty . unpack
specVersionFromRange :: VersionRange -> Version
specVersionFromRange versionRange = case asVersionIntervals versionRange of
[] -> mkVersion [0]
((LowerBound version _, _):_) -> version
newtype SpecLicense = SpecLicense { getSpecLicense :: Either SPDX.License License }
instance Newtype SpecLicense (Either SPDX.License License) where
pack = SpecLicense
unpack = getSpecLicense
instance Parsec SpecLicense where
parsec = do
v <- askCabalSpecVersion
if v >= CabalSpecV2_2
then SpecLicense . Left <$> parsec
else SpecLicense . Right <$> parsec
instance Pretty SpecLicense where
pretty = either pretty pretty . unpack
newtype TestedWith = TestedWith { getTestedWith :: (CompilerFlavor, VersionRange) }
instance Newtype TestedWith (CompilerFlavor, VersionRange) where
pack = TestedWith
unpack = getTestedWith
instance Parsec TestedWith where
parsec = pack <$> parsecTestedWith
instance Pretty TestedWith where
pretty x = case unpack x of
(compiler, vr) -> pretty compiler <+> pretty vr
newtype FreeText = FreeText { getFreeText :: String }
instance Newtype FreeText String where
pack = FreeText
unpack = getFreeText
instance Parsec FreeText where
parsec = pack . dropDotLines <$ P.spaces <*> many P.anyChar
where
dropDotLines "." = "."
dropDotLines x = intercalate "\n" . map dotToEmpty . lines $ x
dotToEmpty x | trim' x == "." = ""
dotToEmpty x = trim x
trim' :: String -> String
trim' = dropWhileEnd (`elem` (" \t" :: String))
trim :: String -> String
trim = dropWhile isSpace . dropWhileEnd isSpace
instance Pretty FreeText where
pretty = showFreeText . unpack
newtype FilePathNT = FilePathNT { getFilePathNT :: String }
instance Newtype FilePathNT String where
pack = FilePathNT
unpack = getFilePathNT
instance Parsec FilePathNT where
parsec = pack <$> parsecToken
instance Pretty FilePathNT where
pretty = showFilePath . unpack
parsecTestedWith :: CabalParsing m => m (CompilerFlavor, VersionRange)
parsecTestedWith = do
name <- lexemeParsec
ver <- parsec <|> pure anyVersion
return (name, ver)