Cabal-syntax/src/Distribution/Types/PkgconfigVersionRange.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 module Distribution.Types.PkgconfigVersionRange
   5   ( PkgconfigVersionRange (..)
   6   , anyPkgconfigVersion
   7   , isAnyPkgconfigVersion
   8   , withinPkgconfigVersionRange
   9
  10     -- * Internal
  11   , versionToPkgconfigVersion
  12   , versionRangeToPkgconfigVersionRange
  13   ) where
  14
  15 import Distribution.Compat.Prelude
  16 import Prelude ()
  17
  18 import Distribution.CabalSpecVersion
  19 import Distribution.Parsec
  20 import Distribution.Pretty
  21 import Distribution.Types.PkgconfigVersion
  22 import Distribution.Types.Version
  23 import Distribution.Types.VersionInterval
  24 import Distribution.Types.VersionRange
  25
  26 import qualified Data.ByteString.Char8 as BS8
  27 import qualified Distribution.Compat.CharParsing as P
  28 import qualified Text.PrettyPrint as PP
  29
  30 -- | @since 3.0
  31 data PkgconfigVersionRange
  32   = PcAnyVersion
  33   | PcThisVersion PkgconfigVersion -- = version
  34   | PcLaterVersion PkgconfigVersion -- > version  (NB. not >=)
  35   | PcEarlierVersion PkgconfigVersion -- < version
  36   | PcOrLaterVersion PkgconfigVersion -- >= version
  37   | PcOrEarlierVersion PkgconfigVersion -- =< version
  38   | PcUnionVersionRanges PkgconfigVersionRange PkgconfigVersionRange
  39   | PcIntersectVersionRanges PkgconfigVersionRange PkgconfigVersionRange
  40   deriving (Generic, Read, Show, Eq, Ord, Typeable, Data)
  41
  42 instance Binary PkgconfigVersionRange
  43 instance Structured PkgconfigVersionRange
  44 instance NFData PkgconfigVersionRange where rnf = genericRnf
  45
  46 instance Pretty PkgconfigVersionRange where
  47   pretty = pp 0
  48     where
  49       pp :: Int -> PkgconfigVersionRange -> PP.Doc
  50       pp _ PcAnyVersion = PP.text "-any"
  51       pp _ (PcThisVersion v) = PP.text "==" <<>> pretty v
  52       pp _ (PcLaterVersion v) = PP.text ">" <<>> pretty v
  53       pp _ (PcEarlierVersion v) = PP.text "<" <<>> pretty v
  54       pp _ (PcOrLaterVersion v) = PP.text ">=" <<>> pretty v
  55       pp _ (PcOrEarlierVersion v) = PP.text "<=" <<>> pretty v
  56       pp d (PcUnionVersionRanges v u) =
  57         parens (d >= 1) $
  58           pp 1 v PP.<+> PP.text "||" PP.<+> pp 0 u
  59       pp d (PcIntersectVersionRanges v u) =
  60         parens (d >= 2) $
  61           pp 2 v PP.<+> PP.text "&&" PP.<+> pp 1 u
  62
  63       parens True = PP.parens
  64       parens False = id
  65
  66 instance Parsec PkgconfigVersionRange where
  67   -- note: the wildcard is used in some places, e.g
  68   -- http://hackage.haskell.org/package/bindings-libzip-0.10.1/bindings-libzip.cabal
  69   --
  70   -- however, in the presence of alphanumerics etc. lax version parser,
  71   -- wildcard is ill-specified
  72
  73   parsec = do
  74     csv <- askCabalSpecVersion
  75     if csv >= CabalSpecV3_0
  76       then pkgconfigParser
  77       else versionRangeToPkgconfigVersionRange <$> versionRangeParser P.integral csv
  78
  79 -- "modern" parser of @pkg-config@ package versions.
  80 pkgconfigParser :: CabalParsing m => m PkgconfigVersionRange
  81 pkgconfigParser = P.spaces >> expr
  82   where
  83     -- every parser here eats trailing space
  84     expr = do
  85       ts <- term `P.sepByNonEmpty` (P.string "||" >> P.spaces)
  86       return $ foldr1 PcUnionVersionRanges ts
  87
  88     term = do
  89       fs <- factor `P.sepByNonEmpty` (P.string "&&" >> P.spaces)
  90       return $ foldr1 PcIntersectVersionRanges fs
  91
  92     factor = parens expr <|> prim
  93
  94     prim = do
  95       op <- P.munch1 isOpChar P.<?> "operator"
  96       case op of
  97         "-" -> anyPkgconfigVersion <$ (P.string "any" *> P.spaces)
  98         "==" -> afterOp PcThisVersion
  99         ">" -> afterOp PcLaterVersion
 100         "<" -> afterOp PcEarlierVersion
 101         ">=" -> afterOp PcOrLaterVersion
 102         "<=" -> afterOp PcOrEarlierVersion
 103         _ -> P.unexpected $ "Unknown version operator " ++ show op
 104
 105     -- https://gitlab.haskell.org/ghc/ghc/issues/17752
 106     isOpChar '<' = True
 107     isOpChar '=' = True
 108     isOpChar '>' = True
 109     isOpChar '^' = True
 110     isOpChar '-' = True
 111     isOpChar _ = False
 112
 113     afterOp f = do
 114       P.spaces
 115       v <- parsec
 116       P.spaces
 117       return (f v)
 118
 119     parens =
 120       P.between
 121         ((P.char '(' P.<?> "opening paren") >> P.spaces)
 122         (P.char ')' >> P.spaces)
 123
 124 anyPkgconfigVersion :: PkgconfigVersionRange
 125 anyPkgconfigVersion = PcAnyVersion
 126
 127 -- | TODO: this is not precise, but used only to prettify output.
 128 isAnyPkgconfigVersion :: PkgconfigVersionRange -> Bool
 129 isAnyPkgconfigVersion = (== PcAnyVersion)
 130
 131 withinPkgconfigVersionRange :: PkgconfigVersion -> PkgconfigVersionRange -> Bool
 132 withinPkgconfigVersionRange v = go
 133   where
 134     go PcAnyVersion = True
 135     go (PcThisVersion u) = v == u
 136     go (PcLaterVersion u) = v > u
 137     go (PcEarlierVersion u) = v < u
 138     go (PcOrLaterVersion u) = v >= u
 139     go (PcOrEarlierVersion u) = v <= u
 140     go (PcUnionVersionRanges a b) = go a || go b
 141     go (PcIntersectVersionRanges a b) = go a && go b
 142
 143 -------------------------------------------------------------------------------
 144 -- Conversion
 145 -------------------------------------------------------------------------------
 146
 147 versionToPkgconfigVersion :: Version -> PkgconfigVersion
 148 versionToPkgconfigVersion = PkgconfigVersion . BS8.pack . prettyShow
 149
 150 versionRangeToPkgconfigVersionRange :: VersionRange -> PkgconfigVersionRange
 151 versionRangeToPkgconfigVersionRange vr
 152   | isAnyVersion vr =
 153       PcAnyVersion
 154   | otherwise =
 155       case asVersionIntervals vr of
 156         [] -> PcEarlierVersion (PkgconfigVersion (BS8.pack "0"))
 157         (i : is) -> foldl (\r j -> PcUnionVersionRanges r (conv j)) (conv i) is
 158   where
 159     conv (VersionInterval (LowerBound v b) NoUpperBound) = convL v b
 160     conv (VersionInterval (LowerBound v b) (UpperBound u c)) = PcIntersectVersionRanges (convL v b) (convU u c)
 161
 162     convL v ExclusiveBound = PcLaterVersion (versionToPkgconfigVersion v)
 163     convL v InclusiveBound = PcOrLaterVersion (versionToPkgconfigVersion v)
 164
 165     convU v ExclusiveBound = PcEarlierVersion (versionToPkgconfigVersion v)
 166     convU v InclusiveBound = PcOrEarlierVersion (versionToPkgconfigVersion v)