{-# LANGUAGE NoImplicitPrelude, OverloadedStrings, RecordWildCards, FlexibleInstances, GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TypeApplications #-}
  {-|
Description: Convert @package.json@ license fields to nixpkgs license attribute sets
-}
module Distribution.Nixpkgs.Nodejs.License
  ( -- * Conversion Logic
    nodeLicenseToNixpkgs
    -- * License Lookup Table
  , LicensesBySpdxId
  ) where

import Protolude

import qualified Data.Aeson as A
import qualified Nix.Expr as Nix
import qualified Data.Map.Strict as Map
import qualified Data.Aeson.BetterErrors as Json
import qualified Data.Scientific as Scientific

-- newtype to circumvent the default instance: we don't want
-- the key of the JSON object to be the key of the HashMap,
-- but one of its values (spdxId).
-- | Lookup table from SPDX identifier (as 'Text') to 'NixpkgsLicense'.
newtype LicensesBySpdxId
  = LicensesBySpdxId (Map Text NixpkgsLicense)
  deriving stock (Int -> LicensesBySpdxId -> ShowS
[LicensesBySpdxId] -> ShowS
LicensesBySpdxId -> String
(Int -> LicensesBySpdxId -> ShowS)
-> (LicensesBySpdxId -> String)
-> ([LicensesBySpdxId] -> ShowS)
-> Show LicensesBySpdxId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LicensesBySpdxId] -> ShowS
$cshowList :: [LicensesBySpdxId] -> ShowS
show :: LicensesBySpdxId -> String
$cshow :: LicensesBySpdxId -> String
showsPrec :: Int -> LicensesBySpdxId -> ShowS
$cshowsPrec :: Int -> LicensesBySpdxId -> ShowS
Show, LicensesBySpdxId -> LicensesBySpdxId -> Bool
(LicensesBySpdxId -> LicensesBySpdxId -> Bool)
-> (LicensesBySpdxId -> LicensesBySpdxId -> Bool)
-> Eq LicensesBySpdxId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LicensesBySpdxId -> LicensesBySpdxId -> Bool
$c/= :: LicensesBySpdxId -> LicensesBySpdxId -> Bool
== :: LicensesBySpdxId -> LicensesBySpdxId -> Bool
$c== :: LicensesBySpdxId -> LicensesBySpdxId -> Bool
Eq)
  deriving newtype (b -> LicensesBySpdxId -> LicensesBySpdxId
NonEmpty LicensesBySpdxId -> LicensesBySpdxId
LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId
(LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId)
-> (NonEmpty LicensesBySpdxId -> LicensesBySpdxId)
-> (forall b.
    Integral b =>
    b -> LicensesBySpdxId -> LicensesBySpdxId)
-> Semigroup LicensesBySpdxId
forall b. Integral b => b -> LicensesBySpdxId -> LicensesBySpdxId
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> LicensesBySpdxId -> LicensesBySpdxId
$cstimes :: forall b. Integral b => b -> LicensesBySpdxId -> LicensesBySpdxId
sconcat :: NonEmpty LicensesBySpdxId -> LicensesBySpdxId
$csconcat :: NonEmpty LicensesBySpdxId -> LicensesBySpdxId
<> :: LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId
$c<> :: LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId
Semigroup, Semigroup LicensesBySpdxId
LicensesBySpdxId
Semigroup LicensesBySpdxId
-> LicensesBySpdxId
-> (LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId)
-> ([LicensesBySpdxId] -> LicensesBySpdxId)
-> Monoid LicensesBySpdxId
[LicensesBySpdxId] -> LicensesBySpdxId
LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [LicensesBySpdxId] -> LicensesBySpdxId
$cmconcat :: [LicensesBySpdxId] -> LicensesBySpdxId
mappend :: LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId
$cmappend :: LicensesBySpdxId -> LicensesBySpdxId -> LicensesBySpdxId
mempty :: LicensesBySpdxId
$cmempty :: LicensesBySpdxId
$cp1Monoid :: Semigroup LicensesBySpdxId
Monoid)

