Cabal-syntax/src/Distribution/SPDX/LicenseExpression.hs

   1 {-# LANGUAGE DeriveDataTypeable #-}
   2 {-# LANGUAGE DeriveGeneric #-}
   3
   4 module Distribution.SPDX.LicenseExpression
   5   ( LicenseExpression (..)
   6   , SimpleLicenseExpression (..)
   7   , simpleLicenseExpression
   8   ) where
   9
  10 import Distribution.Compat.Prelude
  11 import Prelude ()
  12
  13 import Distribution.Parsec
  14 import Distribution.Pretty
  15 import Distribution.SPDX.LicenseExceptionId
  16 import Distribution.SPDX.LicenseId
  17 import Distribution.SPDX.LicenseListVersion
  18 import Distribution.SPDX.LicenseReference
  19 import Distribution.Utils.Generic (isAsciiAlphaNum)
  20
  21 import qualified Distribution.Compat.CharParsing as P
  22 import qualified Text.PrettyPrint as Disp
  23
  24 -- | SPDX License Expression.
  25 --
  26 -- @
  27 -- idstring              = 1*(ALPHA \/ DIGIT \/ "-" \/ "." )
  28 -- license id            = \<short form license identifier inAppendix I.1>
  29 -- license exception id  = \<short form license exception identifier inAppendix I.2>
  30 -- license ref           = [\"DocumentRef-"1*(idstring)":"]\"LicenseRef-"1*(idstring)
  31 --
  32 -- simple expression     = license id \/ license id"+" \/ license ref
  33 --
  34 -- compound expression   = 1*1(simple expression \/
  35 --                         simple expression \"WITH" license exception id \/
  36 --                         compound expression \"AND" compound expression \/
  37 --                         compound expression \"OR" compound expression ) \/
  38 --                         "(" compound expression ")" )
  39 --
  40 -- license expression    = 1*1(simple expression / compound expression)
  41 -- @
  42 data LicenseExpression
  43   = ELicense !SimpleLicenseExpression !(Maybe LicenseExceptionId)
  44   | EAnd !LicenseExpression !LicenseExpression
  45   | EOr !LicenseExpression !LicenseExpression
  46   deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
  47
  48 -- | Simple License Expressions.
  49 data SimpleLicenseExpression
  50   = -- | An SPDX License List Short Form Identifier. For example: @GPL-2.0-only@
  51     ELicenseId LicenseId
  52   | -- | An SPDX License List Short Form Identifier with a unary"+" operator suffix to represent the current version of the license or any later version.  For example: @GPL-2.0+@
  53     ELicenseIdPlus LicenseId
  54   | -- | A SPDX user defined license reference: For example: @LicenseRef-23@, @LicenseRef-MIT-Style-1@, or @DocumentRef-spdx-tool-1.2:LicenseRef-MIT-Style-2@
  55     ELicenseRef LicenseRef
  56   deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
  57
  58 simpleLicenseExpression :: LicenseId -> LicenseExpression
  59 simpleLicenseExpression i = ELicense (ELicenseId i) Nothing
  60
  61 instance Binary LicenseExpression
  62 instance Binary SimpleLicenseExpression
  63 instance Structured SimpleLicenseExpression
  64 instance Structured LicenseExpression
  65
  66 instance Pretty LicenseExpression where
  67   pretty = go 0
  68     where
  69       go :: Int -> LicenseExpression -> Disp.Doc
  70       go _ (ELicense lic exc) =
  71         let doc = pretty lic
  72          in maybe id (\e d -> d <+> Disp.text "WITH" <+> pretty e) exc doc
  73       go d (EAnd e1 e2) = parens (d < 0) $ go 0 e1 <+> Disp.text "AND" <+> go 0 e2
  74       go d (EOr e1 e2) = parens (d < 1) $ go 1 e1 <+> Disp.text "OR" <+> go 1 e2
  75
  76       parens False doc = doc
  77       parens True doc = Disp.parens doc
  78
  79 instance Pretty SimpleLicenseExpression where
  80   pretty (ELicenseId i) = pretty i
  81   pretty (ELicenseIdPlus i) = pretty i <<>> Disp.char '+'
  82   pretty (ELicenseRef r) = pretty r
  83
  84 instance Parsec SimpleLicenseExpression where
  85   parsec = idstring >>= simple
  86     where
  87       simple n
  88         | Just l <- "LicenseRef-" `isPrefixOfMaybe` n =
  89             maybe (fail $ "Incorrect LicenseRef format: " ++ n) (return . ELicenseRef) $ mkLicenseRef Nothing l
  90         | Just d <- "DocumentRef-" `isPrefixOfMaybe` n = do
  91             _ <- P.string ":LicenseRef-"
  92             l <- idstring
  93             maybe (fail $ "Incorrect LicenseRef format:" ++ n) (return . ELicenseRef) $ mkLicenseRef (Just d) l
  94         | otherwise = do
  95             v <- askCabalSpecVersion
  96             l <-
  97               maybe (fail $ "Unknown SPDX license identifier: '" ++ n ++ "' " ++ licenseIdMigrationMessage n) return $
  98                 mkLicenseId (cabalSpecVersionToSPDXListVersion v) n
  99             orLater <- isJust <$> P.optional (P.char '+')
 100             if orLater
 101               then return (ELicenseIdPlus l)
 102               else return (ELicenseId l)
 103
 104 idstring :: P.CharParsing m => m String
 105 idstring = P.munch1 $ \c -> isAsciiAlphaNum c || c == '-' || c == '.'
 106
 107 -- returns suffix part
 108 isPrefixOfMaybe :: Eq a => [a] -> [a] -> Maybe [a]
 109 isPrefixOfMaybe pfx s
 110   | pfx `isPrefixOf` s = Just (drop (length pfx) s)
 111   | otherwise = Nothing
 112
 113 instance Parsec LicenseExpression where
 114   parsec = expr
 115     where
 116       expr = compoundOr
 117
 118       simple = do
 119         s <- parsec
 120         exc <- exception
 121         return $ ELicense s exc
 122
 123       exception = P.optional $ P.try (spaces1 *> P.string "WITH" *> spaces1) *> parsec
 124
 125       compoundOr = do
 126         x <- compoundAnd
 127         l <- P.optional $ P.try (spaces1 *> P.string "OR" *> spaces1) *> compoundOr
 128         return $ maybe id (flip EOr) l x
 129
 130       compoundAnd = do
 131         x <- compound
 132         l <- P.optional $ P.try (spaces1 *> P.string "AND" *> spaces1) *> compoundAnd
 133         return $ maybe id (flip EAnd) l x
 134
 135       compound = braces <|> simple
 136
 137       -- NOTE: we require that there's a space around AND & OR operators,
 138       -- i.e. @(MIT)AND(MIT)@ will cause parse-error.
 139       braces = do
 140         _ <- P.char '('
 141         _ <- P.spaces
 142         x <- expr
 143         _ <- P.char ')'
 144         return x
 145
 146       spaces1 = P.space *> P.spaces
 147
 148 -- notes:
 149 --
 150 -- There MUST NOT be whitespace between a licenseid and any following "+".  This supports easy parsing and
 151 -- backwards compatibility.  There MUST be whitespace on either side of the operator "WITH".  There MUST be
 152 -- whitespace and/or parentheses on either side of the operators "AND" and "OR".
 153 --
 154 -- We handle that by having greedy 'idstring' parser, so MITAND would parse as invalid license identifier.
 155
 156 instance NFData LicenseExpression where
 157   rnf (ELicense s e) = rnf s `seq` rnf e
 158   rnf (EAnd x y) = rnf x `seq` rnf y
 159   rnf (EOr x y) = rnf x `seq` rnf y
 160
 161 instance NFData SimpleLicenseExpression where
 162   rnf (ELicenseId i) = rnf i
 163   rnf (ELicenseIdPlus i) = rnf i
 164   rnf (ELicenseRef r) = rnf r