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