-- | Representation of a nixpkgs license set as found in
--   @lib.licenses@. There doesn't seem to be a strict
--   definition of what is required and what is optional,
--   the distribution of 'Maybe' and non-'Maybe' values
--   is based on the current situation in @lib/licenses.nix@.
data NixpkgsLicense
  = NixpkgsLicense ([(Text, LicenseValue)])
  deriving stock (Int -> NixpkgsLicense -> ShowS
[NixpkgsLicense] -> ShowS
NixpkgsLicense -> String
(Int -> NixpkgsLicense -> ShowS)
-> (NixpkgsLicense -> String)
-> ([NixpkgsLicense] -> ShowS)
-> Show NixpkgsLicense
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NixpkgsLicense] -> ShowS
$cshowList :: [NixpkgsLicense] -> ShowS
show :: NixpkgsLicense -> String
$cshow :: NixpkgsLicense -> String
showsPrec :: Int -> NixpkgsLicense -> ShowS
$cshowsPrec :: Int -> NixpkgsLicense -> ShowS
Show, NixpkgsLicense -> NixpkgsLicense -> Bool
(NixpkgsLicense -> NixpkgsLicense -> Bool)
-> (NixpkgsLicense -> NixpkgsLicense -> Bool) -> Eq NixpkgsLicense
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NixpkgsLicense -> NixpkgsLicense -> Bool
$c/= :: NixpkgsLicense -> NixpkgsLicense -> Bool
== :: NixpkgsLicense -> NixpkgsLicense -> Bool
$c== :: NixpkgsLicense -> NixpkgsLicense -> Bool
Eq)
data LicenseValue
  = LText Text
  | LBool Bool
  | LInt Int
  deriving stock (Int -> LicenseValue -> ShowS
[LicenseValue] -> ShowS
LicenseValue -> String
(Int -> LicenseValue -> ShowS)
-> (LicenseValue -> String)
-> ([LicenseValue] -> ShowS)
-> Show LicenseValue
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LicenseValue] -> ShowS
$cshowList :: [LicenseValue] -> ShowS
show :: LicenseValue -> String
$cshow :: LicenseValue -> String
showsPrec :: Int -> LicenseValue -> ShowS
$cshowsPrec :: Int -> LicenseValue -> ShowS
Show, LicenseValue -> LicenseValue -> Bool
(LicenseValue -> LicenseValue -> Bool)
-> (LicenseValue -> LicenseValue -> Bool) -> Eq LicenseValue
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LicenseValue -> LicenseValue -> Bool
$c/= :: LicenseValue -> LicenseValue -> Bool
== :: LicenseValue -> LicenseValue -> Bool
$c== :: LicenseValue -> LicenseValue -> Bool
Eq)

-- | Static version of @lib.licenses.unfree@,
--   so @UNLICENSED@ can be handled correctly
--   even if no lookup table is provided.
--
-- TODO: this will go out of sync with the nixpkgs definitions every once in a while, how to fix?
unfreeLicense :: NixpkgsLicense
unfreeLicense :: NixpkgsLicense
unfreeLicense = [(Text, LicenseValue)] -> NixpkgsLicense
NixpkgsLicense ([(Text, LicenseValue)] -> NixpkgsLicense)
-> [(Text, LicenseValue)] -> NixpkgsLicense
forall a b. (a -> b) -> a -> b
$ [
    (Text
"shortName", Text -> LicenseValue
LText Text
"unfree")
  , (Text
"deprecated", Bool -> LicenseValue
LBool Bool
False)
  , (Text
"fullName", Text -> LicenseValue
LText Text
"Unfree")
  , (Text
"redistributable", Bool -> LicenseValue
LBool Bool
False)
  , (Text
"free", Bool -> LicenseValue
LBool Bool
False)
 ]

instance A.FromJSON LicensesBySpdxId where
  parseJSON :: Value -> Parser LicensesBySpdxId
