{- |
Copyright: (c) 2017-2020 Kowainik
SPDX-License-Identifier: MPL-2.0
Maintainer: Kowainik <xrom.xkov@gmail.com>

Data types that represent license names and license content and functions
to work with them.
-}

module Summoner.License
       ( LicenseName(..)
       , License(..)
       , customizeLicense
       , githubLicenseQueryNames
       , parseLicenseName
       , fetchLicense
       , fetchLicenseCustom
       , licenseShortDesc
       , showLicenseWithDesc
       ) where

import Colourista (errorMessage)
import Data.Aeson (FromJSON (..), decodeStrict, withObject, (.:))
import Relude.Extra.Enum (inverseMap)
import Shellmet (($|))

import qualified Data.Text as T
import qualified Text.Show as TS


-- | Licenses supported by @summoner@.
data LicenseName
    = MIT
    | BSD2
    | BSD3
    | GPL2
    | GPL3
    | LGPL21
    | LGPL3
    | AGPL3
    | Apache20
    | MPL20
    | ISC
    | NONE
    deriving stock (LicenseName -> LicenseName -> Bool
(LicenseName -> LicenseName -> Bool)
-> (LicenseName -> LicenseName -> Bool) -> Eq LicenseName
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LicenseName -> LicenseName -> Bool
$c/= :: LicenseName -> LicenseName -> Bool
== :: LicenseName -> LicenseName -> Bool
$c== :: LicenseName -> LicenseName -> Bool
Eq, Eq LicenseName
Eq LicenseName =>
(LicenseName -> LicenseName -> Ordering)
-> (LicenseName -> LicenseName -> Bool)
-> (LicenseName -> LicenseName -> Bool)
-> (LicenseName -> LicenseName -> Bool)
-> (LicenseName -> LicenseName -> Bool)
-> (LicenseName -> LicenseName -> LicenseName)
-> (LicenseName -> LicenseName -> LicenseName)
-> Ord LicenseName
LicenseName -> LicenseName -> Bool
LicenseName -> LicenseName -> Ordering
LicenseName -> LicenseName -> LicenseName
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: LicenseName -> LicenseName -> LicenseName
$cmin :: LicenseName -> LicenseName -> LicenseName
max :: LicenseName -> LicenseName -> LicenseName
$cmax :: LicenseName -> LicenseName -> LicenseName
>= :: LicenseName -> LicenseName -> Bool
$c>= :: LicenseName -> LicenseName -> Bool
> :: LicenseName -> LicenseName -> Bool
$c> :: LicenseName -> LicenseName -> Bool
<= :: LicenseName -> LicenseName -> Bool
$c<= :: LicenseName -> LicenseName -> Bool
< :: LicenseName -> LicenseName -> Bool
$c< :: LicenseName -> LicenseName -> Bool
compare :: LicenseName -> LicenseName -> Ordering
$ccompare :: LicenseName -> LicenseName -> Ordering
$cp1Ord :: Eq LicenseName
Ord, Int -> LicenseName
LicenseName -> Int
LicenseName -> [LicenseName]
LicenseName -> LicenseName
LicenseName -> LicenseName -> [LicenseName]
LicenseName -> LicenseName -> LicenseName -> [LicenseName]
(LicenseName -> LicenseName)
-> (LicenseName -> LicenseName)
-> (Int -> LicenseName)
-> (LicenseName -> Int)
-> (LicenseName -> [LicenseName])
-> (LicenseName -> LicenseName -> [LicenseName])
-> (LicenseName -> LicenseName -> [LicenseName])
-> (LicenseName -> LicenseName -> LicenseName -> [LicenseName])
-> Enum LicenseName
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: LicenseName -> LicenseName -> LicenseName -> [LicenseName]
$cenumFromThenTo :: LicenseName -> LicenseName -> LicenseName -> [LicenseName]
enumFromTo :: LicenseName -> LicenseName -> [LicenseName]
$cenumFromTo :: LicenseName -> LicenseName -> [LicenseName]
enumFromThen :: LicenseName -> LicenseName -> [LicenseName]
$cenumFromThen :: LicenseName -> LicenseName -> [LicenseName]
enumFrom :: LicenseName -> [LicenseName]
$cenumFrom :: LicenseName -> [LicenseName]
fromEnum :: LicenseName -> Int
$cfromEnum :: LicenseName -> Int
toEnum :: Int -> LicenseName
$ctoEnum :: Int -> LicenseName
pred :: LicenseName -> LicenseName
$cpred :: LicenseName -> LicenseName
succ :: LicenseName -> LicenseName
$csucc :: LicenseName -> LicenseName
Enum, LicenseName
LicenseName -> LicenseName -> Bounded LicenseName
forall a. a -> a -> Bounded a
maxBound :: LicenseName
$cmaxBound :: LicenseName
minBound :: LicenseName
$cminBound :: LicenseName
Bounded, (forall x. LicenseName -> Rep LicenseName x)
-> (forall x. Rep LicenseName x -> LicenseName)
-> Generic LicenseName
forall x. Rep LicenseName x -> LicenseName
forall x. LicenseName -> Rep LicenseName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LicenseName x -> LicenseName
$cfrom :: forall x. LicenseName -> Rep LicenseName x
Generic)

