-- This file is generated. See Makefile's spdx rule
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
module Distribution.SPDX.LicenseExceptionId (
    LicenseExceptionId (..),
    licenseExceptionId,
    licenseExceptionName,
    mkLicenseExceptionId,
    licenseExceptionIdList,
    ) where

import Distribution.Compat.Prelude
import Prelude ()

import Distribution.Compat.Lens (set)
import Distribution.Pretty
import Distribution.Parsec
import Distribution.Utils.Generic (isAsciiAlphaNum)
import Distribution.Utils.Structured (Structured (..), nominalStructure, typeVersion)
import Distribution.SPDX.LicenseListVersion

import qualified Data.Binary.Get as Binary
import qualified Data.Binary.Put as Binary
import qualified Data.Map.Strict as Map
import qualified Distribution.Compat.CharParsing as P
import qualified Text.PrettyPrint as Disp

-------------------------------------------------------------------------------
-- LicenseExceptionId
-------------------------------------------------------------------------------

-- | SPDX License identifier
data LicenseExceptionId
    = DS389_exception -- ^ @389-exception@, 389 Directory Server Exception
    | Autoconf_exception_2_0 -- ^ @Autoconf-exception-2.0@, Autoconf exception 2.0
    | Autoconf_exception_3_0 -- ^ @Autoconf-exception-3.0@, Autoconf exception 3.0
    | Bison_exception_2_2 -- ^ @Bison-exception-2.2@, Bison exception 2.2
    | Bootloader_exception -- ^ @Bootloader-exception@, Bootloader Distribution Exception
    | Classpath_exception_2_0 -- ^ @Classpath-exception-2.0@, Classpath exception 2.0
    | CLISP_exception_2_0 -- ^ @CLISP-exception-2.0@, CLISP exception 2.0
    | DigiRule_FOSS_exception -- ^ @DigiRule-FOSS-exception@, DigiRule FOSS License Exception
    | ECos_exception_2_0 -- ^ @eCos-exception-2.0@, eCos exception 2.0
    | Fawkes_Runtime_exception -- ^ @Fawkes-Runtime-exception@, Fawkes Runtime Exception
    | FLTK_exception -- ^ @FLTK-exception@, FLTK exception
    | Font_exception_2_0 -- ^ @Font-exception-2.0@, Font exception 2.0
    | Freertos_exception_2_0 -- ^ @freertos-exception-2.0@, FreeRTOS Exception 2.0
    | GCC_exception_2_0 -- ^ @GCC-exception-2.0@, GCC Runtime Library exception 2.0
    | GCC_exception_3_1 -- ^ @GCC-exception-3.1@, GCC Runtime Library exception 3.1
    | Gnu_javamail_exception -- ^ @gnu-javamail-exception@, GNU JavaMail exception
    | GPL_CC_1_0 -- ^ @GPL-CC-1.0@, GPL Cooperation Commitment 1.0, SPDX License List 3.6
    | I2p_gpl_java_exception -- ^ @i2p-gpl-java-exception@, i2p GPL+Java Exception
    | Libtool_exception -- ^ @Libtool-exception@, Libtool Exception
    | Linux_syscall_note -- ^ @Linux-syscall-note@, Linux Syscall Note
    | LLVM_exception -- ^ @LLVM-exception@, LLVM Exception, SPDX License List 3.2, SPDX License List 3.6
    | LZMA_exception -- ^ @LZMA-exception@, LZMA exception
    | Mif_exception -- ^ @mif-exception@, Macros and Inline Functions Exception
    | 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
    | OCaml_LGPL_linking_exception -- ^ @OCaml-LGPL-linking-exception@, OCaml LGPL Linking Exception, SPDX License List 3.6
    | OCCT_exception_1_0 -- ^ @OCCT-exception-1.0@, Open CASCADE Exception 1.0
    | 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
    | Openvpn_openssl_exception -- ^ @openvpn-openssl-exception@, OpenVPN OpenSSL Exception
    | 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
    | 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
    | 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
    | Qwt_exception_1_0 -- ^ @Qwt-exception-1.0@, Qwt exception 1.0
    | Swift_exception -- ^ @Swift-exception@, Swift Exception, SPDX License List 3.6
    | U_boot_exception_2_0 -- ^ @u-boot-exception-2.0@, U-Boot exception 2.0
    | Universal_FOSS_exception_1_0 -- ^ @Universal-FOSS-exception-1.0@, Universal FOSS Exception, Version 1.0, SPDX License List 3.6
    | WxWindows_exception_3_1 -- ^ @WxWindows-exception-3.1@, WxWindows Library Exception 3.1
  deriving (LicenseExceptionId -> LicenseExceptionId -> Bool
(LicenseExceptionId -> LicenseExceptionId -> Bool)
-> (LicenseExceptionId -> LicenseExceptionId -> Bool)
-> Eq LicenseExceptionId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LicenseExceptionId -> LicenseExceptionId -> Bool
$c/= :: LicenseExceptionId -> LicenseExceptionId -> Bool
== :: LicenseExceptionId -> LicenseExceptionId -> Bool
$c== :: LicenseExceptionId -> LicenseExceptionId -> Bool
Eq, Eq LicenseExceptionId
Eq LicenseExceptionId
-> (LicenseExceptionId -> LicenseExceptionId -> Ordering)
-> (LicenseExceptionId -> LicenseExceptionId -> Bool)
-> (LicenseExceptionId -> LicenseExceptionId -> Bool)
-> (LicenseExceptionId -> LicenseExceptionId -> Bool)
-> (LicenseExceptionId -> LicenseExceptionId -> Bool)
-> (LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId)
-> (LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId)
-> Ord LicenseExceptionId
LicenseExceptionId -> LicenseExceptionId -> Bool
LicenseExceptionId -> LicenseExceptionId -> Ordering
LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId
$cmin :: LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId
max :: LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId
$cmax :: LicenseExceptionId -> LicenseExceptionId -> LicenseExceptionId
>= :: LicenseExceptionId -> LicenseExceptionId -> Bool
$c>= :: LicenseExceptionId -> LicenseExceptionId -> Bool
> :: LicenseExceptionId -> LicenseExceptionId -> Bool
$c> :: LicenseExceptionId -> LicenseExceptionId -> Bool
<= :: LicenseExceptionId -> LicenseExceptionId -> Bool
$c<= :: LicenseExceptionId -> LicenseExceptionId -> Bool
< :: LicenseExceptionId -> LicenseExceptionId -> Bool
$c< :: LicenseExceptionId -> LicenseExceptionId -> Bool
compare :: LicenseExceptionId -> LicenseExceptionId -> Ordering
$ccompare :: LicenseExceptionId -> LicenseExceptionId -> Ordering
Instance of class: Eq of the constraint type Eq LicenseExceptionId
Instance of class: Ord of the constraint type Ord LicenseExceptionId
Instance of class: Eq of the constraint type Eq LicenseExceptionId
Ord, Int -> LicenseExceptionId
LicenseExceptionId -> Int
LicenseExceptionId -> [LicenseExceptionId]
LicenseExceptionId -> LicenseExceptionId
LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
LicenseExceptionId
-> LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
(LicenseExceptionId -> LicenseExceptionId)
-> (LicenseExceptionId -> LicenseExceptionId)
-> (Int -> LicenseExceptionId)
-> (LicenseExceptionId -> Int)
-> (LicenseExceptionId -> [LicenseExceptionId])
-> (LicenseExceptionId
    -> LicenseExceptionId -> [LicenseExceptionId])
-> (LicenseExceptionId
    -> LicenseExceptionId -> [LicenseExceptionId])
-> (LicenseExceptionId
    -> LicenseExceptionId
    -> LicenseExceptionId
    -> [LicenseExceptionId])
-> Enum LicenseExceptionId
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LicenseExceptionId
-> LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
$cenumFromThenTo :: LicenseExceptionId
-> LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
enumFromTo :: LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
$cenumFromTo :: LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
enumFromThen :: LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
$cenumFromThen :: LicenseExceptionId -> LicenseExceptionId -> [LicenseExceptionId]
enumFrom :: LicenseExceptionId -> [LicenseExceptionId]
$cenumFrom :: LicenseExceptionId -> [LicenseExceptionId]
fromEnum :: LicenseExceptionId -> Int
$cfromEnum :: LicenseExceptionId -> Int
toEnum :: Int -> LicenseExceptionId
$ctoEnum :: Int -> LicenseExceptionId
pred :: LicenseExceptionId -> LicenseExceptionId
$cpred :: LicenseExceptionId -> LicenseExceptionId
succ :: LicenseExceptionId -> LicenseExceptionId
$csucc :: LicenseExceptionId -> LicenseExceptionId
External instance of the constraint type Enum Int
External instance of the constraint type Show Int
External instance of the constraint type Show Int
External instance of the constraint type Ord Int
External instance of the constraint type Ord Int
External instance of the constraint type Num Int
External instance of the constraint type Eq Int
Enum, LicenseExceptionId
LicenseExceptionId
-> LicenseExceptionId -> Bounded LicenseExceptionId
forall a. a -> a -> Bounded a
maxBound :: LicenseExceptionId
$cmaxBound :: LicenseExceptionId
minBound :: LicenseExceptionId
$cminBound :: LicenseExceptionId
Bounded, Int -> LicenseExceptionId -> ShowS
[LicenseExceptionId] -> ShowS
LicenseExceptionId -> String
(Int -> LicenseExceptionId -> ShowS)
-> (LicenseExceptionId -> String)
-> ([LicenseExceptionId] -> ShowS)
-> Show LicenseExceptionId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LicenseExceptionId] -> ShowS
$cshowList :: [LicenseExceptionId] -> ShowS
show :: LicenseExceptionId -> String
$cshow :: LicenseExceptionId -> String
showsPrec :: Int -> LicenseExceptionId -> ShowS
$cshowsPrec :: Int -> LicenseExceptionId -> ShowS
Show, ReadPrec [LicenseExceptionId]
ReadPrec LicenseExceptionId
Int -> ReadS LicenseExceptionId
ReadS [LicenseExceptionId]
(Int -> ReadS LicenseExceptionId)
-> ReadS [LicenseExceptionId]
-> ReadPrec LicenseExceptionId
-> ReadPrec [LicenseExceptionId]
-> Read LicenseExceptionId
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LicenseExceptionId]
$creadListPrec :: ReadPrec [LicenseExceptionId]
readPrec :: ReadPrec LicenseExceptionId
$creadPrec :: ReadPrec LicenseExceptionId
readList :: ReadS [LicenseExceptionId]
$creadList :: ReadS [LicenseExceptionId]
readsPrec :: Int -> ReadS LicenseExceptionId
$creadsPrec :: Int -> ReadS LicenseExceptionId
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read LicenseExceptionId
Read, Typeable, Typeable LicenseExceptionId
DataType
Constr
Typeable LicenseExceptionId
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> LicenseExceptionId
    -> c LicenseExceptionId)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c LicenseExceptionId)