parseJSON = (Text -> Text)
-> Parse Text LicensesBySpdxId -> Value -> Parser LicensesBySpdxId
forall err a. (err -> Text) -> Parse err a -> Value -> Parser a
Json.toAesonParser Text -> Text
forall a. a -> a
identity (((Text -> ParseT Text Identity (Maybe (Text, NixpkgsLicense)))
-> ParseT Text Identity [Maybe (Text, NixpkgsLicense)]
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Text -> ParseT err m a) -> ParseT err m [a]
Json.forEachInObject ((Text -> ParseT Text Identity (Maybe (Text, NixpkgsLicense)))
 -> ParseT Text Identity [Maybe (Text, NixpkgsLicense)])
-> (Text -> ParseT Text Identity (Maybe (Text, NixpkgsLicense)))
-> ParseT Text Identity [Maybe (Text, NixpkgsLicense)]
forall a b. (a -> b) -> a -> b
$ \Text
_key -> do
    Text
-> ParseT Text Identity Text -> ParseT Text Identity (Maybe Text)
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
Text -> ParseT err m a -> ParseT err m (Maybe a)
Json.keyMay Text
"spdxId" ParseT Text Identity Text
forall (m :: * -> *) err. (Functor m, Monad m) => ParseT err m Text
Json.asText
    ParseT Text Identity (Maybe Text)
-> (Maybe Text
    -> ParseT Text Identity (Maybe (Text, NixpkgsLicense)))
-> ParseT Text Identity (Maybe (Text, NixpkgsLicense))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Maybe Text
Nothing -> Maybe (Text, NixpkgsLicense)
-> ParseT Text Identity (Maybe (Text, NixpkgsLicense))
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe (Text, NixpkgsLicense)
forall a. Maybe a
Nothing
      Just Text
spdxId -> do
        NixpkgsLicense
spdxLicense <- (ParseT Text Identity LicenseValue
-> ParseT Text Identity [(Text, LicenseValue)]
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
ParseT err m a -> ParseT err m [(Text, a)]
Json.eachInObject (ParseT Text Identity LicenseValue
 -> ParseT Text Identity [(Text, LicenseValue)])
-> ParseT Text Identity LicenseValue
-> ParseT Text Identity [(Text, LicenseValue)]
forall a b. (a -> b) -> a -> b
$ (Value -> Either Text LicenseValue)
-> ParseT Text Identity LicenseValue
forall (m :: * -> *) err a.
(Functor m, Monad m) =>
(Value -> Either err a) -> ParseT err m a
Json.withValue ((Value -> Either Text LicenseValue)
 -> ParseT Text Identity LicenseValue)
-> (Value -> Either Text LicenseValue)
-> ParseT Text Identity LicenseValue
forall a b. (a -> b) -> a -> b
$ \case
          A.String Text
t -> LicenseValue -> Either Text LicenseValue
forall a b. b -> Either a b
Right (LicenseValue -> Either Text LicenseValue)
-> LicenseValue -> Either Text LicenseValue
forall a b. (a -> b) -> a -> b
$ Text -> LicenseValue
LText Text
t
          A.Bool Bool
b -> LicenseValue -> Either Text LicenseValue
forall a b. b -> Either a b
Right (LicenseValue -> Either Text LicenseValue)
-> LicenseValue -> Either Text LicenseValue
forall a b. (a -> b) -> a -> b
$ Bool -> LicenseValue
LBool Bool
b
          A.Number Scientific
s -> case Scientific -> Maybe Int
forall i. (Integral i, Bounded i) => Scientific -> Maybe i
Scientific.toBoundedInteger @Int Scientific
s of
            Just Int
i -> LicenseValue -> Either Text LicenseValue
forall a b. b -> Either a b
Right (LicenseValue -> Either Text LicenseValue)
-> LicenseValue -> Either Text LicenseValue
forall a b. (a -> b) -> a -> b
$ Int -> LicenseValue
LInt Int
i
            Maybe Int
Nothing -> Text -> Either Text LicenseValue
forall a b. a -> Either a b
Left (Text -> Either Text LicenseValue)
-> Text -> Either Text LicenseValue
forall a b. (a -> b) -> a -> b
$ Text
"Not an integer: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Scientific
s Scientific -> (Scientific -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Scientific -> Text
forall a b. (Show a, ConvertText String b) => a -> b
show)
          Value
A.Null -> Text -> Either Text LicenseValue
forall a b. a -> Either a b
Left Text
"Cannot parse Null as license value for now"
          A.Object Object
_ -> Text -> Either Text LicenseValue
forall a b. a -> Either a b
Left Text
"Cannot parse Object as license value for now"
          A.Array Array
_ -> Text -> Either Text LicenseValue
forall a b. a -> Either a b
Left Text
"Cannot parse Array as license value for now")
          ParseT Text Identity [(Text, LicenseValue)]
-> ([(Text, LicenseValue)] -> NixpkgsLicense)
-> ParseT Text Identity NixpkgsLicense
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Text, LicenseValue)] -> NixpkgsLicense
NixpkgsLicense
        Maybe (Text, NixpkgsLicense)
-> ParseT Text Identity (Maybe (Text, NixpkgsLicense))
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, NixpkgsLicense)
 -> ParseT Text Identity (Maybe (Text, NixpkgsLicense)))
-> Maybe (Text, NixpkgsLicense)
-> ParseT Text Identity (Maybe (Text, NixpkgsLicense))
forall a b. (a -> b) -> a -> b
$ (Text, NixpkgsLicense) -> Maybe (Text, NixpkgsLicense)
forall a. a -> Maybe a
Just (Text
spdxId, NixpkgsLicense
spdxLicense)
   )
      ParseT Text Identity [Maybe (Text, NixpkgsLicense)]
