{-# LANGUAGE ViewPatterns #-}

module Distribution.Nixpkgs.Haskell.FromCabal.License
    ( fromCabalLicense
    , fromSPDXLicense
    , isFreeLicense
    ) where

import Data.List (intercalate)
import Distribution.License ( License(..), knownLicenses )
import Distribution.Nixpkgs.License
import Distribution.Pretty (prettyShow)
import qualified Distribution.SPDX as SPDX
import Distribution.Text (display)
import Distribution.Version

-- TODO: Programmatically strip trailing zeros from license version numbers.

fromCabalLicense :: Distribution.License.License -> Distribution.Nixpkgs.License.License
fromCabalLicense :: License -> License
fromCabalLicense (GPL Maybe Version
Nothing)                             = Maybe String -> License
Unknown (String -> Maybe String
forall a. a -> Maybe a
Just String
"GPL")
fromCabalLicense (GPL (Just (Version -> [Int]
versionNumbers -> [Int
2])))      = String -> License
Known String
"lib.licenses.gpl2Only"
fromCabalLicense (GPL (Just (Version -> [Int]
versionNumbers -> [Int
3])))      = String -> License
Known String
"lib.licenses.gpl3Only"
fromCabalLicense (GPL (Just (Version -> [Int]
versionNumbers -> [Int
3,Int
0])))    = String -> License
Known String
"lib.licenses.gpl3Only"
fromCabalLicense (LGPL Maybe Version
Nothing)                            = Maybe String -> License
Unknown (String -> Maybe String
forall a. a -> Maybe a
Just String
"LGPL")
fromCabalLicense (LGPL (Just (Version -> [Int]
versionNumbers -> [Int
2,Int
1])))   = String -> License
Known String
"lib.licenses.lgpl21Only"
fromCabalLicense (LGPL (Just (Version -> [Int]
versionNumbers -> [Int
2])))     = String -> License
Known String
"lib.licenses.lgpl2Only"
fromCabalLicense (LGPL (Just (Version -> [Int]
versionNumbers -> [Int
3])))     = String -> License
Known String
"lib.licenses.lgpl3Only"
fromCabalLicense (LGPL (Just (Version -> [Int]
versionNumbers -> [Int
3,Int
0])))   = String -> License
Known String
"lib.licenses.lgpl3Only"
fromCabalLicense (AGPL Maybe Version
Nothing)                            = Maybe String -> License
Unknown (String -> Maybe String
forall a. a -> Maybe a
Just String
"AGPL")
fromCabalLicense (AGPL (Just (Version -> [Int]
versionNumbers -> [Int
3])))     = String -> License
Known String
"lib.licenses.agpl3Only"
fromCabalLicense (AGPL (Just (Version -> [Int]
versionNumbers -> [Int
3,Int
0])))   = String -> License
Known String
"lib.licenses.agpl3Only"
fromCabalLicense (MPL (Version -> [Int]
versionNumbers ->  [Int
2,Int
0]))          = String -> License
Known String
"lib.licenses.mpl20"
fromCabalLicense License
BSD2                                      = String -> License
Known String
"lib.licenses.bsd2"
fromCabalLicense License
BSD3                                      = String -> License
Known String
"lib.licenses.bsd3"
fromCabalLicense License
BSD4                                      = String -> License
Known String
"lib.licenses.bsdOriginal"
fromCabalLicense License
MIT                                       = String -> License
Known String
"lib.licenses.mit"
fromCabalLicense License
PublicDomain                              = String -> License
Known String
"lib.licenses.publicDomain"
fromCabalLicense License
UnspecifiedLicense                        = String -> License
Known String
"lib.licenses.unfree"
fromCabalLicense License
AllRightsReserved                         = String -> License
Known String
"lib.licenses.unfree"
fromCabalLicense (Apache Maybe Version
Nothing)                          = String -> License
Known String
"lib.licenses.asl20"
fromCabalLicense (Apache (Just (Version -> [Int]
versionNumbers -> [Int
2,Int
0]))) = String -> License
Known String
"lib.licenses.asl20"
fromCabalLicense License
ISC                                       = String -> License
Known String
"lib.licenses.isc"
fromCabalLicense License
OtherLicense                              = Maybe String -> License
Unknown Maybe String
forall a. Maybe a
Nothing
fromCabalLicense (UnknownLicense String
"CC0-1.0")                = String -> License
Known String
"lib.licenses.cc0"
fromCabalLicense (UnknownLicense String
"BSD3ClauseORApache20")   = String -> License
Known String
"lib.licenses.bsd3"
fromCabalLicense License
l                                         = String -> License
forall a. HasCallStack => String -> a
error (String -> License) -> String -> License
forall a b. (a -> b) -> a -> b
$ String
"Distribution.Nixpkgs.Haskell.FromCabal.License.fromCabalLicense: unknown license"
                                                                  String -> String -> String
forall a. [a] -> [a] -> [a]
++ License -> String
forall a. Show a => a -> String
show License
l String -> String -> String
forall a. [a] -> [a] -> [a]
++String
"\nChoose one of: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ((License -> String) -> [License] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map License -> String
forall a. Pretty a => a -> String
display [License]
knownLicenses)

fromSPDXLicense :: SPDX.License -> Distribution.Nixpkgs.License.License
fromSPDXLicense :: License -> License
fromSPDXLicense License
SPDX.NONE = Maybe String -> License
Unknown Maybe String
forall a. Maybe a
Nothing
fromSPDXLicense (SPDX.License LicenseExpression
expr) =
  case LicenseExpression
expr of
    SPDX.ELicense SimpleLicenseExpression
simpl Maybe LicenseExceptionId
Nothing ->
      -- Not handled: license exceptions
      case SimpleLicenseExpression
simpl of
        SPDX.ELicenseId LicenseId
lid -> String -> License
Known (String
"lib.licensesSpdx.\"" String -> String -> String
forall a. [a] -> [a] -> [a]
++ LicenseId -> String
forall a. Pretty a => a -> String
prettyShow LicenseId
lid String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\"")
        SimpleLicenseExpression
_ ->
          -- Not handed: the '+' suffix and user-defined licences references.
          -- Use the SPDX expression as a free-form license string.
          Maybe String -> License
Unknown (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ LicenseExpression -> String
forall a. Pretty a => a -> String
prettyShow LicenseExpression
expr)
    LicenseExpression
_ ->
      -- Not handled: compound expressions, not expressible in Nixpkgs.
      -- Use the SPDX expression as a free-form license string.
      Maybe String -> License
Unknown (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ LicenseExpression -> String
forall a. Pretty a => a -> String
prettyShow LicenseExpression
expr)

-- "isFreeLicense" is used to determine whether we generate a "hydraPlatforms =
-- none" in the hackage2nix output for a package with the given license.

-- Note: If "isFreeLicense" returned false for a license which is not an unfree
-- license from "lib.licenses" the package would still be build by hydra if
-- another package depended on it.

-- Since all software on hackage needs to be "open source in spirit" and we
-- don‘t know any software on hackage for which we are not allowed to
-- distribute binary outputs we assume that a package has a free license if we
-- don‘t explicitly know otherwise.
isFreeLicense :: Distribution.Nixpkgs.License.License -> Bool
isFreeLicense :: License -> Bool
isFreeLicense (Known String
"lib.licenses.unfree") = Bool
False
isFreeLicense License
_                             = Bool
True