-> (LicenseExceptionId -> Constr)
-> (LicenseExceptionId -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c LicenseExceptionId))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c LicenseExceptionId))
-> ((forall b. Data b => b -> b)
    -> LicenseExceptionId -> LicenseExceptionId)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> LicenseExceptionId -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> LicenseExceptionId -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> LicenseExceptionId -> m LicenseExceptionId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LicenseExceptionId -> m LicenseExceptionId)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> LicenseExceptionId -> m LicenseExceptionId)
-> Data LicenseExceptionId
LicenseExceptionId -> DataType
LicenseExceptionId -> Constr
(forall b. Data b => b -> b)
-> LicenseExceptionId -> LicenseExceptionId
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LicenseExceptionId
-> c LicenseExceptionId
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LicenseExceptionId
forall a.
Typeable a
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u.
Int -> (forall d. Data d => d -> u) -> LicenseExceptionId -> u
forall u. (forall d. Data d => d -> u) -> LicenseExceptionId -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LicenseExceptionId
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LicenseExceptionId
-> c LicenseExceptionId
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LicenseExceptionId)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LicenseExceptionId)
$cWxWindows_exception_3_1 :: Constr
$cUniversal_FOSS_exception_1_0 :: Constr
$cU_boot_exception_2_0 :: Constr
$cSwift_exception :: Constr
$cQwt_exception_1_0 :: Constr
$cQt_LGPL_exception_1_1 :: Constr
$cQt_GPL_exception_1_0 :: Constr
$cPS_or_PDF_font_exception_20170817 :: Constr
$cOpenvpn_openssl_exception :: Constr
$cOpenJDK_assembly_exception_1_0 :: Constr
$cOCCT_exception_1_0 :: Constr
$cOCaml_LGPL_linking_exception :: Constr
$cNokia_Qt_exception_1_1 :: Constr
$cMif_exception :: Constr
$cLZMA_exception :: Constr
$cLLVM_exception :: Constr
$cLinux_syscall_note :: Constr
$cLibtool_exception :: Constr
$cI2p_gpl_java_exception :: Constr
$cGPL_CC_1_0 :: Constr
$cGnu_javamail_exception :: Constr
$cGCC_exception_3_1 :: Constr
$cGCC_exception_2_0 :: Constr
$cFreertos_exception_2_0 :: Constr
$cFont_exception_2_0 :: Constr
$cFLTK_exception :: Constr
$cFawkes_Runtime_exception :: Constr
$cECos_exception_2_0 :: Constr
$cDigiRule_FOSS_exception :: Constr
$cCLISP_exception_2_0 :: Constr
$cClasspath_exception_2_0 :: Constr
$cBootloader_exception :: Constr
$cBison_exception_2_2 :: Constr
$cAutoconf_exception_3_0 :: Constr
$cAutoconf_exception_2_0 :: Constr
$cDS389_exception :: Constr
$tLicenseExceptionId :: DataType
gmapMo :: (forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
gmapMp :: (forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
gmapM :: (forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> LicenseExceptionId -> m LicenseExceptionId
gmapQi :: Int -> (forall d. Data d => d -> u) -> LicenseExceptionId -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> LicenseExceptionId -> u
gmapQ :: (forall d. Data d => d -> u) -> LicenseExceptionId -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> LicenseExceptionId -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> LicenseExceptionId -> r
gmapT :: (forall b. Data b => b -> b)
-> LicenseExceptionId -> LicenseExceptionId
$cgmapT :: (forall b. Data b => b -> b)
-> LicenseExceptionId -> LicenseExceptionId
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LicenseExceptionId)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c LicenseExceptionId)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c LicenseExceptionId)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c LicenseExceptionId)
dataTypeOf :: LicenseExceptionId -> DataType
$cdataTypeOf :: LicenseExceptionId -> DataType
toConstr :: LicenseExceptionId -> Constr
$ctoConstr :: LicenseExceptionId -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LicenseExceptionId
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c LicenseExceptionId
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LicenseExceptionId
-> c LicenseExceptionId
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g)
-> LicenseExceptionId
-> c LicenseExceptionId
Data, (forall x. LicenseExceptionId -> Rep LicenseExceptionId x)
-> (forall x. Rep LicenseExceptionId x -> LicenseExceptionId)
-> Generic LicenseExceptionId
forall x. Rep LicenseExceptionId x -> LicenseExceptionId
forall x. LicenseExceptionId -> Rep LicenseExceptionId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LicenseExceptionId x -> LicenseExceptionId
$cfrom :: forall x. LicenseExceptionId -> Rep LicenseExceptionId x
Generic)