instance Show LicenseName where
    show :: LicenseName -> String
show MIT      = "MIT"
    show BSD2     = "BSD-2-Clause"
    show BSD3     = "BSD-3-Clause"
    show GPL2     = "GPL-2.0-only"
    show GPL3     = "GPL-3.0-only"
    show LGPL21   = "LGPL-2.1-only"
    show LGPL3    = "LGPL-3.0-only"
    show AGPL3    = "AGPL-3.0-only"
    show Apache20 = "Apache-2.0"
    show MPL20    = "MPL-2.0"
    show ISC      = "ISC"
    show NONE     = "NONE"

newtype License = License
    { License -> Text
unLicense :: Text
    } deriving stock (Int -> License -> ShowS
[License] -> ShowS
License -> String
(Int -> License -> ShowS)
-> (License -> String) -> ([License] -> ShowS) -> Show License
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [License] -> ShowS
$cshowList :: [License] -> ShowS
show :: License -> String
$cshow :: License -> String
showsPrec :: Int -> License -> ShowS
$cshowsPrec :: Int -> License -> ShowS
Show, (forall x. License -> Rep License x)
-> (forall x. Rep License x -> License) -> Generic License
forall x. Rep License x -> License
forall x. License -> Rep License x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep License x -> License
$cfrom :: forall x. License -> Rep License x
Generic)
      deriving newtype (String -> License
(String -> License) -> IsString License
forall a. (String -> a) -> IsString a
fromString :: String -> License
$cfromString :: String -> License
IsString)

instance FromJSON License where
    parseJSON :: Value -> Parser License
parseJSON = String -> (Object -> Parser License) -> Value -> Parser License
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "License" ((Object -> Parser License) -> Value -> Parser License)
-> (Object -> Parser License) -> Value -> Parser License
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Text -> License
License (Text -> License) -> Parser Text -> Parser License
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "body"

-- | Used for downloading the license text form @Github@.
githubLicenseQueryNames :: LicenseName -> Text
githubLicenseQueryNames :: LicenseName -> Text
githubLicenseQueryNames = \case
    MIT      -> "mit"
    BSD2     -> "bsd-2-clause"
    BSD3     -> "bsd-3-clause"
    GPL2     -> "gpl-2.0"
    GPL3     -> "gpl-3.0"
    LGPL21   -> "lgpl-2.1"
    LGPL3    -> "lgpl-3.0"
    AGPL3    -> "agpl-3.0"
    Apache20 -> "apache-2.0"
    MPL20    -> "mpl-2.0"
    ISC      -> "isc"
    NONE     -> "none"

parseLicenseName :: Text -> Maybe LicenseName
parseLicenseName :: Text -> Maybe LicenseName
parseLicenseName = (LicenseName -> Text) -> Text -> Maybe LicenseName
forall a k. (Bounded a, Enum a, Ord k) => (a -> k) -> k -> Maybe a
inverseMap LicenseName -> Text
forall b a. (Show a, IsString b) => a -> b
show

-- | Replaces name/year placeholders with the actual data.
customizeLicense :: LicenseName -> License -> Text -> Text -> License
customizeLicense :: LicenseName -> License -> Text -> Text -> License
customizeLicense l :: LicenseName
l license :: License
license@(License licenseText :: Text
licenseText) nm :: Text
nm year :: Text
year
    | LicenseName
l LicenseName -> [LicenseName] -> Bool
forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [LicenseName
MIT, LicenseName
BSD2, LicenseName
BSD3, LicenseName
ISC] = Text -> License
License Text
updatedLicenseText
    | Bool
otherwise                  = License
license
  where
    updatedLicenseText :: Text
    updatedLicenseText :: Text
updatedLicenseText =
        let (beforeY :: Text
beforeY, withY :: Text
withY) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '[') Text
licenseText
            afterY :: Text
