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