{-# LANGUAGE DeriveAnyClass #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE StaticPointers #-}
{-# LANGUAGE TemplateHaskell #-}

module Control.Distributed.Dataset.OpenDatasets.GHArchive.Types where

import Codec.Serialise (Serialise)
import Control.Distributed.Dataset
  ( Dict (Dict),
    StaticSerialise (staticSerialise),
  )
import Control.Lens.TH (makeLenses, makePrisms)
import Data.Aeson ((.!=), (.:), (.:?), FromJSON (..), withObject)
import Data.Text (Text)
import GHC.Generics (Generic)

data GHEvent = GHEvent {GHEvent -> GHActor
_gheActor :: GHActor, GHEvent -> GHRepo
_gheRepo :: GHRepo, GHEvent -> GHEventType
_gheType :: GHEventType}
  deriving (GHEvent -> GHEvent -> Bool
(GHEvent -> GHEvent -> Bool)
-> (GHEvent -> GHEvent -> Bool) -> Eq GHEvent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHEvent -> GHEvent -> Bool
$c/= :: GHEvent -> GHEvent -> Bool
== :: GHEvent -> GHEvent -> Bool
$c== :: GHEvent -> GHEvent -> Bool
Eq, Int -> GHEvent -> ShowS
[GHEvent] -> ShowS
GHEvent -> String
(Int -> GHEvent -> ShowS)
-> (GHEvent -> String) -> ([GHEvent] -> ShowS) -> Show GHEvent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHEvent] -> ShowS
$cshowList :: [GHEvent] -> ShowS
show :: GHEvent -> String
$cshow :: GHEvent -> String
showsPrec :: Int -> GHEvent -> ShowS
$cshowsPrec :: Int -> GHEvent -> ShowS
Show, (forall x. GHEvent -> Rep GHEvent x)
-> (forall x. Rep GHEvent x -> GHEvent) -> Generic GHEvent
forall x. Rep GHEvent x -> GHEvent
forall x. GHEvent -> Rep GHEvent x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHEvent x -> GHEvent
$cfrom :: forall x. GHEvent -> Rep GHEvent x
Generic, [GHEvent] -> Encoding
GHEvent -> Encoding
(GHEvent -> Encoding)
-> (forall s. Decoder s GHEvent)
-> ([GHEvent] -> Encoding)
-> (forall s. Decoder s [GHEvent])
-> Serialise GHEvent
forall s. Decoder s [GHEvent]
forall s. Decoder s GHEvent
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHEvent]
$cdecodeList :: forall s. Decoder s [GHEvent]
encodeList :: [GHEvent] -> Encoding
$cencodeList :: [GHEvent] -> Encoding
decode :: Decoder s GHEvent
$cdecode :: forall s. Decoder s GHEvent
encode :: GHEvent -> Encoding
$cencode :: GHEvent -> Encoding
Serialise)

instance StaticSerialise GHEvent where
  staticSerialise :: Closure (Dict (Typeable GHEvent, Serialise GHEvent))
staticSerialise = static Dict (Typeable GHEvent, Serialise GHEvent)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHEvent where
  parseJSON :: Value -> Parser GHEvent
parseJSON Value
val =
    String -> (Object -> Parser GHEvent) -> Value -> Parser GHEvent
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"GHEvent"
      ( \Object
obj ->
          GHActor -> GHRepo -> GHEventType -> GHEvent
GHEvent
            (GHActor -> GHRepo -> GHEventType -> GHEvent)
-> Parser GHActor -> Parser (GHRepo -> GHEventType -> GHEvent)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj
            Object -> Text -> Parser GHActor
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"actor"
            Parser (GHRepo -> GHEventType -> GHEvent)
-> Parser GHRepo -> Parser (GHEventType -> GHEvent)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj
            Object -> Text -> Parser GHRepo
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"repo"
            Parser (GHEventType -> GHEvent)
-> Parser GHEventType -> Parser GHEvent
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser GHEventType
forall a. FromJSON a => Value -> Parser a
parseJSON Value
val
      )
      Value
val

