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
63instance Structured SimpleLicenseExpression
64instance Structured LicenseExpression
65
66instance 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
77        parens False doc = doc
78        parens True  doc = Disp.parens doc
79
80instance Pretty SimpleLicenseExpression where
81    pretty (ELicenseId i)     = pretty i
82    pretty (ELicenseIdPlus i) = pretty i <<>> Disp.char '+'
83    pretty (ELicenseRef r)    = pretty r
84
85instance Parsec SimpleLicenseExpression where
86    parsec = idstring >>= simple 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 <- maybe (fail $ "Unknown SPDX license identifier: '" ++  n ++ "' " ++ licenseIdMigrationMessage n) return $
97                    mkLicenseId (cabalSpecVersionToSPDXListVersion v) n
98                orLater <- isJust <$> P.optional (P.char '+')
99                if orLater
100                then return (ELicenseIdPlus l)
101                else return (ELicenseId l)
102
103idstring :: P.CharParsing m => m String
104idstring = P.munch1 $ \c -> isAsciiAlphaNum c || c == '-' || c == '.'
105
106-- returns suffix part
107isPrefixOfMaybe :: Eq a => [a] -> [a] -> Maybe [a]
108isPrefixOfMaybe pfx s
109    | pfx `isPrefixOf` s = Just (drop (length pfx) s)
110    | otherwise          = Nothing
111
112instance Parsec LicenseExpression where
113    parsec = expr
114      where
115        expr = compoundOr
116
117        simple = do
118            s <- parsec
119            exc <- exception
120            return $ ELicense s exc
121
122        exception = P.optional $ P.try (spaces1 *> P.string "WITH" *> spaces1) *> parsec
123
124        compoundOr = do
125            x <- compoundAnd
126            l <- P.optional $ P.try (spaces1 *> P.string "OR" *> spaces1) *> compoundOr
127            return $ maybe id (flip EOr) l x
128
129        compoundAnd = do
130            x <- compound
131            l <- P.optional $ P.try (spaces1 *> P.string "AND" *> spaces1) *> compoundAnd
132            return $ maybe id (flip EAnd) l x
133
134        compound = braces <|> simple
135
136        -- NOTE: we require that there's a space around AND & OR operators,
137        -- i.e. @(MIT)AND(MIT)@ will cause parse-error.
138        braces = do
139            _ <- P.char '('
140            _ <- P.spaces
141            x <- expr
142            _ <- P.char ')'
143            return x
144
145        spaces1 = P.space *> P.spaces
146
147-- notes:
148--
149-- There MUST NOT be whitespace between a license­id and any following "+".  This supports easy parsing and
150-- backwards compatibility.  There MUST be whitespace on either side of the operator "WITH".  There MUST be
151-- whitespace and/or parentheses on either side of the operators "AND" and "OR".
152--
153-- We handle that by having greedy 'idstring' parser, so MITAND would parse as invalid license identifier.
154
155instance NFData LicenseExpression where
156    rnf (ELicense s e) = rnf s `seq` rnf e
157    rnf (EAnd x y)     = rnf x `seq` rnf y
158    rnf (EOr x y)      = rnf x `seq` rnf y
159
160instance NFData SimpleLicenseExpression where
161    rnf (ELicenseId i)     = rnf i
162    rnf (ELicenseIdPlus i) = rnf i
163    rnf (ELicenseRef r)    = rnf r
164