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 license­id 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