data GHEventType
  = GHPushEvent GHPushEventPayload
  | GHOtherEvent Text
  deriving (GHEventType -> GHEventType -> Bool
(GHEventType -> GHEventType -> Bool)
-> (GHEventType -> GHEventType -> Bool) -> Eq GHEventType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHEventType -> GHEventType -> Bool
$c/= :: GHEventType -> GHEventType -> Bool
== :: GHEventType -> GHEventType -> Bool
$c== :: GHEventType -> GHEventType -> Bool
Eq, Int -> GHEventType -> ShowS
[GHEventType] -> ShowS
GHEventType -> String
(Int -> GHEventType -> ShowS)
-> (GHEventType -> String)
-> ([GHEventType] -> ShowS)
-> Show GHEventType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHEventType] -> ShowS
$cshowList :: [GHEventType] -> ShowS
show :: GHEventType -> String
$cshow :: GHEventType -> String
showsPrec :: Int -> GHEventType -> ShowS
$cshowsPrec :: Int -> GHEventType -> ShowS
Show, (forall x. GHEventType -> Rep GHEventType x)
-> (forall x. Rep GHEventType x -> GHEventType)
-> Generic GHEventType
forall x. Rep GHEventType x -> GHEventType
forall x. GHEventType -> Rep GHEventType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHEventType x -> GHEventType
$cfrom :: forall x. GHEventType -> Rep GHEventType x
Generic, [GHEventType] -> Encoding
GHEventType -> Encoding
(GHEventType -> Encoding)
-> (forall s. Decoder s GHEventType)
-> ([GHEventType] -> Encoding)
-> (forall s. Decoder s [GHEventType])
-> Serialise GHEventType
forall s. Decoder s [GHEventType]
forall s. Decoder s GHEventType
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHEventType]
$cdecodeList :: forall s. Decoder s [GHEventType]
encodeList :: [GHEventType] -> Encoding
$cencodeList :: [GHEventType] -> Encoding
decode :: Decoder s GHEventType
$cdecode :: forall s. Decoder s GHEventType
encode :: GHEventType -> Encoding
$cencode :: GHEventType -> Encoding
Serialise)

instance StaticSerialise GHEventType where
  staticSerialise :: Closure (Dict (Typeable GHEventType, Serialise GHEventType))
staticSerialise = static Dict (Typeable GHEventType, Serialise GHEventType)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHEventType where
  parseJSON :: Value -> Parser GHEventType
parseJSON =
    String
-> (Object -> Parser GHEventType) -> Value -> Parser GHEventType
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject
      String
"GHEventType"
      ( \Object
obj -> do
          Text
ty <- Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"type"
          Value
payload <- Object
obj Object -> Text -> Parser Value
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"payload"
          case Text
ty of
            Text
"PushEvent" -> GHPushEventPayload -> GHEventType
GHPushEvent (GHPushEventPayload -> GHEventType)
-> Parser GHPushEventPayload -> Parser GHEventType
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser GHPushEventPayload
forall a. FromJSON a => Value -> Parser a
parseJSON Value
payload
            Text
other -> GHEventType -> Parser GHEventType
forall (m :: * -> *) a. Monad m => a -> m a
return (GHEventType -> Parser GHEventType)
-> GHEventType -> Parser GHEventType
forall a b. (a -> b) -> a -> b
$ Text -> GHEventType
GHOtherEvent Text
other
      )

