1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric #-}
3module Distribution.SPDX.License (
4    License (..),
5    ) where
6
7import Prelude ()
8import Distribution.Compat.Prelude
9
10import Distribution.Pretty
11import Distribution.Parsec
12import Distribution.SPDX.LicenseExpression
13
14import qualified Distribution.Compat.CharParsing as P
15import qualified Text.PrettyPrint as Disp
16
17-- | Declared license.
18-- See [section 3.15 of SPDX Specification 2.1](https://spdx.org/spdx-specification-21-web-version#h.1hmsyys)
19--
20-- /Note:/ the NOASSERTION case is omitted.
21--
22-- Old 'License' can be migrated using following rules:
23--
24-- * @AllRightsReserved@ and @UnspecifiedLicense@ to 'NONE'.
25--   No license specified which legally defaults to /All Rights Reserved/.
26--   The package may not be legally modified or redistributed by anyone but
27--   the rightsholder.
28--
29-- * @OtherLicense@ can be converted to 'LicenseRef' pointing to the file
30--   in the package.
31--
32-- * @UnknownLicense@ i.e. other licenses of the form @name-x.y@, should be
33--   covered by SPDX license list, otherwise use 'LicenseRef'.
34--
35-- * @PublicDomain@ isn't covered. Consider using CC0.
36--   See <https://wiki.spdx.org/view/Legal_Team/Decisions/Dealing_with_Public_Domain_within_SPDX_Files>
37--   for more information.
38--
39data License
40    = NONE
41      -- ^ if the package contains no license information whatsoever; or
42    | License LicenseExpression
43      -- ^ A valid SPDX License Expression as defined in Appendix IV.
44  deriving (Show, Read, Eq, Ord, Typeable, Data, Generic)
45
46instance Binary License
47instance Structured License
48
49instance NFData License where
50    rnf NONE        = ()
51    rnf (License l) = rnf l
52
53instance Pretty License where
54    pretty NONE        = Disp.text "NONE"
55    pretty (License l) = pretty l
56
57-- |
58-- >>> eitherParsec "BSD-3-Clause AND MIT" :: Either String License
59-- Right (License (EAnd (ELicense (ELicenseId BSD_3_Clause) Nothing) (ELicense (ELicenseId MIT) Nothing)))
60--
61-- >>> eitherParsec "NONE" :: Either String License
62-- Right NONE
63--
64instance Parsec License where
65    parsec = NONE <$ P.try (P.string "NONE") <|> License <$> parsec
66