instance Binary LicenseExceptionId where
    put :: LicenseExceptionId -> Put
put = Word8 -> Put
Binary.putWord8 (Word8 -> Put)
-> (LicenseExceptionId -> Word8) -> LicenseExceptionId -> Put
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral (Int -> Word8)
-> (LicenseExceptionId -> Int) -> LicenseExceptionId -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LicenseExceptionId -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum LicenseExceptionId
fromEnum
    get :: Get LicenseExceptionId
get = do
        Word8
i <- Get Word8
Binary.getWord8
        if Word8
i Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
External instance of the constraint type Ord Word8
> Int -> Word8
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Word8
External instance of the constraint type Integral Int
fromIntegral (LicenseExceptionId -> Int
forall a. Enum a => a -> Int
Instance of class: Enum of the constraint type Enum LicenseExceptionId
fromEnum (LicenseExceptionId
forall a. Bounded a => a
Instance of class: Bounded of the constraint type Bounded LicenseExceptionId
maxBound :: LicenseExceptionId))
        then String -> Get LicenseExceptionId
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type MonadFail Get
fail String
"Too large LicenseExceptionId tag"
        else LicenseExceptionId -> Get LicenseExceptionId
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad Get
return (Int -> LicenseExceptionId
forall a. Enum a => Int -> a
Instance of class: Enum of the constraint type Enum LicenseExceptionId
toEnum (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
External instance of the constraint type Num Int
External instance of the constraint type Integral Word8
fromIntegral Word8
i))