-> ([Maybe (Text, NixpkgsLicense)] -> [(Text, NixpkgsLicense)])
-> ParseT Text Identity [(Text, NixpkgsLicense)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [Maybe (Text, NixpkgsLicense)] -> [(Text, NixpkgsLicense)]
forall a. [Maybe a] -> [a]
catMaybes
      ParseT Text Identity [(Text, NixpkgsLicense)]
-> ([(Text, NixpkgsLicense)] -> Map Text NixpkgsLicense)
-> ParseT Text Identity (Map Text NixpkgsLicense)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> [(Text, NixpkgsLicense)] -> Map Text NixpkgsLicense
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
      ParseT Text Identity (Map Text NixpkgsLicense)
-> (Map Text NixpkgsLicense -> LicensesBySpdxId)
-> Parse Text LicensesBySpdxId
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Map Text NixpkgsLicense -> LicensesBySpdxId
LicensesBySpdxId
   )


-- | Build nix attribute set for given 'NixpkgsLicense'.
--
--   The resulting nix value of @nixpkgsLicenseExpression x@
--   should be equal to @lib.licenses.<attrName x>@ for the
--   same version of nixpkgs used.
nixpkgsLicenseExpression :: NixpkgsLicense -> Nix.NExpr
nixpkgsLicenseExpression :: NixpkgsLicense -> NExpr
nixpkgsLicenseExpression (NixpkgsLicense [(Text, LicenseValue)]
m) =
  [(Text, LicenseValue)]
m
  [(Text, LicenseValue)]
-> ((Text, LicenseValue) -> (Text, NExpr)) -> [(Text, NExpr)]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (LicenseValue -> NExpr) -> (Text, LicenseValue) -> (Text, NExpr)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second LicenseValue -> NExpr
licenseValueToNExpr
  [(Text, NExpr)] -> ([(Text, NExpr)] -> NExpr) -> NExpr
forall a b. a -> (a -> b) -> b
& [(Text, NExpr)] -> NExpr
Nix.attrsE

licenseValueToNExpr :: LicenseValue -> Nix.NExpr
licenseValueToNExpr :: LicenseValue -> NExpr
licenseValueToNExpr = \case
  LText Text
t -> Text -> NExpr
Nix.mkStr Text
t
  LInt Int
i -> Integer -> NExpr
Nix.mkInt (Int
i Int -> (Int -> Integer) -> Integer
forall a b. a -> (a -> b) -> b
& (Integral Int, Num Integer) => Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral @Int @Integer)
  LBool Bool
b -> Bool -> NExpr
Nix.mkBool Bool
b

-- | Implements the logic for converting from an (optional)
--   @package.json@ @license@ field to a nixpkgs @meta.license@
--   set. Since support for multiple licenses is poor in nixpkgs
--   at the moment, we don't attempt to convert SPDX expressions
--   like @(ISC OR GPL-3.0-only)@.
--
--   See <https://docs.npmjs.com/files/package.json#license> for
--   details on npm's @license@ field.
nodeLicenseToNixpkgs :: Text -> LicensesBySpdxId -> Nix.NExpr
nodeLicenseToNixpkgs :: Text -> LicensesBySpdxId -> NExpr
nodeLicenseToNixpkgs Text
nodeLicense LicensesBySpdxId
licSet = do
  if Text
nodeLicense Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"UNLICENSED"
    then NixpkgsLicense -> NExpr
nixpkgsLicenseExpression NixpkgsLicense
unfreeLicense
    else case Text -> LicensesBySpdxId -> Maybe NExpr
lookupSpdxId Text
nodeLicense LicensesBySpdxId
licSet of
      Maybe NExpr
Nothing -> Text -> NExpr
Nix.mkStr Text
nodeLicense
      Just NExpr
license -> NExpr
license

-- | Lookup function for 'LicensesBySpdxId' which directly returns a 'NExpr'.
--   This function only looks up by SPDX identifier and does not take
--   npm-specific quirks into account.
--
--   Use 'nodeLicenseToNixpkgs' when dealing with the @license@ field
--   of a npm-ish javascript package.
lookupSpdxId :: Text -> LicensesBySpdxId -> Maybe Nix.NExpr
lookupSpdxId :: Text -> LicensesBySpdxId -> Maybe NExpr
lookupSpdxId Text
lic (LicensesBySpdxId Map Text NixpkgsLicense
licSet) =
  Map Text NixpkgsLicense
licSet
  Map Text NixpkgsLicense
-> (Map Text NixpkgsLicense -> Maybe NixpkgsLicense)
-> Maybe NixpkgsLicense
forall a b. a -> (a -> b) -> b
& Text -> Map Text NixpkgsLicense -> Maybe NixpkgsLicense
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Text
lic
  Maybe NixpkgsLicense -> (NixpkgsLicense -> NExpr) -> Maybe NExpr
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> NixpkgsLicense -> NExpr
nixpkgsLicenseExpression