{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards   #-}
{-# LANGUAGE StrictData        #-}
module GitHub.Types.Base.License where

import           Data.Aeson                (FromJSON (..), ToJSON (..), object)
import           Data.Aeson.Types          (Value (..), (.:), (.=))
import           Data.Text                 (Text)
import           Data.Text.Arbitrary       ()
import           Test.QuickCheck.Arbitrary (Arbitrary (..))

------------------------------------------------------------------------------
-- License

data License = License
    { License -> Text
licenseKey    :: Text
    , License -> Text
licenseName   :: Text
    , License -> Text
licenseNodeId :: Text
    , License -> Maybe Text
licenseSpdxId :: Maybe Text
    , License -> Maybe Text
licenseUrl    :: Maybe Text
    } deriving (License -> License -> Bool
(License -> License -> Bool)
-> (License -> License -> Bool) -> Eq License
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: License -> License -> Bool
$c/= :: License -> License -> Bool
== :: License -> License -> Bool
$c== :: License -> License -> Bool
Eq, 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, ReadPrec [License]
ReadPrec License
Int -> ReadS License
ReadS [License]
(Int -> ReadS License)
-> ReadS [License]
-> ReadPrec License
-> ReadPrec [License]
-> Read License
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [License]
$creadListPrec :: ReadPrec [License]
readPrec :: ReadPrec License
$creadPrec :: ReadPrec License
readList :: ReadS [License]
$creadList :: ReadS [License]
readsPrec :: Int -> ReadS License
$creadsPrec :: Int -> ReadS License
Read)


instance FromJSON License where
    parseJSON :: Value -> Parser License
parseJSON (Object Object
x) = Text -> Text -> Text -> Maybe Text -> Maybe Text -> License
License
        (Text -> Text -> Text -> Maybe Text -> Maybe Text -> License)
-> Parser Text
-> Parser (Text -> Text -> Maybe Text -> Maybe Text -> License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"key"
        Parser (Text -> Text -> Maybe Text -> Maybe Text -> License)
-> Parser Text
-> Parser (Text -> Maybe Text -> Maybe Text -> License)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
        Parser (Text -> Maybe Text -> Maybe Text -> License)
-> Parser Text -> Parser (Maybe Text -> Maybe Text -> License)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"node_id"
        Parser (Maybe Text -> Maybe Text -> License)
-> Parser (Maybe Text) -> Parser (Maybe Text -> License)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"spdx_id"
        Parser (Maybe Text -> License)
-> Parser (Maybe Text) -> Parser License
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
x Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"

    parseJSON Value
_ = String -> Parser License
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"License"


instance ToJSON License where
    toJSON :: License -> Value
toJSON License{Maybe Text
Text
licenseUrl :: Maybe Text
licenseSpdxId :: Maybe Text
licenseNodeId :: Text
licenseName :: Text
licenseKey :: Text
licenseUrl :: License -> Maybe Text
licenseSpdxId :: License -> Maybe Text
licenseNodeId :: License -> Text
licenseName :: License -> Text
licenseKey :: License -> Text
..} = [Pair] -> Value
object
        [ Key
"key"     Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
licenseKey
        , Key
"name"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
licenseName
        , Key
"node_id" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
licenseNodeId
        , Key
"spdx_id" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
licenseSpdxId
        , Key
"url"     Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Maybe Text
licenseUrl
        ]

instance Arbitrary License where
    arbitrary :: Gen License
arbitrary = Text -> Text -> Text -> Maybe Text -> Maybe Text -> License
License
        (Text -> Text -> Text -> Maybe Text -> Maybe Text -> License)
-> Gen Text
-> Gen (Text -> Text -> Maybe Text -> Maybe Text -> License)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Text -> Maybe Text -> Maybe Text -> License)
-> Gen Text -> Gen (Text -> Maybe Text -> Maybe Text -> License)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Text -> Maybe Text -> Maybe Text -> License)
-> Gen Text -> Gen (Maybe Text -> Maybe Text -> License)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Text
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Maybe Text -> Maybe Text -> License)
-> Gen (Maybe Text) -> Gen (Maybe Text -> License)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Maybe Text -> License) -> Gen (Maybe Text) -> Gen License
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Text)
forall a. Arbitrary a => Gen a
arbitrary