1-- This file is generated. See Makefile's spdx rule
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveGeneric      #-}
4module Distribution.SPDX.LicenseExceptionId (
5    LicenseExceptionId (..),
6    licenseExceptionId,
7    licenseExceptionName,
8    mkLicenseExceptionId,
9    licenseExceptionIdList,
10    ) where
11
12import Distribution.Compat.Prelude
13import Prelude ()
14
15import Distribution.Compat.Lens (set)
16import Distribution.Pretty
17import Distribution.Parsec
18import Distribution.Utils.Generic (isAsciiAlphaNum)
19import Distribution.Utils.Structured (Structured (..), nominalStructure, typeVersion)
20import Distribution.SPDX.LicenseListVersion
21
22import qualified Data.Binary.Get as Binary
23import qualified Data.Binary.Put as Binary
24import qualified Data.Map.Strict as Map
25import qualified Distribution.Compat.CharParsing as P
26import qualified Text.PrettyPrint as Disp
27
28-------------------------------------------------------------------------------
29-- LicenseExceptionId
30-------------------------------------------------------------------------------
31
32-- | SPDX License identifier
33data LicenseExceptionId
34    = DS389_exception -- ^ @389-exception@, 389 Directory Server Exception
35    | Autoconf_exception_2_0 -- ^ @Autoconf-exception-2.0@, Autoconf exception 2.0
36    | Autoconf_exception_3_0 -- ^ @Autoconf-exception-3.0@, Autoconf exception 3.0
37    | Bison_exception_2_2 -- ^ @Bison-exception-2.2@, Bison exception 2.2
38    | Bootloader_exception -- ^ @Bootloader-exception@, Bootloader Distribution Exception
39    | Classpath_exception_2_0 -- ^ @Classpath-exception-2.0@, Classpath exception 2.0
40    | CLISP_exception_2_0 -- ^ @CLISP-exception-2.0@, CLISP exception 2.0
41    | DigiRule_FOSS_exception -- ^ @DigiRule-FOSS-exception@, DigiRule FOSS License Exception
42    | ECos_exception_2_0 -- ^ @eCos-exception-2.0@, eCos exception 2.0
43    | Fawkes_Runtime_exception -- ^ @Fawkes-Runtime-exception@, Fawkes Runtime Exception
44    | FLTK_exception -- ^ @FLTK-exception@, FLTK exception
45    | Font_exception_2_0 -- ^ @Font-exception-2.0@, Font exception 2.0
46    | Freertos_exception_2_0 -- ^ @freertos-exception-2.0@, FreeRTOS Exception 2.0
47    | GCC_exception_2_0 -- ^ @GCC-exception-2.0@, GCC Runtime Library exception 2.0
48    | GCC_exception_3_1 -- ^ @GCC-exception-3.1@, GCC Runtime Library exception 3.1
49    | Gnu_javamail_exception -- ^ @gnu-javamail-exception@, GNU JavaMail exception
50    | GPL_CC_1_0 -- ^ @GPL-CC-1.0@, GPL Cooperation Commitment 1.0, SPDX License List 3.6
51    | I2p_gpl_java_exception -- ^ @i2p-gpl-java-exception@, i2p GPL+Java Exception
52    | Libtool_exception -- ^ @Libtool-exception@, Libtool Exception
53    | Linux_syscall_note -- ^ @Linux-syscall-note@, Linux Syscall Note
54    | LLVM_exception -- ^ @LLVM-exception@, LLVM Exception, SPDX License List 3.2, SPDX License List 3.6
55    | LZMA_exception -- ^ @LZMA-exception@, LZMA exception
56    | Mif_exception -- ^ @mif-exception@, Macros and Inline Functions Exception
57    | Nokia_Qt_exception_1_1 -- ^ @Nokia-Qt-exception-1.1@, Nokia Qt LGPL exception 1.1, SPDX License List 3.0, SPDX License List 3.2
58    | OCaml_LGPL_linking_exception -- ^ @OCaml-LGPL-linking-exception@, OCaml LGPL Linking Exception, SPDX License List 3.6
59    | OCCT_exception_1_0 -- ^ @OCCT-exception-1.0@, Open CASCADE Exception 1.0
60    | OpenJDK_assembly_exception_1_0 -- ^ @OpenJDK-assembly-exception-1.0@, OpenJDK Assembly exception 1.0, SPDX License List 3.2, SPDX License List 3.6
61    | Openvpn_openssl_exception -- ^ @openvpn-openssl-exception@, OpenVPN OpenSSL Exception
62    | PS_or_PDF_font_exception_20170817 -- ^ @PS-or-PDF-font-exception-20170817@, PS/PDF font exception (2017-08-17), SPDX License List 3.2, SPDX License List 3.6
63    | Qt_GPL_exception_1_0 -- ^ @Qt-GPL-exception-1.0@, Qt GPL exception 1.0, SPDX License List 3.2, SPDX License List 3.6
64    | Qt_LGPL_exception_1_1 -- ^ @Qt-LGPL-exception-1.1@, Qt LGPL exception 1.1, SPDX License List 3.2, SPDX License List 3.6
65    | Qwt_exception_1_0 -- ^ @Qwt-exception-1.0@, Qwt exception 1.0
66    | Swift_exception -- ^ @Swift-exception@, Swift Exception, SPDX License List 3.6
67    | U_boot_exception_2_0 -- ^ @u-boot-exception-2.0@, U-Boot exception 2.0
68    | Universal_FOSS_exception_1_0 -- ^ @Universal-FOSS-exception-1.0@, Universal FOSS Exception, Version 1.0, SPDX License List 3.6
69    | WxWindows_exception_3_1 -- ^ @WxWindows-exception-3.1@, WxWindows Library Exception 3.1
70  deriving (Eq, Ord, Enum, Bounded, Show, Read, Typeable, Data, Generic)
71
72instance Binary LicenseExceptionId where
73    put = Binary.putWord8 . fromIntegral . fromEnum
74    get = do
75        i <- Binary.getWord8
76        if i > fromIntegral (fromEnum (maxBound :: LicenseExceptionId))
77        then fail "Too large LicenseExceptionId tag"
78        else return (toEnum (fromIntegral i))
79
80-- note: remember to bump version each time the definition changes
81instance Structured LicenseExceptionId where
82    structure p = set typeVersion 306 $ nominalStructure p
83
84instance Pretty LicenseExceptionId where
85    pretty = Disp.text . licenseExceptionId
86
87instance Parsec LicenseExceptionId where
88    parsec = do
89        n <- some $ P.satisfy $ \c -> isAsciiAlphaNum c || c == '-' || c == '.'
90        v <- askCabalSpecVersion
91        maybe (fail $ "Unknown SPDX license exception identifier: " ++ n) return $
92            mkLicenseExceptionId (cabalSpecVersionToSPDXListVersion v) n
93
94instance NFData LicenseExceptionId where
95    rnf l = l `seq` ()
96
97-------------------------------------------------------------------------------
98-- License Data
99-------------------------------------------------------------------------------
100
101-- | License SPDX identifier, e.g. @"BSD-3-Clause"@.
102licenseExceptionId :: LicenseExceptionId -> String
103licenseExceptionId DS389_exception = "389-exception"
104licenseExceptionId Autoconf_exception_2_0 = "Autoconf-exception-2.0"
105licenseExceptionId Autoconf_exception_3_0 = "Autoconf-exception-3.0"
106licenseExceptionId Bison_exception_2_2 = "Bison-exception-2.2"
107licenseExceptionId Bootloader_exception = "Bootloader-exception"
108licenseExceptionId Classpath_exception_2_0 = "Classpath-exception-2.0"
109licenseExceptionId CLISP_exception_2_0 = "CLISP-exception-2.0"
110licenseExceptionId DigiRule_FOSS_exception = "DigiRule-FOSS-exception"
111licenseExceptionId ECos_exception_2_0 = "eCos-exception-2.0"
112licenseExceptionId Fawkes_Runtime_exception = "Fawkes-Runtime-exception"
113licenseExceptionId FLTK_exception = "FLTK-exception"
114licenseExceptionId Font_exception_2_0 = "Font-exception-2.0"
115licenseExceptionId Freertos_exception_2_0 = "freertos-exception-2.0"
116licenseExceptionId GCC_exception_2_0 = "GCC-exception-2.0"
117licenseExceptionId GCC_exception_3_1 = "GCC-exception-3.1"
118licenseExceptionId Gnu_javamail_exception = "gnu-javamail-exception"
119licenseExceptionId GPL_CC_1_0 = "GPL-CC-1.0"
120licenseExceptionId I2p_gpl_java_exception = "i2p-gpl-java-exception"
121licenseExceptionId Libtool_exception = "Libtool-exception"
122licenseExceptionId Linux_syscall_note = "Linux-syscall-note"
123licenseExceptionId LLVM_exception = "LLVM-exception"
124licenseExceptionId LZMA_exception = "LZMA-exception"
125licenseExceptionId Mif_exception = "mif-exception"
126licenseExceptionId Nokia_Qt_exception_1_1 = "Nokia-Qt-exception-1.1"
127licenseExceptionId OCaml_LGPL_linking_exception = "OCaml-LGPL-linking-exception"
128licenseExceptionId OCCT_exception_1_0 = "OCCT-exception-1.0"
129licenseExceptionId OpenJDK_assembly_exception_1_0 = "OpenJDK-assembly-exception-1.0"
130licenseExceptionId Openvpn_openssl_exception = "openvpn-openssl-exception"
131licenseExceptionId PS_or_PDF_font_exception_20170817 = "PS-or-PDF-font-exception-20170817"
132licenseExceptionId Qt_GPL_exception_1_0 = "Qt-GPL-exception-1.0"
133licenseExceptionId Qt_LGPL_exception_1_1 = "Qt-LGPL-exception-1.1"
134licenseExceptionId Qwt_exception_1_0 = "Qwt-exception-1.0"
135licenseExceptionId Swift_exception = "Swift-exception"
136licenseExceptionId U_boot_exception_2_0 = "u-boot-exception-2.0"
137licenseExceptionId Universal_FOSS_exception_1_0 = "Universal-FOSS-exception-1.0"
138licenseExceptionId WxWindows_exception_3_1 = "WxWindows-exception-3.1"
139
140-- | License name, e.g. @"GNU General Public License v2.0 only"@
141licenseExceptionName :: LicenseExceptionId -> String
142licenseExceptionName DS389_exception = "389 Directory Server Exception"
143licenseExceptionName Autoconf_exception_2_0 = "Autoconf exception 2.0"
144licenseExceptionName Autoconf_exception_3_0 = "Autoconf exception 3.0"
145licenseExceptionName Bison_exception_2_2 = "Bison exception 2.2"
146licenseExceptionName Bootloader_exception = "Bootloader Distribution Exception"
147licenseExceptionName Classpath_exception_2_0 = "Classpath exception 2.0"
148licenseExceptionName CLISP_exception_2_0 = "CLISP exception 2.0"
149licenseExceptionName DigiRule_FOSS_exception = "DigiRule FOSS License Exception"
150licenseExceptionName ECos_exception_2_0 = "eCos exception 2.0"
151licenseExceptionName Fawkes_Runtime_exception = "Fawkes Runtime Exception"
152licenseExceptionName FLTK_exception = "FLTK exception"
153licenseExceptionName Font_exception_2_0 = "Font exception 2.0"
154licenseExceptionName Freertos_exception_2_0 = "FreeRTOS Exception 2.0"
155licenseExceptionName GCC_exception_2_0 = "GCC Runtime Library exception 2.0"
156licenseExceptionName GCC_exception_3_1 = "GCC Runtime Library exception 3.1"
157licenseExceptionName Gnu_javamail_exception = "GNU JavaMail exception"
158licenseExceptionName GPL_CC_1_0 = "GPL Cooperation Commitment 1.0"
159licenseExceptionName I2p_gpl_java_exception = "i2p GPL+Java Exception"
160licenseExceptionName Libtool_exception = "Libtool Exception"
161licenseExceptionName Linux_syscall_note = "Linux Syscall Note"
162licenseExceptionName LLVM_exception = "LLVM Exception"
163licenseExceptionName LZMA_exception = "LZMA exception"
164licenseExceptionName Mif_exception = "Macros and Inline Functions Exception"
165licenseExceptionName Nokia_Qt_exception_1_1 = "Nokia Qt LGPL exception 1.1"
166licenseExceptionName OCaml_LGPL_linking_exception = "OCaml LGPL Linking Exception"
167licenseExceptionName OCCT_exception_1_0 = "Open CASCADE Exception 1.0"
168licenseExceptionName OpenJDK_assembly_exception_1_0 = "OpenJDK Assembly exception 1.0"
169licenseExceptionName Openvpn_openssl_exception = "OpenVPN OpenSSL Exception"
170licenseExceptionName PS_or_PDF_font_exception_20170817 = "PS/PDF font exception (2017-08-17)"
171licenseExceptionName Qt_GPL_exception_1_0 = "Qt GPL exception 1.0"
172licenseExceptionName Qt_LGPL_exception_1_1 = "Qt LGPL exception 1.1"
173licenseExceptionName Qwt_exception_1_0 = "Qwt exception 1.0"
174licenseExceptionName Swift_exception = "Swift Exception"
175licenseExceptionName U_boot_exception_2_0 = "U-Boot exception 2.0"
176licenseExceptionName Universal_FOSS_exception_1_0 = "Universal FOSS Exception, Version 1.0"
177licenseExceptionName WxWindows_exception_3_1 = "WxWindows Library Exception 3.1"
178
179-------------------------------------------------------------------------------
180-- Creation
181-------------------------------------------------------------------------------
182
183licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId]
184licenseExceptionIdList LicenseListVersion_3_0 =
185    [ Nokia_Qt_exception_1_1
186    ]
187    ++ bulkOfLicenses
188licenseExceptionIdList LicenseListVersion_3_2 =
189    [ LLVM_exception
190    , Nokia_Qt_exception_1_1
191    , OpenJDK_assembly_exception_1_0
192    , PS_or_PDF_font_exception_20170817
193    , Qt_GPL_exception_1_0
194    , Qt_LGPL_exception_1_1
195    ]
196    ++ bulkOfLicenses
197licenseExceptionIdList LicenseListVersion_3_6 =
198    [ GPL_CC_1_0
199    , LLVM_exception
200    , OCaml_LGPL_linking_exception
201    , OpenJDK_assembly_exception_1_0
202    , PS_or_PDF_font_exception_20170817
203    , Qt_GPL_exception_1_0
204    , Qt_LGPL_exception_1_1
205    , Swift_exception
206    , Universal_FOSS_exception_1_0
207    ]
208    ++ bulkOfLicenses
209
210-- | Create a 'LicenseExceptionId' from a 'String'.
211mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId
212mkLicenseExceptionId LicenseListVersion_3_0 s = Map.lookup s stringLookup_3_0
213mkLicenseExceptionId LicenseListVersion_3_2 s = Map.lookup s stringLookup_3_2
214mkLicenseExceptionId LicenseListVersion_3_6 s = Map.lookup s stringLookup_3_6
215
216stringLookup_3_0 :: Map String LicenseExceptionId
217stringLookup_3_0 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $
218    licenseExceptionIdList LicenseListVersion_3_0
219
220stringLookup_3_2 :: Map String LicenseExceptionId
221stringLookup_3_2 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $
222    licenseExceptionIdList LicenseListVersion_3_2
223
224stringLookup_3_6 :: Map String LicenseExceptionId
225stringLookup_3_6 = Map.fromList $ map (\i -> (licenseExceptionId i, i)) $
226    licenseExceptionIdList LicenseListVersion_3_6
227
228--  | License exceptions in all SPDX License lists
229bulkOfLicenses :: [LicenseExceptionId]
230bulkOfLicenses =
231    [ DS389_exception
232    , Autoconf_exception_2_0
233    , Autoconf_exception_3_0
234    , Bison_exception_2_2
235    , Bootloader_exception
236    , Classpath_exception_2_0
237    , CLISP_exception_2_0
238    , DigiRule_FOSS_exception
239    , ECos_exception_2_0
240    , Fawkes_Runtime_exception
241    , FLTK_exception
242    , Font_exception_2_0
243    , Freertos_exception_2_0
244    , GCC_exception_2_0
245    , GCC_exception_3_1
246    , Gnu_javamail_exception
247    , I2p_gpl_java_exception
248    , Libtool_exception
249    , Linux_syscall_note
250    , LZMA_exception
251    , Mif_exception
252    , OCCT_exception_1_0
253    , Openvpn_openssl_exception
254    , Qwt_exception_1_0
255    , U_boot_exception_2_0
256    , WxWindows_exception_3_1
257    ]
258