-- note: remember to bump version each time the definition changes
instance Structured LicenseExceptionId where
    structure :: Proxy LicenseExceptionId -> Structure
structure Proxy LicenseExceptionId
p = ASetter Structure Structure TypeVersion TypeVersion
-> TypeVersion -> Structure -> Structure
forall s t a b. ASetter s t a b -> b -> s -> t
set ASetter Structure Structure TypeVersion TypeVersion
forall (f :: * -> *).
Functor f =>
(TypeVersion -> f TypeVersion) -> Structure -> f Structure
External instance of the constraint type Functor Identity
typeVersion TypeVersion
306 (Structure -> Structure) -> Structure -> Structure
forall a b. (a -> b) -> a -> b
$ Proxy LicenseExceptionId -> Structure
forall {k} (a :: k). Typeable a => Proxy a -> Structure
nominalStructure Proxy LicenseExceptionId
p

instance Pretty LicenseExceptionId where
    pretty :: LicenseExceptionId -> Doc
pretty = String -> Doc
Disp.text (String -> Doc)
-> (LicenseExceptionId -> String) -> LicenseExceptionId -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LicenseExceptionId -> String
licenseExceptionId

instance Parsec LicenseExceptionId where
    parsec :: m LicenseExceptionId
parsec = do
        String
n <- m Char -> m String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
External instance of the constraint type forall (m :: * -> *). Parsing m => Alternative m
External instance of the constraint type forall (m :: * -> *). CharParsing m => Parsing m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
some (m Char -> m String) -> m Char -> m String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> m Char
forall (m :: * -> *). CharParsing m => (Char -> Bool) -> m Char
External instance of the constraint type forall (m :: * -> *). CabalParsing m => CharParsing m
Evidence bound by a type signature of the constraint type CabalParsing m
P.satisfy ((Char -> Bool) -> m Char) -> (Char -> Bool) -> m Char
forall a b. (a -> b) -> a -> b
$ \Char
c -> Char -> Bool
isAsciiAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
External instance of the constraint type Eq Char
== Char
'.'
        CabalSpecVersion
