{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
module Hpack.License where

import           Control.Arrow ((&&&))

import           Distribution.Pretty (prettyShow)
import           Distribution.Version (mkVersion)
import qualified Distribution.License as Cabal
import qualified Distribution.SPDX.License as SPDX
import           Distribution.Parsec (eitherParsec)

import qualified Data.License.Infer as Infer

data License a = DontTouch String | CanSPDX Cabal.License a | MustSPDX a
  deriving (License a -> License a -> Bool
(License a -> License a -> Bool)
-> (License a -> License a -> Bool) -> Eq (License a)
forall a. Eq a => License a -> License a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: License a -> License a -> Bool
$c/= :: forall a. Eq a => License a -> License a -> Bool
== :: License a -> License a -> Bool
$c== :: forall a. Eq a => License a -> License a -> Bool
Eq, Int -> License a -> ShowS
[License a] -> ShowS
License a -> String
(Int -> License a -> ShowS)
-> (License a -> String)
-> ([License a] -> ShowS)
-> Show (License a)
forall a. Show a => Int -> License a -> ShowS
forall a. Show a => [License a] -> ShowS
forall a. Show a => License a -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [License a] -> ShowS
$cshowList :: forall a. Show a => [License a] -> ShowS
show :: License a -> String
$cshow :: forall a. Show a => License a -> String
showsPrec :: Int -> License a -> ShowS
$cshowsPrec :: forall a. Show a => Int -> License a -> ShowS
Show, a -> License b -> License a
(a -> b) -> License a -> License b
(forall a b. (a -> b) -> License a -> License b)
-> (forall a b. a -> License b -> License a) -> Functor License
forall a b. a -> License b -> License a
forall a b. (a -> b) -> License a -> License b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> License b -> License a
$c<$ :: forall a b. a -> License b -> License a
fmap :: (a -> b) -> License a -> License b
$cfmap :: forall a b. (a -> b) -> License a -> License b
Functor)

parseLicense :: String -> License SPDX.License
parseLicense :: String -> License License
parseLicense String
license = case String -> [(String, License)] -> Maybe License
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup String
license [(String, License)]
knownLicenses of
  Just License
l -> License -> License -> License License
forall a. License -> a -> License a
CanSPDX License
l (License -> License
Cabal.licenseToSPDX License
l)
  Maybe License
Nothing -> case Maybe License
spdxLicense of
    Just License
l -> License -> License License
forall a. a -> License a
MustSPDX License
l
    Maybe License
Nothing -> String -> License License
forall a. String -> License a
DontTouch String
license
  where
    knownLicenses :: [(String, Cabal.License)]
    knownLicenses :: [(String, License)]
knownLicenses = (License -> (String, License)) -> [License] -> [(String, License)]
forall a b. (a -> b) -> [a] -> [b]
map (License -> String
forall a. Pretty a => a -> String
prettyShow (License -> String)
-> (License -> License) -> License -> (String, License)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& License -> License
forall a. a -> a
id) (License
Cabal.BSD4 License -> [License] -> [License]
forall a. a -> [a] -> [a]
: [License]
Cabal.knownLicenses)

    spdxLicense :: Maybe SPDX.License
    spdxLicense :: Maybe License
spdxLicense  = (String -> Maybe License)
-> (License -> Maybe License)
-> Either String License
-> Maybe License
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Maybe License -> String -> Maybe License
forall a b. a -> b -> a
const Maybe License
forall a. Maybe a
Nothing) License -> Maybe License
forall a. a -> Maybe a
Just (String -> Either String License
forall a. Parsec a => String -> Either String a
eitherParsec String
license)

inferLicense :: String -> Maybe (License SPDX.License)
inferLicense :: String -> Maybe (License License)
inferLicense = (License -> License License)
-> Maybe License -> Maybe (License License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((License -> License -> License License)
-> (License, License) -> License License
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry License -> License -> License License
forall a. License -> a -> License a
CanSPDX ((License, License) -> License License)
-> (License -> (License, License)) -> License -> License License
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (License -> License
forall a. a -> a
id (License -> License)
-> (License -> License) -> License -> (License, License)
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& License -> License
Cabal.licenseToSPDX) (License -> (License, License))
-> (License -> License) -> License -> (License, License)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. License -> License
toLicense) (Maybe License -> Maybe (License License))
-> (String -> Maybe License) -> String -> Maybe (License License)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Maybe License
Infer.inferLicense
  where
    toLicense :: License -> License
toLicense = \ case
      License
Infer.MIT -> License
Cabal.MIT
      License
Infer.ISC -> License
Cabal.ISC
      License
Infer.BSD2 -> License
Cabal.BSD2
      License
Infer.BSD3 -> License
Cabal.BSD3
      License
Infer.BSD4 -> License
Cabal.BSD4
      License
Infer.Apache_2_0 -> Maybe Version -> License
Cabal.Apache (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
2,Int
0])
      License
Infer.MPL_2_0 -> Version -> License
Cabal.MPL ([Int] -> Version
mkVersion [Int
2,Int
0])
      License
Infer.GPLv2 -> Maybe Version -> License
Cabal.GPL (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
2])
      License
Infer.GPLv3 -> Maybe Version -> License
Cabal.GPL (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
3])
      License
Infer.LGPLv2_1 -> Maybe Version -> License
Cabal.LGPL (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
2,Int
1])
      License
Infer.LGPLv3 -> Maybe Version -> License
Cabal.LGPL (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
3])
      License
Infer.AGPLv3 -> Maybe Version -> License
Cabal.AGPL (Version -> Maybe Version
forall a. a -> Maybe a
Just (Version -> Maybe Version) -> Version -> Maybe Version
forall a b. (a -> b) -> a -> b
$ [Int] -> Version
mkVersion [Int
3])