newtype GHPushEventPayload = GHPushEventPayload {GHPushEventPayload -> [GHCommit]
_ghpepCommits :: [GHCommit]}
  deriving (GHPushEventPayload -> GHPushEventPayload -> Bool
(GHPushEventPayload -> GHPushEventPayload -> Bool)
-> (GHPushEventPayload -> GHPushEventPayload -> Bool)
-> Eq GHPushEventPayload
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHPushEventPayload -> GHPushEventPayload -> Bool
$c/= :: GHPushEventPayload -> GHPushEventPayload -> Bool
== :: GHPushEventPayload -> GHPushEventPayload -> Bool
$c== :: GHPushEventPayload -> GHPushEventPayload -> Bool
Eq, Int -> GHPushEventPayload -> ShowS
[GHPushEventPayload] -> ShowS
GHPushEventPayload -> String
(Int -> GHPushEventPayload -> ShowS)
-> (GHPushEventPayload -> String)
-> ([GHPushEventPayload] -> ShowS)
-> Show GHPushEventPayload
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHPushEventPayload] -> ShowS
$cshowList :: [GHPushEventPayload] -> ShowS
show :: GHPushEventPayload -> String
$cshow :: GHPushEventPayload -> String
showsPrec :: Int -> GHPushEventPayload -> ShowS
$cshowsPrec :: Int -> GHPushEventPayload -> ShowS
Show, (forall x. GHPushEventPayload -> Rep GHPushEventPayload x)
-> (forall x. Rep GHPushEventPayload x -> GHPushEventPayload)
-> Generic GHPushEventPayload
forall x. Rep GHPushEventPayload x -> GHPushEventPayload
forall x. GHPushEventPayload -> Rep GHPushEventPayload x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHPushEventPayload x -> GHPushEventPayload
$cfrom :: forall x. GHPushEventPayload -> Rep GHPushEventPayload x
Generic, [GHPushEventPayload] -> Encoding
GHPushEventPayload -> Encoding
(GHPushEventPayload -> Encoding)
-> (forall s. Decoder s GHPushEventPayload)
-> ([GHPushEventPayload] -> Encoding)
-> (forall s. Decoder s [GHPushEventPayload])
-> Serialise GHPushEventPayload
forall s. Decoder s [GHPushEventPayload]
forall s. Decoder s GHPushEventPayload
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHPushEventPayload]
$cdecodeList :: forall s. Decoder s [GHPushEventPayload]
encodeList :: [GHPushEventPayload] -> Encoding
$cencodeList :: [GHPushEventPayload] -> Encoding
decode :: Decoder s GHPushEventPayload
$cdecode :: forall s. Decoder s GHPushEventPayload
encode :: GHPushEventPayload -> Encoding
$cencode :: GHPushEventPayload -> Encoding
Serialise)

instance StaticSerialise GHPushEventPayload where
  staticSerialise :: Closure
  (Dict (Typeable GHPushEventPayload, Serialise GHPushEventPayload))
staticSerialise = static Dict (Typeable GHPushEventPayload, Serialise GHPushEventPayload)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHPushEventPayload where
  parseJSON :: Value -> Parser GHPushEventPayload
parseJSON =
    String
-> (Object -> Parser GHPushEventPayload)
-> Value
-> Parser GHPushEventPayload
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GHPushEventPayload" ((Object -> Parser GHPushEventPayload)
 -> Value -> Parser GHPushEventPayload)
-> (Object -> Parser GHPushEventPayload)
-> Value
-> Parser GHPushEventPayload
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      [GHCommit] -> GHPushEventPayload
GHPushEventPayload
        ([GHCommit] -> GHPushEventPayload)
-> Parser [GHCommit] -> Parser GHPushEventPayload
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser [GHCommit]
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"commits"

data GHCommit
  = GHCommit
      { GHCommit -> GHCommitAuthor
_ghcAuthor :: GHCommitAuthor,
        GHCommit -> Text
_ghcMessage :: Text,
        GHCommit -> Text
_ghcSha :: Text,
        GHCommit -> Bool
_ghcDistinct :: Bool
      }
  deriving (GHCommit -> GHCommit -> Bool
(GHCommit -> GHCommit -> Bool)
-> (GHCommit -> GHCommit -> Bool) -> Eq GHCommit
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHCommit -> GHCommit -> Bool
$c/= :: GHCommit -> GHCommit -> Bool
== :: GHCommit -> GHCommit -> Bool
$c== :: GHCommit -> GHCommit -> Bool
Eq, Int -> GHCommit -> ShowS
[GHCommit] -> ShowS
GHCommit -> String
(Int -> GHCommit -> ShowS)
-> (GHCommit -> String) -> ([GHCommit] -> ShowS) -> Show GHCommit
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHCommit] -> ShowS
$cshowList :: [GHCommit] -> ShowS
show :: GHCommit -> String
$cshow :: GHCommit -> String
showsPrec :: Int -> GHCommit -> ShowS
$cshowsPrec :: Int -> GHCommit -> ShowS
Show, (forall x. GHCommit -> Rep GHCommit x)
-> (forall x. Rep GHCommit x -> GHCommit) -> Generic GHCommit
forall x. Rep GHCommit x -> GHCommit
forall x. GHCommit -> Rep GHCommit x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHCommit x -> GHCommit
$cfrom :: forall x. GHCommit -> Rep GHCommit x
Generic, [GHCommit] -> Encoding
GHCommit -> Encoding
(GHCommit -> Encoding)
-> (forall s. Decoder s GHCommit)
-> ([GHCommit] -> Encoding)
-> (forall s. Decoder s [GHCommit])
-> Serialise GHCommit
forall s. Decoder s [GHCommit]
forall s. Decoder s GHCommit
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHCommit]
$cdecodeList :: forall s. Decoder s [GHCommit]
encodeList :: [GHCommit] -> Encoding
$cencodeList :: [GHCommit] -> Encoding
decode :: Decoder s GHCommit
$cdecode :: forall s. Decoder s GHCommit
encode :: GHCommit -> Encoding
$cencode :: GHCommit -> Encoding
Serialise)