afterY           = Text -> Text
T.tail (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ']') Text
withY
            (beforeN :: Text
beforeN, withN :: Text
withN) = (Char -> Bool) -> Text -> (Text, Text)
T.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= '[') Text
afterY
            afterN :: Text
afterN           = Text -> Text
T.tail (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= ']') Text
withN
        in  Text
beforeY Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
year Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
beforeN Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nm Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
afterN

-- | Download the given LICENSE text as it is from GitHub API.
fetchLicense :: LicenseName -> IO License
fetchLicense :: LicenseName -> IO License
fetchLicense NONE = License -> IO License
forall (f :: * -> *) a. Applicative f => a -> f a
pure (License -> IO License) -> License -> IO License
forall a b. (a -> b) -> a -> b
$ Text -> License
License (Text -> License) -> Text -> License
forall a b. (a -> b) -> a -> b
$ LicenseName -> Text
licenseShortDesc LicenseName
NONE
fetchLicense name :: LicenseName
name = do
    let licenseLink :: Text
licenseLink = "https://api.github.com/licenses/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LicenseName -> Text
githubLicenseQueryNames LicenseName
name
    Text
licenseJson <- "curl" String -> [Text] -> IO Text
$|
        [ Text
licenseLink
        , "-H"
        , "Accept: application/vnd.github.drax-preview+json"
        , "--silent"
        , "--fail"
        ]

    Maybe License -> IO License -> IO License
forall (f :: * -> *) a. Applicative f => Maybe a -> f a -> f a
whenNothing (FromJSON License => ByteString -> Maybe License
forall a. FromJSON a => ByteString -> Maybe a
decodeStrict @License (ByteString -> Maybe License) -> ByteString -> Maybe License
forall a b. (a -> b) -> a -> b
$ Text -> ByteString
forall a b. ConvertUtf8 a b => a -> b
encodeUtf8 Text
licenseJson) (IO License -> IO License) -> IO License -> IO License
forall a b. (a -> b) -> a -> b
$ do
        Text -> IO ()
errorMessage (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Error downloading license: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LicenseName -> Text
forall b a. (Show a, IsString b) => a -> b
show LicenseName
name
        Text -> IO ()
forall (m :: * -> *). MonadIO m => Text -> m ()
putTextLn (Text -> IO ()) -> Text -> IO ()
forall a b. (a -> b) -> a -> b
$ "Fetched content:\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
licenseJson
        IO License
forall (m :: * -> *) a. MonadIO m => m a
exitFailure

{- | Fetches the license by given name and customises user information where
applicable.
-}
fetchLicenseCustom :: LicenseName -> Text -> Text -> IO License
fetchLicenseCustom :: LicenseName -> Text -> Text -> IO License
fetchLicenseCustom license :: LicenseName
license fullName :: Text
fullName year :: Text
year = do
    License
licenseText <- LicenseName -> IO License
fetchLicense LicenseName
license
    License -> IO License
forall (f :: * -> *) a. Applicative f => a -> f a
pure (License -> IO License) -> License -> IO License
forall a b. (a -> b) -> a -> b
$ LicenseName -> License -> Text -> Text -> License
customizeLicense LicenseName
license License
licenseText Text
fullName Text
year

-- | Show short information for the 'LicenseName'.
licenseShortDesc :: LicenseName -> Text
licenseShortDesc :: LicenseName -> Text
licenseShortDesc = \case
    MIT      -> "MIT license"
    BSD2     -> "2-clause BSD license"
    BSD3     -> "3-clause BSD license"
    GPL2     -> "GNU General Public License, version 2"
    GPL3     -> "GNU General Public License, version 3"
    LGPL21   -> "GNU Lesser General Public License, version 2.1"
    LGPL3    -> "GNU Lesser General Public License, version 3"
    AGPL3    -> "GNU Affero General Public License, version 3"
    Apache20 -> "Apache License, version 2.0"
    MPL20    -> "Mozilla Public License, version 2.0"
    ISC      -> "Internet Systems Consortium"
    NONE -> "License file won't be added. The package may not be legally \
        \modified or redistributed by anyone but the rightsholder"

-- | Show license name along with its short description.
showLicenseWithDesc :: LicenseName -> Text
showLicenseWithDesc :: LicenseName -> Text
showLicenseWithDesc l :: LicenseName
l = LicenseName -> Text
forall b a. (Show a, IsString b) => a -> b
show LicenseName
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> LicenseName -> Text
licenseShortDesc LicenseName
l