v <- m CabalSpecVersion
forall (m :: * -> *). CabalParsing m => m CabalSpecVersion
Evidence bound by a type signature of the constraint type CabalParsing m
askCabalSpecVersion
        m LicenseExceptionId
-> (LicenseExceptionId -> m LicenseExceptionId)
-> Maybe LicenseExceptionId
-> m LicenseExceptionId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> m LicenseExceptionId
forall (m :: * -> *) a. MonadFail m => String -> m a
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadFail m
Evidence bound by a type signature of the constraint type CabalParsing m
fail (String -> m LicenseExceptionId) -> String -> m LicenseExceptionId
forall a b. (a -> b) -> a -> b
$ String
"Unknown SPDX license exception identifier: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
n) LicenseExceptionId -> m LicenseExceptionId
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type forall (m :: * -> *). MonadPlus m => Monad m
External instance of the constraint type forall (m :: * -> *). CabalParsing m => MonadPlus m
Evidence bound by a type signature of the constraint type CabalParsing m
return (Maybe LicenseExceptionId -> m LicenseExceptionId)
-> Maybe LicenseExceptionId -> m LicenseExceptionId
forall a b. (a -> b) -> a -> b
$
            LicenseListVersion -> String -> Maybe LicenseExceptionId
mkLicenseExceptionId (CabalSpecVersion -> LicenseListVersion
cabalSpecVersionToSPDXListVersion CabalSpecVersion
v) String
n

instance NFData LicenseExceptionId where
    rnf :: LicenseExceptionId -> ()
rnf LicenseExceptionId
l = LicenseExceptionId
l LicenseExceptionId -> () -> ()
`seq` ()

-------------------------------------------------------------------------------
-- License Data
-------------------------------------------------------------------------------

-- | License SPDX identifier, e.g. @"BSD-3-Clause"@.
licenseExceptionId :: LicenseExceptionId -> String
licenseExceptionId :: LicenseExceptionId -> String
licenseExceptionId LicenseExceptionId
DS389_exception = String
"389-exception"
licenseExceptionId LicenseExceptionId
Autoconf_exception_2_0 = String
"Autoconf-exception-2.0"
licenseExceptionId LicenseExceptionId
Autoconf_exception_3_0 = String
"Autoconf-exception-3.0"
licenseExceptionId LicenseExceptionId
Bison_exception_2_2 = String
"Bison-exception-2.2"
licenseExceptionId LicenseExceptionId
Bootloader_exception = String
"Bootloader-exception"
licenseExceptionId LicenseExceptionId
Classpath_exception_2_0 = String
"Classpath-exception-2.0"
licenseExceptionId LicenseExceptionId
CLISP_exception_2_0 = String
"CLISP-exception-2.0"
licenseExceptionId LicenseExceptionId
DigiRule_FOSS_exception = String
"DigiRule-FOSS-exception"
licenseExceptionId LicenseExceptionId
ECos_exception_2_0 = String
"eCos-exception-2.0"
licenseExceptionId LicenseExceptionId
Fawkes_Runtime_exception = String
"Fawkes-Runtime-exception"
licenseExceptionId LicenseExceptionId
FLTK_exception = String
"FLTK-exception"
licenseExceptionId LicenseExceptionId
Font_exception_2_0 = String
"Font-exception-2.0"
licenseExceptionId LicenseExceptionId
Freertos_exception_2_0 = String
"freertos-exception-2.0"
licenseExceptionId LicenseExceptionId
GCC_exception_2_0 = String
"GCC-exception-2.0"
licenseExceptionId LicenseExceptionId
GCC_exception_3_1 = String
"GCC-exception-3.1"
licenseExceptionId LicenseExceptionId
Gnu_javamail_exception = String
"gnu-javamail-exception"
licenseExceptionId LicenseExceptionId
GPL_CC_1_0 = String
"GPL-CC-1.0"
licenseExceptionId LicenseExceptionId
I2p_gpl_java_exception = String
"i2p-gpl-java-exception"
licenseExceptionId LicenseExceptionId
Libtool_exception = String
"Libtool-exception"
licenseExceptionId LicenseExceptionId
Linux_syscall_note = String
"Linux-syscall-note"
licenseExceptionId LicenseExceptionId
LLVM_exception = String
"LLVM-exception"
licenseExceptionId LicenseExceptionId
LZMA_exception = String
"LZMA-exception"
licenseExceptionId LicenseExceptionId
Mif_exception = String
"mif-exception"
licenseExceptionId LicenseExceptionId
Nokia_Qt_exception_1_1 = String
"Nokia-Qt-exception-1.1"
licenseExceptionId LicenseExceptionId
OCaml_LGPL_linking_exception = String
"OCaml-LGPL-linking-exception"
licenseExceptionId LicenseExceptionId
OCCT_exception_1_0 = String
"OCCT-exception-1.0"
licenseExceptionId LicenseExceptionId
OpenJDK_assembly_exception_1_0 = String
"OpenJDK-assembly-exception-1.0"
licenseExceptionId LicenseExceptionId
Openvpn_openssl_exception = String
"openvpn-openssl-exception"
licenseExceptionId LicenseExceptionId
PS_or_PDF_font_exception_20170817 = String
"PS-or-PDF-font-exception-20170817"
licenseExceptionId LicenseExceptionId
Qt_GPL_exception_1_0 = String
"Qt-GPL-exception-1.0"
licenseExceptionId LicenseExceptionId
Qt_LGPL_exception_1_1 = String
"Qt-LGPL-exception-1.1"
licenseExceptionId LicenseExceptionId
Qwt_exception_1_0 = String
"Qwt-exception-1.0"
licenseExceptionId LicenseExceptionId
Swift_exception = String
"Swift-exception"
licenseExceptionId LicenseExceptionId
U_boot_exception_2_0 = String
"u-boot-exception-2.0"
licenseExceptionId LicenseExceptionId
Universal_FOSS_exception_1_0 = String
"Universal-FOSS-exception-1.0"
licenseExceptionId LicenseExceptionId
WxWindows_exception_3_1 = String
"WxWindows-exception-3.1"

