{-|
Module      : Portage.Cabal
License     : GPL-3+
Maintainer  : haskell@gentoo.org

Utilities to extract and manipulate information from a package's @.cabal@ file,
such as its license and dependencies.
-}
module Portage.Cabal
  ( convertLicense
  , partition_depends
  ) where

import qualified Data.List as L

import qualified Distribution.License as Cabal
import qualified Distribution.SPDX    as SPDX
import qualified Distribution.Package as Cabal
import qualified Distribution.Pretty  as Cabal

-- | Convert the Cabal 'SPDX.License' into the Gentoo format, as a 'String'.
--
-- Generally, if the license is one of the common free-software or
-- open-source licenses, 'convertLicense' should return the license
-- as a 'Right' 'String':
--
-- >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.GPL_3_0_or_later)
-- Right "GPL-3+"
--
-- >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.GPL_3_0_only)
-- Right "GPL-3"
--
-- If it is a more obscure license, this should alert the user by returning
-- a 'Left' 'String':
--
-- >>> convertLicense (SPDX.License $ SPDX.simpleLicenseExpression SPDX.EUPL_1_1)
-- Left ...
convertLicense :: SPDX.License -> Either String String
convertLicense :: License -> Either String String
convertLicense License
l =
    case License -> License
Cabal.licenseFromSPDX License
l of
        --  good ones
        Cabal.AGPL Maybe Version
mv      -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"AGPL-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Version -> String
forall a. Pretty a => a -> String
Cabal.prettyShow (Version -> String) -> Maybe Version -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version
mv of
                                                  Just String
"3"   -> String
"3"
                                                  Just String
"3.0" -> String
"3+"
                                                  Maybe String
_          -> String
"3" -- almost certainly version 3
        Cabal.GPL Maybe Version
mv       -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"GPL-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Version -> String
forall a. Pretty a => a -> String
Cabal.prettyShow (Version -> String) -> Maybe Version -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version
mv of
                                                  Just String
"2"   -> String
"2"
                                                  Just String
"2.0" -> String
"2+"
                                                  Just String
"3"   -> String
"3"
                                                  Just String
"3.0" -> String
"3+"
                                                  Maybe String
_          -> String
"2" -- possibly version 2
        Cabal.LGPL Maybe Version
mv      -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"LGPL-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ case Version -> String
forall a. Pretty a => a -> String
Cabal.prettyShow (Version -> String) -> Maybe Version -> Maybe String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Version
mv of
                                                   Just String
"2"   -> String
"2"
                                                   -- Cabal can't handle 2.0+ properly
                                                   Just String
"2.0" -> String
"2"
                                                   Just String
"3"   -> String
"3"
                                                   Just String
"3.0" -> String
"3+"
                                                   Maybe String
_          -> String
"2.1" -- probably version 2.1
        License
Cabal.BSD2         -> String -> Either String String
forall a b. b -> Either a b
Right String
"BSD-2"
        License
Cabal.BSD3         -> String -> Either String String
forall a b. b -> Either a b
Right String
"BSD"
        License
Cabal.BSD4         -> String -> Either String String
forall a b. b -> Either a b
Right String
"BSD-4"
        License
Cabal.PublicDomain -> String -> Either String String
forall a b. b -> Either a b
Right String
"public-domain"
        License
Cabal.MIT          -> String -> Either String String
forall a b. b -> Either a b
Right String
"MIT"
        Cabal.Apache Maybe Version
mv    -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"Apache-" String -> String -> String
forall a. [a] -> [a] -> [a]
++
                              String -> (Version -> String) -> Maybe Version -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"1.1" Version -> String
forall a. Pretty a => a -> String
Cabal.prettyShow Maybe Version
mv -- probably version 1.1
        License
Cabal.ISC          -> String -> Either String String
forall a b. b -> Either a b
Right String
"ISC"
        Cabal.MPL Version
v        -> String -> Either String String
forall a b. b -> Either a b
Right (String -> Either String String) -> String -> Either String String
forall a b. (a -> b) -> a -> b
$ String
"MPL-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Version -> String
forall a. Pretty a => a -> String
Cabal.prettyShow Version
v -- probably version 1.0
        -- bad ones
        License
Cabal.AllRightsReserved -> String -> Either String String
forall a b. a -> Either a b
Left String
"EULA-style licence. Please pick it manually."
        Cabal.UnknownLicense String
_  -> String -> Either String String
forall a b. a -> Either a b
Left String
"license unknown to cabal. Please pick it manually."
        License
Cabal.OtherLicense      -> String -> Either String String
forall a b. a -> Either a b
Left String
"(Other) Please look at license file of package and pick it manually."
        License
Cabal.UnspecifiedLicense -> String -> Either String String
forall a b. a -> Either a b
Left String
"(Unspecified) Please look at license file of package and pick it manually."

-- | Extract only the dependencies which are not bundled with @GHC@.
partition_depends :: [Cabal.PackageName] -> Cabal.PackageName -> [Cabal.Dependency] -> ([Cabal.Dependency], [Cabal.Dependency])
partition_depends :: [PackageName]
-> PackageName -> [Dependency] -> ([Dependency], [Dependency])
partition_depends [PackageName]
ghc_package_names PackageName
merged_cabal_pkg_name = (Dependency -> Bool)
-> [Dependency] -> ([Dependency], [Dependency])
forall a. (a -> Bool) -> [a] -> ([a], [a])
L.partition (Bool -> Bool
not (Bool -> Bool) -> (Dependency -> Bool) -> Dependency -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dependency -> Bool
is_internal_depend)
    where is_internal_depend :: Dependency -> Bool
is_internal_depend (Cabal.Dependency PackageName
pn VersionRange
_vr NonEmptySet LibraryName
_lib) = Bool
is_itself Bool -> Bool -> Bool
|| Bool
is_ghc_package
              where is_itself :: Bool
is_itself = PackageName
pn PackageName -> PackageName -> Bool
forall a. Eq a => a -> a -> Bool
== PackageName
merged_cabal_pkg_name
                    is_ghc_package :: Bool
is_ghc_package = PackageName
pn PackageName -> [PackageName] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PackageName]
ghc_package_names