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
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"
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
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
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
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
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"
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