-- | License name, e.g. @"GNU General Public License v2.0 only"@
licenseExceptionName :: LicenseExceptionId -> String
licenseExceptionName :: LicenseExceptionId -> String
licenseExceptionName LicenseExceptionId
DS389_exception = String
"389 Directory Server Exception"
licenseExceptionName LicenseExceptionId
Autoconf_exception_2_0 = String
"Autoconf exception 2.0"
licenseExceptionName LicenseExceptionId
Autoconf_exception_3_0 = String
"Autoconf exception 3.0"
licenseExceptionName LicenseExceptionId
Bison_exception_2_2 = String
"Bison exception 2.2"
licenseExceptionName LicenseExceptionId
Bootloader_exception = String
"Bootloader Distribution Exception"
licenseExceptionName LicenseExceptionId
Classpath_exception_2_0 = String
"Classpath exception 2.0"
licenseExceptionName LicenseExceptionId
CLISP_exception_2_0 = String
"CLISP exception 2.0"
licenseExceptionName LicenseExceptionId
DigiRule_FOSS_exception = String
"DigiRule FOSS License Exception"
licenseExceptionName LicenseExceptionId
ECos_exception_2_0 = String
"eCos exception 2.0"
licenseExceptionName LicenseExceptionId
Fawkes_Runtime_exception = String
"Fawkes Runtime Exception"
licenseExceptionName LicenseExceptionId
FLTK_exception = String
"FLTK exception"
licenseExceptionName LicenseExceptionId
Font_exception_2_0 = String
"Font exception 2.0"
licenseExceptionName LicenseExceptionId
Freertos_exception_2_0 = String
"FreeRTOS Exception 2.0"
licenseExceptionName LicenseExceptionId
GCC_exception_2_0 = String
"GCC Runtime Library exception 2.0"
licenseExceptionName LicenseExceptionId
GCC_exception_3_1 = String
"GCC Runtime Library exception 3.1"
licenseExceptionName LicenseExceptionId
Gnu_javamail_exception = String
"GNU JavaMail exception"
licenseExceptionName LicenseExceptionId
GPL_CC_1_0 = String
"GPL Cooperation Commitment 1.0"
licenseExceptionName LicenseExceptionId
I2p_gpl_java_exception = String
"i2p GPL+Java Exception"
licenseExceptionName LicenseExceptionId
Libtool_exception = String
"Libtool Exception"
licenseExceptionName LicenseExceptionId
Linux_syscall_note = String
"Linux Syscall Note"
licenseExceptionName LicenseExceptionId
LLVM_exception = String
"LLVM Exception"
licenseExceptionName LicenseExceptionId
LZMA_exception = String
"LZMA exception"
licenseExceptionName LicenseExceptionId
Mif_exception = String
"Macros and Inline Functions Exception"
licenseExceptionName LicenseExceptionId
Nokia_Qt_exception_1_1 = String
"Nokia Qt LGPL exception 1.1"
licenseExceptionName LicenseExceptionId
OCaml_LGPL_linking_exception = String
"OCaml LGPL Linking Exception"
licenseExceptionName LicenseExceptionId
OCCT_exception_1_0 = String
"Open CASCADE Exception 1.0"
licenseExceptionName LicenseExceptionId
OpenJDK_assembly_exception_1_0 = String
"OpenJDK Assembly exception 1.0"
licenseExceptionName LicenseExceptionId
Openvpn_openssl_exception = String
"OpenVPN OpenSSL Exception"
licenseExceptionName LicenseExceptionId
PS_or_PDF_font_exception_20170817 = String
"PS/PDF font exception (2017-08-17)"
licenseExceptionName LicenseExceptionId
Qt_GPL_exception_1_0 = String
"Qt GPL exception 1.0"
licenseExceptionName LicenseExceptionId
Qt_LGPL_exception_1_1 = String
"Qt LGPL exception 1.1"
licenseExceptionName LicenseExceptionId
Qwt_exception_1_0 = String
"Qwt exception 1.0"
licenseExceptionName LicenseExceptionId
Swift_exception = String
"Swift Exception"
licenseExceptionName LicenseExceptionId
U_boot_exception_2_0 = String
"U-Boot exception 2.0"
licenseExceptionName LicenseExceptionId
Universal_FOSS_exception_1_0 = String
"Universal FOSS Exception, Version 1.0"
licenseExceptionName LicenseExceptionId
WxWindows_exception_3_1 = String
"WxWindows Library Exception 3.1"

