1{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveGeneric      #-}
3
4-----------------------------------------------------------------------------
5-- |
6-- Module      :  Distribution.License
7-- Description :  The License data type.
8-- Copyright   :  Isaac Jones 2003-2005
9--                Duncan Coutts 2008
10-- License     :  BSD3
11--
12-- Maintainer  :  cabal-devel@haskell.org
13-- Portability :  portable
14--
15-- Package descriptions contain fields for specifying the name of a software
16-- license and the name of the file containing the text of that license. While
17-- package authors may choose any license they like, Cabal provides an
18-- enumeration of a small set of common free and open source software licenses.
19-- This is done so that Hackage can recognise licenses, so that tools can detect
20-- <https://en.wikipedia.org/wiki/License_compatibility licensing conflicts>,
21-- and to deter
22-- <https://en.wikipedia.org/wiki/License_proliferation license proliferation>.
23--
24-- It is recommended that all package authors use the @license-file@ or
25-- @license-files@ fields in their package descriptions. Further information
26-- about these fields can be found in the
27-- <http://www.haskell.org/cabal/users-guide/developing-packages.html#package-descriptions Cabal users guide>.
28--
29-- = Additional resources
30--
31-- The following websites provide information about free and open source
32-- software licenses:
33--
34-- * <http://www.opensource.org The Open Source Initiative (OSI)>
35--
36-- * <https://www.fsf.org The Free Software Foundation (FSF)>
37--
38-- = Disclaimer
39--
40-- The descriptions of software licenses provided by this documentation are
41-- intended for informational purposes only and in no way constitute legal
42-- advice. Please read the text of the licenses and consult a lawyer for any
43-- advice regarding software licensing.
44
45module Distribution.License (
46    License(..),
47    knownLicenses,
48    licenseToSPDX,
49    licenseFromSPDX,
50  ) where
51
52import Distribution.Compat.Prelude
53import Prelude ()
54
55import Distribution.Parsec
56import Distribution.Pretty
57import Distribution.Version
58
59import qualified Distribution.Compat.CharParsing as P
60import qualified Data.Map.Strict                 as Map
61import qualified Distribution.SPDX               as SPDX
62import qualified Text.PrettyPrint                as Disp
63
64-- | Indicates the license under which a package's source code is released.
65-- Versions of the licenses not listed here will be rejected by Hackage and
66-- cause @cabal check@ to issue a warning.
67data License =
68    -- TODO: * remove BSD4
69
70    -- | GNU General Public License,
71    -- <https://www.gnu.org/licenses/old-licenses/gpl-2.0.html version 2> or
72    -- <https://www.gnu.org/licenses/gpl.html version 3>.
73    GPL (Maybe Version)
74
75    -- | <https://www.gnu.org/licenses/agpl.html GNU Affero General Public License, version 3>.
76  | AGPL (Maybe Version)
77
78    -- | GNU Lesser General Public License,
79    -- <https://www.gnu.org/licenses/old-licenses/lgpl-2.1.html version 2.1> or
80    -- <https://www.gnu.org/licenses/lgpl.html version 3>.
81  | LGPL (Maybe Version)
82
83    -- | <http://www.opensource.org/licenses/bsd-license 2-clause BSD license>.
84  | BSD2
85
86    -- | <http://www.opensource.org/licenses/bsd-3-clause 3-clause BSD license>.
87  | BSD3
88
89    -- | <http://directory.fsf.org/wiki/License:BSD_4Clause 4-clause BSD license>.
90    -- This license has not been approved by the OSI and is incompatible with
91    -- the GNU GPL. It is provided for historical reasons and should be avoided.
92  | BSD4
93
94    -- | <http://www.opensource.org/licenses/MIT MIT license>.
95  | MIT
96
97    -- | <http://www.isc.org/downloads/software-support-policy/isc-license/ ISC license>
98  | ISC
99
100    -- | <https://www.mozilla.org/MPL/ Mozilla Public License, version 2.0>.
101  | MPL Version
102
103    -- | <https://www.apache.org/licenses/ Apache License, version 2.0>.
104  | Apache (Maybe Version)
105
106    -- | The author of a package disclaims any copyright to its source code and
107    -- dedicates it to the public domain. This is not a software license. Please
108    -- note that it is not possible to dedicate works to the public domain in
109    -- every jurisdiction, nor is a work that is in the public domain in one
110    -- jurisdiction necessarily in the public domain elsewhere.
111  | PublicDomain
112
113    -- | Explicitly 'All Rights Reserved', eg for proprietary software. The
114    -- package may not be legally modified or redistributed by anyone but the
115    -- rightsholder.
116  | AllRightsReserved
117
118    -- | No license specified which legally defaults to 'All Rights Reserved'.
119    -- The package may not be legally modified or redistributed by anyone but
120    -- the rightsholder.
121  | UnspecifiedLicense
122
123    -- | Any other software license.
124  | OtherLicense
125
126    -- | Indicates an erroneous license name.
127  | UnknownLicense String
128  deriving (Generic, Read, Show, Eq, Typeable, Data)
129
130instance Binary License
131instance Structured License
132instance NFData License where rnf = genericRnf
133
134-- | The list of all currently recognised licenses.
135knownLicenses :: [License]
136knownLicenses = [ GPL  unversioned, GPL  (version [2]),    GPL  (version [3])
137                , LGPL unversioned, LGPL (version [2, 1]), LGPL (version [3])
138                , AGPL unversioned,                        AGPL (version [3])
139                , BSD2, BSD3, MIT, ISC
140                , MPL (mkVersion [2, 0])
141                , Apache unversioned, Apache (version [2, 0])
142                , PublicDomain, AllRightsReserved, OtherLicense]
143  where
144    unversioned = Nothing
145    version     = Just . mkVersion
146
147-- | Convert old 'License' to SPDX 'SPDX.License'.
148-- Non-SPDX licenses are converted to 'SPDX.LicenseRef'.
149--
150-- @since 2.2.0.0
151licenseToSPDX :: License -> SPDX.License
152licenseToSPDX l = case l of
153    GPL v | v == version [2]      -> spdx SPDX.GPL_2_0_only
154    GPL v | v == version [3]      -> spdx SPDX.GPL_3_0_only
155    LGPL v | v == version [2,1]   -> spdx SPDX.LGPL_2_1_only
156    LGPL v | v == version [3]     -> spdx SPDX.LGPL_3_0_only
157    AGPL v | v == version [3]     -> spdx SPDX.AGPL_3_0_only
158    BSD2                          -> spdx SPDX.BSD_2_Clause
159    BSD3                          -> spdx SPDX.BSD_3_Clause
160    BSD4                          -> spdx SPDX.BSD_4_Clause
161    MIT                           -> spdx SPDX.MIT
162    ISC                           -> spdx SPDX.ISC
163    MPL v | v == mkVersion [2,0]  -> spdx SPDX.MPL_2_0
164    Apache v | v == version [2,0] -> spdx SPDX.Apache_2_0
165    AllRightsReserved             -> SPDX.NONE
166    UnspecifiedLicense            -> SPDX.NONE
167    OtherLicense                  -> ref (SPDX.mkLicenseRef' Nothing "OtherLicense")
168    PublicDomain                  -> ref (SPDX.mkLicenseRef' Nothing "PublicDomain")
169    UnknownLicense str            -> ref (SPDX.mkLicenseRef' Nothing str)
170    _                             -> ref (SPDX.mkLicenseRef' Nothing $ prettyShow l)
171  where
172    version = Just . mkVersion
173    spdx    = SPDX.License . SPDX.simpleLicenseExpression
174    ref  r  = SPDX.License $ SPDX.ELicense (SPDX.ELicenseRef r) Nothing
175
176-- | Convert 'SPDX.License' to 'License',
177--
178-- This is lossy conversion. We try our best.
179--
180-- >>> licenseFromSPDX . licenseToSPDX $ BSD3
181-- BSD3
182--
183-- >>> licenseFromSPDX . licenseToSPDX $ GPL (Just (mkVersion [3]))
184-- GPL (Just (mkVersion [3]))
185--
186-- >>> licenseFromSPDX . licenseToSPDX $ PublicDomain
187-- UnknownLicense "LicenseRefPublicDomain"
188--
189-- >>> licenseFromSPDX $ SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1
190-- UnknownLicense "EUPL-1.1"
191--
192-- >>> licenseFromSPDX . licenseToSPDX $ AllRightsReserved
193-- AllRightsReserved
194--
195-- >>> licenseFromSPDX <$> simpleParsec "BSD-3-Clause OR GPL-3.0-only"
196-- Just (UnknownLicense "BSD3ClauseORGPL30only")
197--
198-- @since 2.2.0.0
199licenseFromSPDX :: SPDX.License -> License
200licenseFromSPDX SPDX.NONE = AllRightsReserved
201licenseFromSPDX l =
202    fromMaybe (mungle $ prettyShow l) $ Map.lookup l m
203  where
204    m :: Map.Map SPDX.License License
205    m = Map.fromList $ filter (isSimple . fst ) $
206        map (\x -> (licenseToSPDX x, x)) knownLicenses
207
208    isSimple (SPDX.License (SPDX.ELicense (SPDX.ELicenseId _) Nothing)) = True
209    isSimple _ = False
210
211    mungle name = fromMaybe (UnknownLicense (mapMaybe mangle name)) (simpleParsec name)
212
213    mangle c
214        | isAlphaNum c = Just c
215        | otherwise = Nothing
216
217instance Pretty License where
218  pretty (GPL  version)         = Disp.text "GPL"    <<>> dispOptVersion version
219  pretty (LGPL version)         = Disp.text "LGPL"   <<>> dispOptVersion version
220  pretty (AGPL version)         = Disp.text "AGPL"   <<>> dispOptVersion version
221  pretty (MPL  version)         = Disp.text "MPL"    <<>> dispVersion    version
222  pretty (Apache version)       = Disp.text "Apache" <<>> dispOptVersion version
223  pretty (UnknownLicense other) = Disp.text other
224  pretty other                  = Disp.text (show other)
225
226instance Parsec License where
227  parsec = do
228    name    <- P.munch1 isAlphaNum
229    version <- P.optional (P.char '-' *> parsec)
230    return $! case (name, version :: Maybe Version) of
231      ("GPL",               _      )  -> GPL  version
232      ("LGPL",              _      )  -> LGPL version
233      ("AGPL",              _      )  -> AGPL version
234      ("BSD2",              Nothing)  -> BSD2
235      ("BSD3",              Nothing)  -> BSD3
236      ("BSD4",              Nothing)  -> BSD4
237      ("ISC",               Nothing)  -> ISC
238      ("MIT",               Nothing)  -> MIT
239      ("MPL",         Just version')  -> MPL version'
240      ("Apache",            _      )  -> Apache version
241      ("PublicDomain",      Nothing)  -> PublicDomain
242      ("AllRightsReserved", Nothing)  -> AllRightsReserved
243      ("OtherLicense",      Nothing)  -> OtherLicense
244      _                               -> UnknownLicense $ name ++
245                                         maybe "" (('-':) . prettyShow) version
246
247dispOptVersion :: Maybe Version -> Disp.Doc
248dispOptVersion Nothing  = Disp.empty
249dispOptVersion (Just v) = dispVersion v
250
251dispVersion :: Version -> Disp.Doc
252dispVersion v = Disp.char '-' <<>> pretty v
253