instance StaticSerialise GHCommit where
  staticSerialise :: Closure (Dict (Typeable GHCommit, Serialise GHCommit))
staticSerialise = static Dict (Typeable GHCommit, Serialise GHCommit)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHCommit where
  parseJSON :: Value -> Parser GHCommit
parseJSON =
    String -> (Object -> Parser GHCommit) -> Value -> Parser GHCommit
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GHCommit" ((Object -> Parser GHCommit) -> Value -> Parser GHCommit)
-> (Object -> Parser GHCommit) -> Value -> Parser GHCommit
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      GHCommitAuthor -> Text -> Text -> Bool -> GHCommit
GHCommit
        (GHCommitAuthor -> Text -> Text -> Bool -> GHCommit)
-> Parser GHCommitAuthor
-> Parser (Text -> Text -> Bool -> GHCommit)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser GHCommitAuthor
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"author"
        Parser (Text -> Text -> Bool -> GHCommit)
-> Parser Text -> Parser (Text -> Bool -> GHCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"message"
        Parser (Text -> Bool -> GHCommit)
-> Parser Text -> Parser (Bool -> GHCommit)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"sha"
        Parser (Bool -> GHCommit) -> Parser Bool -> Parser GHCommit
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"distinct" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
True

data GHCommitAuthor = GHCommitAuthor {GHCommitAuthor -> Text
_ghcaEmail :: Text, GHCommitAuthor -> Text
_ghcaName :: Text}
  deriving (GHCommitAuthor -> GHCommitAuthor -> Bool
(GHCommitAuthor -> GHCommitAuthor -> Bool)
-> (GHCommitAuthor -> GHCommitAuthor -> Bool) -> Eq GHCommitAuthor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHCommitAuthor -> GHCommitAuthor -> Bool
$c/= :: GHCommitAuthor -> GHCommitAuthor -> Bool
== :: GHCommitAuthor -> GHCommitAuthor -> Bool
$c== :: GHCommitAuthor -> GHCommitAuthor -> Bool
Eq, Int -> GHCommitAuthor -> ShowS
[GHCommitAuthor] -> ShowS
GHCommitAuthor -> String
(Int -> GHCommitAuthor -> ShowS)
-> (GHCommitAuthor -> String)
-> ([GHCommitAuthor] -> ShowS)
-> Show GHCommitAuthor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHCommitAuthor] -> ShowS
$cshowList :: [GHCommitAuthor] -> ShowS
show :: GHCommitAuthor -> String
$cshow :: GHCommitAuthor -> String
showsPrec :: Int -> GHCommitAuthor -> ShowS
$cshowsPrec :: Int -> GHCommitAuthor -> ShowS
Show, (forall x. GHCommitAuthor -> Rep GHCommitAuthor x)
-> (forall x. Rep GHCommitAuthor x -> GHCommitAuthor)
-> Generic GHCommitAuthor
forall x. Rep GHCommitAuthor x -> GHCommitAuthor
forall x. GHCommitAuthor -> Rep GHCommitAuthor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHCommitAuthor x -> GHCommitAuthor
$cfrom :: forall x. GHCommitAuthor -> Rep GHCommitAuthor x
Generic, [GHCommitAuthor] -> Encoding
GHCommitAuthor -> Encoding
(GHCommitAuthor -> Encoding)
-> (forall s. Decoder s GHCommitAuthor)
-> ([GHCommitAuthor] -> Encoding)
-> (forall s. Decoder s [GHCommitAuthor])
-> Serialise GHCommitAuthor
forall s. Decoder s [GHCommitAuthor]
forall s. Decoder s GHCommitAuthor
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHCommitAuthor]
$cdecodeList :: forall s. Decoder s [GHCommitAuthor]
encodeList :: [GHCommitAuthor] -> Encoding
$cencodeList :: [GHCommitAuthor] -> Encoding
decode :: Decoder s GHCommitAuthor
$cdecode :: forall s. Decoder s GHCommitAuthor
encode :: GHCommitAuthor -> Encoding
$cencode :: GHCommitAuthor -> Encoding
Serialise)