-------------------------------------------------------------------------------
-- Creation
-------------------------------------------------------------------------------

licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId]
licenseExceptionIdList :: LicenseListVersion -> [LicenseExceptionId]
licenseExceptionIdList LicenseListVersion
LicenseListVersion_3_0 =
    [ LicenseExceptionId
Nokia_Qt_exception_1_1
    ]
    [LicenseExceptionId]
-> [LicenseExceptionId] -> [LicenseExceptionId]
forall a. [a] -> [a] -> [a]
++ [LicenseExceptionId]
bulkOfLicenses
licenseExceptionIdList LicenseListVersion
LicenseListVersion_3_2 =
    [ LicenseExceptionId
LLVM_exception
    , LicenseExceptionId
Nokia_Qt_exception_1_1
    , LicenseExceptionId
OpenJDK_assembly_exception_1_0
    , LicenseExceptionId
PS_or_PDF_font_exception_20170817
    , LicenseExceptionId
Qt_GPL_exception_1_0
    , LicenseExceptionId
Qt_LGPL_exception_1_1
    ]
    [LicenseExceptionId]
-> [LicenseExceptionId] -> [LicenseExceptionId]
forall a. [a] -> [a] -> [a]
++ [LicenseExceptionId]
bulkOfLicenses
licenseExceptionIdList LicenseListVersion
LicenseListVersion_3_6 =
    [ LicenseExceptionId
GPL_CC_1_0
    , LicenseExceptionId
LLVM_exception
    , LicenseExceptionId
OCaml_LGPL_linking_exception
    , LicenseExceptionId
OpenJDK_assembly_exception_1_0
    , LicenseExceptionId
PS_or_PDF_font_exception_20170817
    , LicenseExceptionId
Qt_GPL_exception_1_0
    , LicenseExceptionId
Qt_LGPL_exception_1_1
    , LicenseExceptionId
Swift_exception
    , LicenseExceptionId
Universal_FOSS_exception_1_0
    ]
    [LicenseExceptionId]
-> [LicenseExceptionId] -> [LicenseExceptionId]
forall a. [a] -> [a] -> [a]
++ [LicenseExceptionId]
bulkOfLicenses

-- | Create a 'LicenseExceptionId' from a 'String'.
mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId
mkLicenseExceptionId :: LicenseListVersion -> String -> Maybe LicenseExceptionId
mkLicenseExceptionId LicenseListVersion
LicenseListVersion_3_0 String
s = String -> Map String LicenseExceptionId -> Maybe LicenseExceptionId
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.lookup String
s Map String LicenseExceptionId
stringLookup_3_0
mkLicenseExceptionId LicenseListVersion
LicenseListVersion_3_2 String
s = String -> Map String LicenseExceptionId -> Maybe LicenseExceptionId
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.lookup String
s Map String LicenseExceptionId
stringLookup_3_2
mkLicenseExceptionId LicenseListVersion
LicenseListVersion_3_6 String
s = String -> Map String LicenseExceptionId -> Maybe LicenseExceptionId
forall k a. Ord k => k -> Map k a -> Maybe a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.lookup String
s Map String LicenseExceptionId
stringLookup_3_6