instance StaticSerialise GHCommitAuthor where
  staticSerialise :: Closure (Dict (Typeable GHCommitAuthor, Serialise GHCommitAuthor))
staticSerialise = static Dict (Typeable GHCommitAuthor, Serialise GHCommitAuthor)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHCommitAuthor where
  parseJSON :: Value -> Parser GHCommitAuthor
parseJSON =
    String
-> (Object -> Parser GHCommitAuthor)
-> Value
-> Parser GHCommitAuthor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GHCommitAuthor" ((Object -> Parser GHCommitAuthor)
 -> Value -> Parser GHCommitAuthor)
-> (Object -> Parser GHCommitAuthor)
-> Value
-> Parser GHCommitAuthor
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      Text -> Text -> GHCommitAuthor
GHCommitAuthor
        (Text -> Text -> GHCommitAuthor)
-> Parser Text -> Parser (Text -> GHCommitAuthor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"email"
        Parser (Text -> GHCommitAuthor)
-> Parser Text -> Parser GHCommitAuthor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"

data GHActor = GHActor {GHActor -> Maybe Integer
_ghaId :: Maybe Integer, GHActor -> Maybe Text
_ghaLogin :: Maybe Text, GHActor -> Text
_ghaUrl :: Text}
  deriving (GHActor -> GHActor -> Bool
(GHActor -> GHActor -> Bool)
-> (GHActor -> GHActor -> Bool) -> Eq GHActor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHActor -> GHActor -> Bool
$c/= :: GHActor -> GHActor -> Bool
== :: GHActor -> GHActor -> Bool
$c== :: GHActor -> GHActor -> Bool
Eq, Int -> GHActor -> ShowS
[GHActor] -> ShowS
GHActor -> String
(Int -> GHActor -> ShowS)
-> (GHActor -> String) -> ([GHActor] -> ShowS) -> Show GHActor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHActor] -> ShowS
$cshowList :: [GHActor] -> ShowS
show :: GHActor -> String
$cshow :: GHActor -> String
showsPrec :: Int -> GHActor -> ShowS
$cshowsPrec :: Int -> GHActor -> ShowS
Show, (forall x. GHActor -> Rep GHActor x)
-> (forall x. Rep GHActor x -> GHActor) -> Generic GHActor
forall x. Rep GHActor x -> GHActor
forall x. GHActor -> Rep GHActor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHActor x -> GHActor
$cfrom :: forall x. GHActor -> Rep GHActor x
Generic, [GHActor] -> Encoding
GHActor -> Encoding
(GHActor -> Encoding)
-> (forall s. Decoder s GHActor)
-> ([GHActor] -> Encoding)
-> (forall s. Decoder s [GHActor])
-> Serialise GHActor
forall s. Decoder s [GHActor]
forall s. Decoder s GHActor
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHActor]
$cdecodeList :: forall s. Decoder s [GHActor]
encodeList :: [GHActor] -> Encoding
$cencodeList :: [GHActor] -> Encoding
decode :: Decoder s GHActor
$cdecode :: forall s. Decoder s GHActor
encode :: GHActor -> Encoding
$cencode :: GHActor -> Encoding
Serialise)

instance StaticSerialise GHActor where
  staticSerialise :: Closure (Dict (Typeable GHActor, Serialise GHActor))
staticSerialise = static Dict (Typeable GHActor, Serialise GHActor)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHActor where
  parseJSON :: Value -> Parser GHActor
parseJSON =
    String -> (Object -> Parser GHActor) -> Value -> Parser GHActor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GHActor" ((Object -> Parser GHActor) -> Value -> Parser GHActor)