stringLookup_3_0 :: Map String LicenseExceptionId
stringLookup_3_0 :: Map String LicenseExceptionId
stringLookup_3_0 = [(String, LicenseExceptionId)] -> Map String LicenseExceptionId
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.fromList ([(String, LicenseExceptionId)] -> Map String LicenseExceptionId)
-> [(String, LicenseExceptionId)] -> Map String LicenseExceptionId
forall a b. (a -> b) -> a -> b
$ (LicenseExceptionId -> (String, LicenseExceptionId))
-> [LicenseExceptionId] -> [(String, LicenseExceptionId)]
forall a b. (a -> b) -> [a] -> [b]
map (\LicenseExceptionId
i -> (LicenseExceptionId -> String
licenseExceptionId LicenseExceptionId
i, LicenseExceptionId
i)) ([LicenseExceptionId] -> [(String, LicenseExceptionId)])
-> [LicenseExceptionId] -> [(String, LicenseExceptionId)]
forall a b. (a -> b) -> a -> b
$
    LicenseListVersion -> [LicenseExceptionId]
licenseExceptionIdList LicenseListVersion
LicenseListVersion_3_0

stringLookup_3_2 :: Map String LicenseExceptionId
stringLookup_3_2 :: Map String LicenseExceptionId
stringLookup_3_2 = [(String, LicenseExceptionId)] -> Map String LicenseExceptionId
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.fromList ([(String, LicenseExceptionId)] -> Map String LicenseExceptionId)
-> [(String, LicenseExceptionId)] -> Map String LicenseExceptionId
forall a b. (a -> b) -> a -> b
$ (LicenseExceptionId -> (String, LicenseExceptionId))
-> [LicenseExceptionId] -> [(String, LicenseExceptionId)]
forall a b. (a -> b) -> [a] -> [b]
map (\LicenseExceptionId
i -> (LicenseExceptionId -> String
licenseExceptionId LicenseExceptionId
i, LicenseExceptionId
i)) ([LicenseExceptionId] -> [(String, LicenseExceptionId)])
-> [LicenseExceptionId] -> [(String, LicenseExceptionId)]
forall a b. (a -> b) -> a -> b
$
    LicenseListVersion -> [LicenseExceptionId]
licenseExceptionIdList LicenseListVersion
LicenseListVersion_3_2

stringLookup_3_6 :: Map String LicenseExceptionId
stringLookup_3_6 :: Map String LicenseExceptionId
stringLookup_3_6 = [(String, LicenseExceptionId)] -> Map String LicenseExceptionId
forall k a. Ord k => [(k, a)] -> Map k a
External instance of the constraint type forall a. Ord a => Ord [a]
External instance of the constraint type Ord Char
Map.fromList ([(String, LicenseExceptionId)] -> Map String LicenseExceptionId)
-> [(String, LicenseExceptionId)] -> Map String LicenseExceptionId
forall a b. (a -> b) -> a -> b
$ (LicenseExceptionId -> (String, LicenseExceptionId))
-> [LicenseExceptionId] -> [(String, LicenseExceptionId)]
forall a b. (a -> b) -> [a] -> [b]
map (\LicenseExceptionId
i -> (LicenseExceptionId -> String
licenseExceptionId LicenseExceptionId
i, LicenseExceptionId
i)) ([LicenseExceptionId] -> [(String, LicenseExceptionId)])
-> [LicenseExceptionId] -> [(String, LicenseExceptionId)]
forall a b. (a -> b) -> a -> b
$
    LicenseListVersion -> [LicenseExceptionId]
licenseExceptionIdList LicenseListVersion
LicenseListVersion_3_6

--  | License exceptions in all SPDX License lists
bulkOfLicenses :: [LicenseExceptionId]
bulkOfLicenses :: [LicenseExceptionId]
bulkOfLicenses =
    [ LicenseExceptionId
DS389_exception
    , LicenseExceptionId
Autoconf_exception_2_0
    , LicenseExceptionId
Autoconf_exception_3_0
    , LicenseExceptionId
Bison_exception_2_2
    , LicenseExceptionId
Bootloader_exception
    , LicenseExceptionId
Classpath_exception_2_0
    , LicenseExceptionId
CLISP_exception_2_0
    , LicenseExceptionId
DigiRule_FOSS_exception
    , LicenseExceptionId
ECos_exception_2_0
    , LicenseExceptionId
Fawkes_Runtime_exception
    , LicenseExceptionId
FLTK_exception
    , LicenseExceptionId
Font_exception_2_0
    , LicenseExceptionId
Freertos_exception_2_0
    , LicenseExceptionId
GCC_exception_2_0
    , LicenseExceptionId
GCC_exception_3_1
    , LicenseExceptionId
Gnu_javamail_exception
    , LicenseExceptionId
I2p_gpl_java_exception
    , LicenseExceptionId
Libtool_exception
    , LicenseExceptionId
Linux_syscall_note
    , LicenseExceptionId
LZMA_exception
    , LicenseExceptionId
Mif_exception
    , LicenseExceptionId
OCCT_exception_1_0
    , LicenseExceptionId
Openvpn_openssl_exception
    , LicenseExceptionId
Qwt_exception_1_0
    , LicenseExceptionId
U_boot_exception_2_0
    , LicenseExceptionId
WxWindows_exception_3_1
    ]