-> (Object -> Parser GHActor) -> Value -> Parser GHActor
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      Maybe Integer -> Maybe Text -> Text -> GHActor
GHActor
        (Maybe Integer -> Maybe Text -> Text -> GHActor)
-> Parser (Maybe Integer) -> Parser (Maybe Text -> Text -> GHActor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"id"
        Parser (Maybe Text -> Text -> GHActor)
-> Parser (Maybe Text) -> Parser (Text -> GHActor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? Text
"login"
        Parser (Text -> GHActor) -> Parser Text -> Parser GHActor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"url"

data GHRepo = GHRepo {GHRepo -> Integer
_ghrId :: Integer, GHRepo -> Text
_ghrName :: Text}
  deriving (GHRepo -> GHRepo -> Bool
(GHRepo -> GHRepo -> Bool)
-> (GHRepo -> GHRepo -> Bool) -> Eq GHRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GHRepo -> GHRepo -> Bool
$c/= :: GHRepo -> GHRepo -> Bool
== :: GHRepo -> GHRepo -> Bool
$c== :: GHRepo -> GHRepo -> Bool
Eq, Int -> GHRepo -> ShowS
[GHRepo] -> ShowS
GHRepo -> String
(Int -> GHRepo -> ShowS)
-> (GHRepo -> String) -> ([GHRepo] -> ShowS) -> Show GHRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GHRepo] -> ShowS
$cshowList :: [GHRepo] -> ShowS
show :: GHRepo -> String
$cshow :: GHRepo -> String
showsPrec :: Int -> GHRepo -> ShowS
$cshowsPrec :: Int -> GHRepo -> ShowS
Show, (forall x. GHRepo -> Rep GHRepo x)
-> (forall x. Rep GHRepo x -> GHRepo) -> Generic GHRepo
forall x. Rep GHRepo x -> GHRepo
forall x. GHRepo -> Rep GHRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GHRepo x -> GHRepo
$cfrom :: forall x. GHRepo -> Rep GHRepo x
Generic, [GHRepo] -> Encoding
GHRepo -> Encoding
(GHRepo -> Encoding)
-> (forall s. Decoder s GHRepo)
-> ([GHRepo] -> Encoding)
-> (forall s. Decoder s [GHRepo])
-> Serialise GHRepo
forall s. Decoder s [GHRepo]
forall s. Decoder s GHRepo
forall a.
(a -> Encoding)
-> (forall s. Decoder s a)
-> ([a] -> Encoding)
-> (forall s. Decoder s [a])
-> Serialise a
decodeList :: Decoder s [GHRepo]
$cdecodeList :: forall s. Decoder s [GHRepo]
encodeList :: [GHRepo] -> Encoding
$cencodeList :: [GHRepo] -> Encoding
decode :: Decoder s GHRepo
$cdecode :: forall s. Decoder s GHRepo
encode :: GHRepo -> Encoding
$cencode :: GHRepo -> Encoding
Serialise)

instance StaticSerialise GHRepo where
  staticSerialise :: Closure (Dict (Typeable GHRepo, Serialise GHRepo))
staticSerialise = static Dict (Typeable GHRepo, Serialise GHRepo)
forall (a :: Constraint). a => Dict a
Dict

instance FromJSON GHRepo where
  parseJSON :: Value -> Parser GHRepo
parseJSON =
    String -> (Object -> Parser GHRepo) -> Value -> Parser GHRepo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"GHRepo" ((Object -> Parser GHRepo) -> Value -> Parser GHRepo)
-> (Object -> Parser GHRepo) -> Value -> Parser GHRepo
forall a b. (a -> b) -> a -> b
$ \Object
obj ->
      Integer -> Text -> GHRepo
GHRepo
        (Integer -> Text -> GHRepo)
-> Parser Integer -> Parser (Text -> GHRepo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
obj Object -> Text -> Parser Integer
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"id"
        Parser (Text -> GHRepo) -> Parser Text -> Parser GHRepo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
obj Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"name"

makeLenses ''GHEvent

makePrisms ''GHEventType

makeLenses ''GHPushEventPayload

makeLenses ''GHCommit

makeLenses ''GHCommitAuthor

makeLenses ''GHActor

makeLenses ''GHRepo