{-# LANGUAGE CPP #-}
{-# LANGUAGE FlexibleInstances #-}
#define UNSAFE 1
module GitHub.Data.Repos where
import GitHub.Data.Definitions
import GitHub.Data.Id (Id)
import GitHub.Data.Name (Name)
import GitHub.Data.Request (IsPathPart (..))
import GitHub.Data.URL (URL)
import GitHub.Internal.Prelude
import Prelude ()
import qualified Data.HashMap.Strict as HM
#if MIN_VERSION_aeson(1,0,0)
import Data.Aeson.Types (FromJSONKey (..), fromJSONKeyCoerce)
#else
#ifdef UNSAFE
import Unsafe.Coerce (unsafeCoerce)
#endif
#endif
data Repo = Repo
{ Repo -> Maybe URL
repoSshUrl :: !(Maybe URL)
, Repo -> Maybe Text
repoDescription :: !(Maybe Text)
, Repo -> Maybe UTCTime
repoCreatedAt :: !(Maybe UTCTime)
, Repo -> URL
repoHtmlUrl :: !URL
, Repo -> Maybe URL
repoSvnUrl :: !(Maybe URL)
, Repo -> Maybe Int
repoForks :: !(Maybe Int)
, Repo -> Maybe Text
repoHomepage :: !(Maybe Text)
, Repo -> Maybe Bool
repoFork :: !(Maybe Bool)
, Repo -> Maybe URL
repoGitUrl :: !(Maybe URL)
, Repo -> Bool
repoPrivate :: !Bool
, Repo -> Bool
repoArchived :: !Bool
, Repo -> Maybe URL
repoCloneUrl :: !(Maybe URL)
, Repo -> Maybe Int
repoSize :: !(Maybe Int)
, Repo -> Maybe UTCTime
repoUpdatedAt :: !(Maybe UTCTime)
, Repo -> Maybe Int
repoWatchers :: !(Maybe Int)
, Repo -> SimpleOwner
repoOwner :: !SimpleOwner
, Repo -> Name Repo
repoName :: !(Name Repo)
, Repo -> Maybe Language
repoLanguage :: !(Maybe Language)
, Repo -> Maybe Text
repoDefaultBranch :: !(Maybe Text)
, Repo -> Maybe UTCTime
repoPushedAt :: !(Maybe UTCTime)
, Repo -> Id Repo
repoId :: !(Id Repo)
, Repo -> URL
repoUrl :: !URL
, Repo -> Maybe Int
repoOpenIssues :: !(Maybe Int)
, Repo -> Maybe Bool
repoHasWiki :: !(Maybe Bool)
, Repo -> Maybe Bool
repoHasIssues :: !(Maybe Bool)
, Repo -> Maybe Bool
repoHasDownloads :: !(Maybe Bool)
, Repo -> Maybe RepoRef
repoParent :: !(Maybe RepoRef)
, Repo -> Maybe RepoRef
repoSource :: !(Maybe RepoRef)
, Repo -> URL
repoHooksUrl :: !URL
, Repo -> Int
repoStargazersCount :: !Int
}
deriving (Int -> Repo -> ShowS
[Repo] -> ShowS
Repo -> String
(Int -> Repo -> ShowS)
-> (Repo -> String) -> ([Repo] -> ShowS) -> Show Repo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repo] -> ShowS
$cshowList :: [Repo] -> ShowS
show :: Repo -> String
$cshow :: Repo -> String
showsPrec :: Int -> Repo -> ShowS
$cshowsPrec :: Int -> Repo -> ShowS
Show, Typeable Repo
Constr
DataType
Typeable Repo =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Repo -> c Repo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Repo)
-> (Repo -> Constr)
-> (Repo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Repo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Repo))
-> ((forall b. Data b => b -> b) -> Repo -> Repo)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r)
-> (forall u. (forall d. Data d => d -> u) -> Repo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Repo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo)
-> Data Repo
Repo -> Constr
Repo -> DataType
(forall b. Data b => b -> b) -> Repo -> Repo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Repo -> c Repo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Repo
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Repo -> u
forall u. (forall d. Data d => d -> u) -> Repo -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Repo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Repo -> c Repo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Repo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Repo)
$cRepo :: Constr
$tRepo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Repo -> m Repo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo
gmapMp :: (forall d. Data d => d -> m d) -> Repo -> m Repo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo
gmapM :: (forall d. Data d => d -> m d) -> Repo -> m Repo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Repo -> m Repo
gmapQi :: Int -> (forall d. Data d => d -> u) -> Repo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Repo -> u
gmapQ :: (forall d. Data d => d -> u) -> Repo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Repo -> [u]
gmapQr :: (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r
gmapQl :: (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Repo -> r
gmapT :: (forall b. Data b => b -> b) -> Repo -> Repo
$cgmapT :: (forall b. Data b => b -> b) -> Repo -> Repo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Repo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Repo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Repo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Repo)
dataTypeOf :: Repo -> DataType
$cdataTypeOf :: Repo -> DataType
toConstr :: Repo -> Constr
$ctoConstr :: Repo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Repo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Repo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Repo -> c Repo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Repo -> c Repo
$cp1Data :: Typeable Repo
Data, Typeable, Repo -> Repo -> Bool
(Repo -> Repo -> Bool) -> (Repo -> Repo -> Bool) -> Eq Repo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repo -> Repo -> Bool
$c/= :: Repo -> Repo -> Bool
== :: Repo -> Repo -> Bool
$c== :: Repo -> Repo -> Bool
Eq, Eq Repo
Eq Repo =>
(Repo -> Repo -> Ordering)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Bool)
-> (Repo -> Repo -> Repo)
-> (Repo -> Repo -> Repo)
-> Ord Repo
Repo -> Repo -> Bool
Repo -> Repo -> Ordering
Repo -> Repo -> Repo
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 :: Repo -> Repo -> Repo
$cmin :: Repo -> Repo -> Repo
max :: Repo -> Repo -> Repo
$cmax :: Repo -> Repo -> Repo
>= :: Repo -> Repo -> Bool
$c>= :: Repo -> Repo -> Bool
> :: Repo -> Repo -> Bool
$c> :: Repo -> Repo -> Bool
<= :: Repo -> Repo -> Bool
$c<= :: Repo -> Repo -> Bool
< :: Repo -> Repo -> Bool
$c< :: Repo -> Repo -> Bool
compare :: Repo -> Repo -> Ordering
$ccompare :: Repo -> Repo -> Ordering
$cp1Ord :: Eq Repo
Ord, (forall x. Repo -> Rep Repo x)
-> (forall x. Rep Repo x -> Repo) -> Generic Repo
forall x. Rep Repo x -> Repo
forall x. Repo -> Rep Repo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Repo x -> Repo
$cfrom :: forall x. Repo -> Rep Repo x
Generic)
instance NFData Repo where rnf :: Repo -> ()
rnf = Repo -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Repo
data RepoRef = RepoRef
{ RepoRef -> SimpleOwner
repoRefOwner :: !SimpleOwner
, RepoRef -> Name Repo
repoRefRepo :: !(Name Repo)
}
deriving (Int -> RepoRef -> ShowS
[RepoRef] -> ShowS
RepoRef -> String
(Int -> RepoRef -> ShowS)
-> (RepoRef -> String) -> ([RepoRef] -> ShowS) -> Show RepoRef
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoRef] -> ShowS
$cshowList :: [RepoRef] -> ShowS
show :: RepoRef -> String
$cshow :: RepoRef -> String
showsPrec :: Int -> RepoRef -> ShowS
$cshowsPrec :: Int -> RepoRef -> ShowS
Show, Typeable RepoRef
Constr
DataType
Typeable RepoRef =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoRef -> c RepoRef)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoRef)
-> (RepoRef -> Constr)
-> (RepoRef -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoRef))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoRef))
-> ((forall b. Data b => b -> b) -> RepoRef -> RepoRef)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r)
-> (forall u. (forall d. Data d => d -> u) -> RepoRef -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> RepoRef -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef)
-> Data RepoRef
RepoRef -> Constr
RepoRef -> DataType
(forall b. Data b => b -> b) -> RepoRef -> RepoRef
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoRef -> c RepoRef
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoRef
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RepoRef -> u
forall u. (forall d. Data d => d -> u) -> RepoRef -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoRef
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoRef -> c RepoRef
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoRef)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoRef)
$cRepoRef :: Constr
$tRepoRef :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
gmapMp :: (forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
gmapM :: (forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoRef -> m RepoRef
gmapQi :: Int -> (forall d. Data d => d -> u) -> RepoRef -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RepoRef -> u
gmapQ :: (forall d. Data d => d -> u) -> RepoRef -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RepoRef -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoRef -> r
gmapT :: (forall b. Data b => b -> b) -> RepoRef -> RepoRef
$cgmapT :: (forall b. Data b => b -> b) -> RepoRef -> RepoRef
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoRef)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c RepoRef)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RepoRef)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoRef)
dataTypeOf :: RepoRef -> DataType
$cdataTypeOf :: RepoRef -> DataType
toConstr :: RepoRef -> Constr
$ctoConstr :: RepoRef -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoRef
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoRef
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoRef -> c RepoRef
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoRef -> c RepoRef
$cp1Data :: Typeable RepoRef
Data, Typeable, RepoRef -> RepoRef -> Bool
(RepoRef -> RepoRef -> Bool)
-> (RepoRef -> RepoRef -> Bool) -> Eq RepoRef
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoRef -> RepoRef -> Bool
$c/= :: RepoRef -> RepoRef -> Bool
== :: RepoRef -> RepoRef -> Bool
$c== :: RepoRef -> RepoRef -> Bool
Eq, Eq RepoRef
Eq RepoRef =>
(RepoRef -> RepoRef -> Ordering)
-> (RepoRef -> RepoRef -> Bool)
-> (RepoRef -> RepoRef -> Bool)
-> (RepoRef -> RepoRef -> Bool)
-> (RepoRef -> RepoRef -> Bool)
-> (RepoRef -> RepoRef -> RepoRef)
-> (RepoRef -> RepoRef -> RepoRef)
-> Ord RepoRef
RepoRef -> RepoRef -> Bool
RepoRef -> RepoRef -> Ordering
RepoRef -> RepoRef -> RepoRef
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 :: RepoRef -> RepoRef -> RepoRef
$cmin :: RepoRef -> RepoRef -> RepoRef
max :: RepoRef -> RepoRef -> RepoRef
$cmax :: RepoRef -> RepoRef -> RepoRef
>= :: RepoRef -> RepoRef -> Bool
$c>= :: RepoRef -> RepoRef -> Bool
> :: RepoRef -> RepoRef -> Bool
$c> :: RepoRef -> RepoRef -> Bool
<= :: RepoRef -> RepoRef -> Bool
$c<= :: RepoRef -> RepoRef -> Bool
< :: RepoRef -> RepoRef -> Bool
$c< :: RepoRef -> RepoRef -> Bool
compare :: RepoRef -> RepoRef -> Ordering
$ccompare :: RepoRef -> RepoRef -> Ordering
$cp1Ord :: Eq RepoRef
Ord, (forall x. RepoRef -> Rep RepoRef x)
-> (forall x. Rep RepoRef x -> RepoRef) -> Generic RepoRef
forall x. Rep RepoRef x -> RepoRef
forall x. RepoRef -> Rep RepoRef x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoRef x -> RepoRef
$cfrom :: forall x. RepoRef -> Rep RepoRef x
Generic)
instance NFData RepoRef where rnf :: RepoRef -> ()
rnf = RepoRef -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary RepoRef
data NewRepo = NewRepo
{ NewRepo -> Name Repo
newRepoName :: !(Name Repo)
, NewRepo -> Maybe Text
newRepoDescription :: !(Maybe Text)
, NewRepo -> Maybe Text
newRepoHomepage :: !(Maybe Text)
, NewRepo -> Maybe Bool
newRepoPrivate :: !(Maybe Bool)
, NewRepo -> Maybe Bool
newRepoHasIssues :: !(Maybe Bool)
, NewRepo -> Maybe Bool
newRepoHasWiki :: !(Maybe Bool)
, NewRepo -> Maybe Bool
newRepoAutoInit :: !(Maybe Bool)
} deriving (NewRepo -> NewRepo -> Bool
(NewRepo -> NewRepo -> Bool)
-> (NewRepo -> NewRepo -> Bool) -> Eq NewRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NewRepo -> NewRepo -> Bool
$c/= :: NewRepo -> NewRepo -> Bool
== :: NewRepo -> NewRepo -> Bool
$c== :: NewRepo -> NewRepo -> Bool
Eq, Eq NewRepo
Eq NewRepo =>
(NewRepo -> NewRepo -> Ordering)
-> (NewRepo -> NewRepo -> Bool)
-> (NewRepo -> NewRepo -> Bool)
-> (NewRepo -> NewRepo -> Bool)
-> (NewRepo -> NewRepo -> Bool)
-> (NewRepo -> NewRepo -> NewRepo)
-> (NewRepo -> NewRepo -> NewRepo)
-> Ord NewRepo
NewRepo -> NewRepo -> Bool
NewRepo -> NewRepo -> Ordering
NewRepo -> NewRepo -> NewRepo
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 :: NewRepo -> NewRepo -> NewRepo
$cmin :: NewRepo -> NewRepo -> NewRepo
max :: NewRepo -> NewRepo -> NewRepo
$cmax :: NewRepo -> NewRepo -> NewRepo
>= :: NewRepo -> NewRepo -> Bool
$c>= :: NewRepo -> NewRepo -> Bool
> :: NewRepo -> NewRepo -> Bool
$c> :: NewRepo -> NewRepo -> Bool
<= :: NewRepo -> NewRepo -> Bool
$c<= :: NewRepo -> NewRepo -> Bool
< :: NewRepo -> NewRepo -> Bool
$c< :: NewRepo -> NewRepo -> Bool
compare :: NewRepo -> NewRepo -> Ordering
$ccompare :: NewRepo -> NewRepo -> Ordering
$cp1Ord :: Eq NewRepo
Ord, Int -> NewRepo -> ShowS
[NewRepo] -> ShowS
NewRepo -> String
(Int -> NewRepo -> ShowS)
-> (NewRepo -> String) -> ([NewRepo] -> ShowS) -> Show NewRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NewRepo] -> ShowS
$cshowList :: [NewRepo] -> ShowS
show :: NewRepo -> String
$cshow :: NewRepo -> String
showsPrec :: Int -> NewRepo -> ShowS
$cshowsPrec :: Int -> NewRepo -> ShowS
Show, Typeable NewRepo
Constr
DataType
Typeable NewRepo =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewRepo -> c NewRepo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewRepo)
-> (NewRepo -> Constr)
-> (NewRepo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewRepo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewRepo))
-> ((forall b. Data b => b -> b) -> NewRepo -> NewRepo)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r)
-> (forall u. (forall d. Data d => d -> u) -> NewRepo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> NewRepo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo)
-> Data NewRepo
NewRepo -> Constr
NewRepo -> DataType
(forall b. Data b => b -> b) -> NewRepo -> NewRepo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewRepo -> c NewRepo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewRepo
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> NewRepo -> u
forall u. (forall d. Data d => d -> u) -> NewRepo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewRepo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewRepo -> c NewRepo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewRepo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewRepo)
$cNewRepo :: Constr
$tNewRepo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
gmapMp :: (forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
gmapM :: (forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> NewRepo -> m NewRepo
gmapQi :: Int -> (forall d. Data d => d -> u) -> NewRepo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> NewRepo -> u
gmapQ :: (forall d. Data d => d -> u) -> NewRepo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> NewRepo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> NewRepo -> r
gmapT :: (forall b. Data b => b -> b) -> NewRepo -> NewRepo
$cgmapT :: (forall b. Data b => b -> b) -> NewRepo -> NewRepo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewRepo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c NewRepo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c NewRepo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c NewRepo)
dataTypeOf :: NewRepo -> DataType
$cdataTypeOf :: NewRepo -> DataType
toConstr :: NewRepo -> Constr
$ctoConstr :: NewRepo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewRepo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c NewRepo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewRepo -> c NewRepo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> NewRepo -> c NewRepo
$cp1Data :: Typeable NewRepo
Data, Typeable, (forall x. NewRepo -> Rep NewRepo x)
-> (forall x. Rep NewRepo x -> NewRepo) -> Generic NewRepo
forall x. Rep NewRepo x -> NewRepo
forall x. NewRepo -> Rep NewRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep NewRepo x -> NewRepo
$cfrom :: forall x. NewRepo -> Rep NewRepo x
Generic)
instance NFData NewRepo where rnf :: NewRepo -> ()
rnf = NewRepo -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary NewRepo
newRepo :: Name Repo -> NewRepo
newRepo :: Name Repo -> NewRepo
newRepo name :: Name Repo
name = Name Repo
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> NewRepo
NewRepo Name Repo
name Maybe Text
forall a. Maybe a
Nothing Maybe Text
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing Maybe Bool
forall a. Maybe a
Nothing
data EditRepo = EditRepo
{ EditRepo -> Maybe (Name Repo)
editName :: !(Maybe (Name Repo))
, EditRepo -> Maybe Text
editDescription :: !(Maybe Text)
, EditRepo -> Maybe Text
editHomepage :: !(Maybe Text)
, EditRepo -> Maybe Bool
editPublic :: !(Maybe Bool)
, EditRepo -> Maybe Bool
editHasIssues :: !(Maybe Bool)
, EditRepo -> Maybe Bool
editHasWiki :: !(Maybe Bool)
, EditRepo -> Maybe Bool
editHasDownloads :: !(Maybe Bool)
}
deriving (EditRepo -> EditRepo -> Bool
(EditRepo -> EditRepo -> Bool)
-> (EditRepo -> EditRepo -> Bool) -> Eq EditRepo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditRepo -> EditRepo -> Bool
$c/= :: EditRepo -> EditRepo -> Bool
== :: EditRepo -> EditRepo -> Bool
$c== :: EditRepo -> EditRepo -> Bool
Eq, Eq EditRepo
Eq EditRepo =>
(EditRepo -> EditRepo -> Ordering)
-> (EditRepo -> EditRepo -> Bool)
-> (EditRepo -> EditRepo -> Bool)
-> (EditRepo -> EditRepo -> Bool)
-> (EditRepo -> EditRepo -> Bool)
-> (EditRepo -> EditRepo -> EditRepo)
-> (EditRepo -> EditRepo -> EditRepo)
-> Ord EditRepo
EditRepo -> EditRepo -> Bool
EditRepo -> EditRepo -> Ordering
EditRepo -> EditRepo -> EditRepo
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 :: EditRepo -> EditRepo -> EditRepo
$cmin :: EditRepo -> EditRepo -> EditRepo
max :: EditRepo -> EditRepo -> EditRepo
$cmax :: EditRepo -> EditRepo -> EditRepo
>= :: EditRepo -> EditRepo -> Bool
$c>= :: EditRepo -> EditRepo -> Bool
> :: EditRepo -> EditRepo -> Bool
$c> :: EditRepo -> EditRepo -> Bool
<= :: EditRepo -> EditRepo -> Bool
$c<= :: EditRepo -> EditRepo -> Bool
< :: EditRepo -> EditRepo -> Bool
$c< :: EditRepo -> EditRepo -> Bool
compare :: EditRepo -> EditRepo -> Ordering
$ccompare :: EditRepo -> EditRepo -> Ordering
$cp1Ord :: Eq EditRepo
Ord, Int -> EditRepo -> ShowS
[EditRepo] -> ShowS
EditRepo -> String
(Int -> EditRepo -> ShowS)
-> (EditRepo -> String) -> ([EditRepo] -> ShowS) -> Show EditRepo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditRepo] -> ShowS
$cshowList :: [EditRepo] -> ShowS
show :: EditRepo -> String
$cshow :: EditRepo -> String
showsPrec :: Int -> EditRepo -> ShowS
$cshowsPrec :: Int -> EditRepo -> ShowS
Show, Typeable EditRepo
Constr
DataType
Typeable EditRepo =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EditRepo -> c EditRepo)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EditRepo)
-> (EditRepo -> Constr)
-> (EditRepo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EditRepo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EditRepo))
-> ((forall b. Data b => b -> b) -> EditRepo -> EditRepo)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r)
-> (forall u. (forall d. Data d => d -> u) -> EditRepo -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> EditRepo -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo)
-> Data EditRepo
EditRepo -> Constr
EditRepo -> DataType
(forall b. Data b => b -> b) -> EditRepo -> EditRepo
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EditRepo -> c EditRepo
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EditRepo
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> EditRepo -> u
forall u. (forall d. Data d => d -> u) -> EditRepo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EditRepo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EditRepo -> c EditRepo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EditRepo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EditRepo)
$cEditRepo :: Constr
$tEditRepo :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
gmapMp :: (forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
gmapM :: (forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> EditRepo -> m EditRepo
gmapQi :: Int -> (forall d. Data d => d -> u) -> EditRepo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> EditRepo -> u
gmapQ :: (forall d. Data d => d -> u) -> EditRepo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> EditRepo -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> EditRepo -> r
gmapT :: (forall b. Data b => b -> b) -> EditRepo -> EditRepo
$cgmapT :: (forall b. Data b => b -> b) -> EditRepo -> EditRepo
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EditRepo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c EditRepo)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c EditRepo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c EditRepo)
dataTypeOf :: EditRepo -> DataType
$cdataTypeOf :: EditRepo -> DataType
toConstr :: EditRepo -> Constr
$ctoConstr :: EditRepo -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EditRepo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c EditRepo
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EditRepo -> c EditRepo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> EditRepo -> c EditRepo
$cp1Data :: Typeable EditRepo
Data, Typeable, (forall x. EditRepo -> Rep EditRepo x)
-> (forall x. Rep EditRepo x -> EditRepo) -> Generic EditRepo
forall x. Rep EditRepo x -> EditRepo
forall x. EditRepo -> Rep EditRepo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EditRepo x -> EditRepo
$cfrom :: forall x. EditRepo -> Rep EditRepo x
Generic)
instance NFData EditRepo where rnf :: EditRepo -> ()
rnf = EditRepo -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary EditRepo
data RepoPublicity
= RepoPublicityAll
| RepoPublicityOwner
| RepoPublicityPublic
| RepoPublicityPrivate
| RepoPublicityMember
deriving (Int -> RepoPublicity -> ShowS
[RepoPublicity] -> ShowS
RepoPublicity -> String
(Int -> RepoPublicity -> ShowS)
-> (RepoPublicity -> String)
-> ([RepoPublicity] -> ShowS)
-> Show RepoPublicity
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepoPublicity] -> ShowS
$cshowList :: [RepoPublicity] -> ShowS
show :: RepoPublicity -> String
$cshow :: RepoPublicity -> String
showsPrec :: Int -> RepoPublicity -> ShowS
$cshowsPrec :: Int -> RepoPublicity -> ShowS
Show, RepoPublicity -> RepoPublicity -> Bool
(RepoPublicity -> RepoPublicity -> Bool)
-> (RepoPublicity -> RepoPublicity -> Bool) -> Eq RepoPublicity
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepoPublicity -> RepoPublicity -> Bool
$c/= :: RepoPublicity -> RepoPublicity -> Bool
== :: RepoPublicity -> RepoPublicity -> Bool
$c== :: RepoPublicity -> RepoPublicity -> Bool
Eq, Eq RepoPublicity
Eq RepoPublicity =>
(RepoPublicity -> RepoPublicity -> Ordering)
-> (RepoPublicity -> RepoPublicity -> Bool)
-> (RepoPublicity -> RepoPublicity -> Bool)
-> (RepoPublicity -> RepoPublicity -> Bool)
-> (RepoPublicity -> RepoPublicity -> Bool)
-> (RepoPublicity -> RepoPublicity -> RepoPublicity)
-> (RepoPublicity -> RepoPublicity -> RepoPublicity)
-> Ord RepoPublicity
RepoPublicity -> RepoPublicity -> Bool
RepoPublicity -> RepoPublicity -> Ordering
RepoPublicity -> RepoPublicity -> RepoPublicity
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 :: RepoPublicity -> RepoPublicity -> RepoPublicity
$cmin :: RepoPublicity -> RepoPublicity -> RepoPublicity
max :: RepoPublicity -> RepoPublicity -> RepoPublicity
$cmax :: RepoPublicity -> RepoPublicity -> RepoPublicity
>= :: RepoPublicity -> RepoPublicity -> Bool
$c>= :: RepoPublicity -> RepoPublicity -> Bool
> :: RepoPublicity -> RepoPublicity -> Bool
$c> :: RepoPublicity -> RepoPublicity -> Bool
<= :: RepoPublicity -> RepoPublicity -> Bool
$c<= :: RepoPublicity -> RepoPublicity -> Bool
< :: RepoPublicity -> RepoPublicity -> Bool
$c< :: RepoPublicity -> RepoPublicity -> Bool
compare :: RepoPublicity -> RepoPublicity -> Ordering
$ccompare :: RepoPublicity -> RepoPublicity -> Ordering
$cp1Ord :: Eq RepoPublicity
Ord, Int -> RepoPublicity
RepoPublicity -> Int
RepoPublicity -> [RepoPublicity]
RepoPublicity -> RepoPublicity
RepoPublicity -> RepoPublicity -> [RepoPublicity]
RepoPublicity -> RepoPublicity -> RepoPublicity -> [RepoPublicity]
(RepoPublicity -> RepoPublicity)
-> (RepoPublicity -> RepoPublicity)
-> (Int -> RepoPublicity)
-> (RepoPublicity -> Int)
-> (RepoPublicity -> [RepoPublicity])
-> (RepoPublicity -> RepoPublicity -> [RepoPublicity])
-> (RepoPublicity -> RepoPublicity -> [RepoPublicity])
-> (RepoPublicity
-> RepoPublicity -> RepoPublicity -> [RepoPublicity])
-> Enum RepoPublicity
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 :: RepoPublicity -> RepoPublicity -> RepoPublicity -> [RepoPublicity]
$cenumFromThenTo :: RepoPublicity -> RepoPublicity -> RepoPublicity -> [RepoPublicity]
enumFromTo :: RepoPublicity -> RepoPublicity -> [RepoPublicity]
$cenumFromTo :: RepoPublicity -> RepoPublicity -> [RepoPublicity]
enumFromThen :: RepoPublicity -> RepoPublicity -> [RepoPublicity]
$cenumFromThen :: RepoPublicity -> RepoPublicity -> [RepoPublicity]
enumFrom :: RepoPublicity -> [RepoPublicity]
$cenumFrom :: RepoPublicity -> [RepoPublicity]
fromEnum :: RepoPublicity -> Int
$cfromEnum :: RepoPublicity -> Int
toEnum :: Int -> RepoPublicity
$ctoEnum :: Int -> RepoPublicity
pred :: RepoPublicity -> RepoPublicity
$cpred :: RepoPublicity -> RepoPublicity
succ :: RepoPublicity -> RepoPublicity
$csucc :: RepoPublicity -> RepoPublicity
Enum, RepoPublicity
RepoPublicity -> RepoPublicity -> Bounded RepoPublicity
forall a. a -> a -> Bounded a
maxBound :: RepoPublicity
$cmaxBound :: RepoPublicity
minBound :: RepoPublicity
$cminBound :: RepoPublicity
Bounded, Typeable, Typeable RepoPublicity
Constr
DataType
Typeable RepoPublicity =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoPublicity -> c RepoPublicity)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoPublicity)
-> (RepoPublicity -> Constr)
-> (RepoPublicity -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoPublicity))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoPublicity))
-> ((forall b. Data b => b -> b) -> RepoPublicity -> RepoPublicity)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r)
-> (forall u. (forall d. Data d => d -> u) -> RepoPublicity -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> RepoPublicity -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity)
-> Data RepoPublicity
RepoPublicity -> Constr
RepoPublicity -> DataType
(forall b. Data b => b -> b) -> RepoPublicity -> RepoPublicity
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoPublicity -> c RepoPublicity
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoPublicity
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> RepoPublicity -> u
forall u. (forall d. Data d => d -> u) -> RepoPublicity -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoPublicity
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoPublicity -> c RepoPublicity
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoPublicity)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoPublicity)
$cRepoPublicityMember :: Constr
$cRepoPublicityPrivate :: Constr
$cRepoPublicityPublic :: Constr
$cRepoPublicityOwner :: Constr
$cRepoPublicityAll :: Constr
$tRepoPublicity :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
gmapMp :: (forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
gmapM :: (forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> RepoPublicity -> m RepoPublicity
gmapQi :: Int -> (forall d. Data d => d -> u) -> RepoPublicity -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> RepoPublicity -> u
gmapQ :: (forall d. Data d => d -> u) -> RepoPublicity -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> RepoPublicity -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> RepoPublicity -> r
gmapT :: (forall b. Data b => b -> b) -> RepoPublicity -> RepoPublicity
$cgmapT :: (forall b. Data b => b -> b) -> RepoPublicity -> RepoPublicity
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoPublicity)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c RepoPublicity)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c RepoPublicity)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c RepoPublicity)
dataTypeOf :: RepoPublicity -> DataType
$cdataTypeOf :: RepoPublicity -> DataType
toConstr :: RepoPublicity -> Constr
$ctoConstr :: RepoPublicity -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoPublicity
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c RepoPublicity
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoPublicity -> c RepoPublicity
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> RepoPublicity -> c RepoPublicity
$cp1Data :: Typeable RepoPublicity
Data, (forall x. RepoPublicity -> Rep RepoPublicity x)
-> (forall x. Rep RepoPublicity x -> RepoPublicity)
-> Generic RepoPublicity
forall x. Rep RepoPublicity x -> RepoPublicity
forall x. RepoPublicity -> Rep RepoPublicity x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RepoPublicity x -> RepoPublicity
$cfrom :: forall x. RepoPublicity -> Rep RepoPublicity x
Generic)
type Languages = HM.HashMap Language Int
newtype Language = Language Text
deriving (Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, Typeable Language
Constr
DataType
Typeable Language =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language)
-> (Language -> Constr)
-> (Language -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Language))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language))
-> ((forall b. Data b => b -> b) -> Language -> Language)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r)
-> (forall u. (forall d. Data d => d -> u) -> Language -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Language -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Language -> m Language)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language)
-> Data Language
Language -> Constr
Language -> DataType
(forall b. Data b => b -> b) -> Language -> Language
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Language -> u
forall u. (forall d. Data d => d -> u) -> Language -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Language -> m Language
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Language)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language)
$cLanguage :: Constr
$tLanguage :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Language -> m Language
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
gmapMp :: (forall d. Data d => d -> m d) -> Language -> m Language
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Language -> m Language
gmapM :: (forall d. Data d => d -> m d) -> Language -> m Language
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Language -> m Language
gmapQi :: Int -> (forall d. Data d => d -> u) -> Language -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Language -> u
gmapQ :: (forall d. Data d => d -> u) -> Language -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Language -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Language -> r
gmapT :: (forall b. Data b => b -> b) -> Language -> Language
$cgmapT :: (forall b. Data b => b -> b) -> Language -> Language
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Language)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Language)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Language)
dataTypeOf :: Language -> DataType
$cdataTypeOf :: Language -> DataType
toConstr :: Language -> Constr
$ctoConstr :: Language -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Language
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Language -> c Language
$cp1Data :: Typeable Language
Data, Typeable, Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Eq Language
Eq Language =>
(Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
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 :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
$cp1Ord :: Eq Language
Ord, (forall x. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic)
getLanguage :: Language -> Text
getLanguage :: Language -> Text
getLanguage (Language l :: Text
l) = Text
l
instance NFData Language where rnf :: Language -> ()
rnf = Language -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Language
instance Hashable Language where
hashWithSalt :: Int -> Language -> Int
hashWithSalt salt :: Int
salt (Language l :: Text
l) = Int -> Text -> Int
forall a. Hashable a => Int -> a -> Int
hashWithSalt Int
salt Text
l
instance IsString Language where
fromString :: String -> Language
fromString = Text -> Language
Language (Text -> Language) -> (String -> Text) -> String -> Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
forall a. IsString a => String -> a
fromString
data Contributor
= KnownContributor !Int !URL !(Name User) !URL !(Id User) !Text
| AnonymousContributor !Int !Text
deriving (Int -> Contributor -> ShowS
[Contributor] -> ShowS
Contributor -> String
(Int -> Contributor -> ShowS)
-> (Contributor -> String)
-> ([Contributor] -> ShowS)
-> Show Contributor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Contributor] -> ShowS
$cshowList :: [Contributor] -> ShowS
show :: Contributor -> String
$cshow :: Contributor -> String
showsPrec :: Int -> Contributor -> ShowS
$cshowsPrec :: Int -> Contributor -> ShowS
Show, Typeable Contributor
Constr
DataType
Typeable Contributor =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contributor -> c Contributor)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Contributor)
-> (Contributor -> Constr)
-> (Contributor -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Contributor))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Contributor))
-> ((forall b. Data b => b -> b) -> Contributor -> Contributor)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r)
-> (forall u. (forall d. Data d => d -> u) -> Contributor -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> Contributor -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor)
-> Data Contributor
Contributor -> Constr
Contributor -> DataType
(forall b. Data b => b -> b) -> Contributor -> Contributor
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contributor -> c Contributor
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Contributor
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Contributor -> u
forall u. (forall d. Data d => d -> u) -> Contributor -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Contributor
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contributor -> c Contributor
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Contributor)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Contributor)
$cAnonymousContributor :: Constr
$cKnownContributor :: Constr
$tContributor :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> Contributor -> m Contributor
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor
gmapMp :: (forall d. Data d => d -> m d) -> Contributor -> m Contributor
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor
gmapM :: (forall d. Data d => d -> m d) -> Contributor -> m Contributor
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Contributor -> m Contributor
gmapQi :: Int -> (forall d. Data d => d -> u) -> Contributor -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Contributor -> u
gmapQ :: (forall d. Data d => d -> u) -> Contributor -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Contributor -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Contributor -> r
gmapT :: (forall b. Data b => b -> b) -> Contributor -> Contributor
$cgmapT :: (forall b. Data b => b -> b) -> Contributor -> Contributor
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Contributor)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c Contributor)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c Contributor)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Contributor)
dataTypeOf :: Contributor -> DataType
$cdataTypeOf :: Contributor -> DataType
toConstr :: Contributor -> Constr
$ctoConstr :: Contributor -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Contributor
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Contributor
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contributor -> c Contributor
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Contributor -> c Contributor
$cp1Data :: Typeable Contributor
Data, Typeable, Contributor -> Contributor -> Bool
(Contributor -> Contributor -> Bool)
-> (Contributor -> Contributor -> Bool) -> Eq Contributor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Contributor -> Contributor -> Bool
$c/= :: Contributor -> Contributor -> Bool
== :: Contributor -> Contributor -> Bool
$c== :: Contributor -> Contributor -> Bool
Eq, Eq Contributor
Eq Contributor =>
(Contributor -> Contributor -> Ordering)
-> (Contributor -> Contributor -> Bool)
-> (Contributor -> Contributor -> Bool)
-> (Contributor -> Contributor -> Bool)
-> (Contributor -> Contributor -> Bool)
-> (Contributor -> Contributor -> Contributor)
-> (Contributor -> Contributor -> Contributor)
-> Ord Contributor
Contributor -> Contributor -> Bool
Contributor -> Contributor -> Ordering
Contributor -> Contributor -> Contributor
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 :: Contributor -> Contributor -> Contributor
$cmin :: Contributor -> Contributor -> Contributor
max :: Contributor -> Contributor -> Contributor
$cmax :: Contributor -> Contributor -> Contributor
>= :: Contributor -> Contributor -> Bool
$c>= :: Contributor -> Contributor -> Bool
> :: Contributor -> Contributor -> Bool
$c> :: Contributor -> Contributor -> Bool
<= :: Contributor -> Contributor -> Bool
$c<= :: Contributor -> Contributor -> Bool
< :: Contributor -> Contributor -> Bool
$c< :: Contributor -> Contributor -> Bool
compare :: Contributor -> Contributor -> Ordering
$ccompare :: Contributor -> Contributor -> Ordering
$cp1Ord :: Eq Contributor
Ord, (forall x. Contributor -> Rep Contributor x)
-> (forall x. Rep Contributor x -> Contributor)
-> Generic Contributor
forall x. Rep Contributor x -> Contributor
forall x. Contributor -> Rep Contributor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Contributor x -> Contributor
$cfrom :: forall x. Contributor -> Rep Contributor x
Generic)
instance NFData Contributor where rnf :: Contributor -> ()
rnf = Contributor -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Contributor
contributorToSimpleUser :: Contributor -> Maybe SimpleUser
contributorToSimpleUser :: Contributor -> Maybe SimpleUser
contributorToSimpleUser (AnonymousContributor _ _) = Maybe SimpleUser
forall a. Maybe a
Nothing
contributorToSimpleUser (KnownContributor _contributions :: Int
_contributions avatarUrl :: URL
avatarUrl name :: Name User
name url :: URL
url uid :: Id User
uid _gravatarid :: Text
_gravatarid) =
SimpleUser -> Maybe SimpleUser
forall a. a -> Maybe a
Just (SimpleUser -> Maybe SimpleUser) -> SimpleUser -> Maybe SimpleUser
forall a b. (a -> b) -> a -> b
$ Id User -> Name User -> URL -> URL -> SimpleUser
SimpleUser Id User
uid Name User
name URL
avatarUrl URL
url
instance FromJSON Repo where
parseJSON :: Value -> Parser Repo
parseJSON = String -> (Object -> Parser Repo) -> Value -> Parser Repo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Repo" ((Object -> Parser Repo) -> Value -> Parser Repo)
-> (Object -> Parser Repo) -> Value -> Parser Repo
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> Maybe URL
-> Maybe Text
-> Maybe UTCTime
-> URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo
Repo (Maybe URL
-> Maybe Text
-> Maybe UTCTime
-> URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe URL)
-> Parser
(Maybe Text
-> Maybe UTCTime
-> URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser (Maybe URL)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "ssh_url"
Parser
(Maybe Text
-> Maybe UTCTime
-> URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Text)
-> Parser
(Maybe UTCTime
-> URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser a
.: "description"
Parser
(Maybe UTCTime
-> URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe UTCTime)
-> Parser
(URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "created_at"
Parser
(URL
-> Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser URL
-> Parser
(Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser URL
forall a. FromJSON a => Object -> Text -> Parser a
.: "html_url"
Parser
(Maybe URL
-> Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe URL)
-> Parser
(Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe URL)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "svn_url"
Parser
(Maybe Int
-> Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Int)
-> Parser
(Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "forks"
Parser
(Maybe Text
-> Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Text)
-> Parser
(Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "homepage"
Parser
(Maybe Bool
-> Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Bool)
-> Parser
(Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser a
.: "fork"
Parser
(Maybe URL
-> Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe URL)
-> Parser
(Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe URL)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "git_url"
Parser
(Bool
-> Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser Bool
-> Parser
(Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: "private"
Parser
(Bool
-> Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser Bool
-> Parser
(Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "archived" Parser (Maybe Bool) -> Bool -> Parser Bool
forall a. Parser (Maybe a) -> a -> Parser a
.!= Bool
False
Parser
(Maybe URL
-> Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe URL)
-> Parser
(Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe URL)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "clone_url"
Parser
(Maybe Int
-> Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Int)
-> Parser
(Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "size"
Parser
(Maybe UTCTime
-> Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe UTCTime)
-> Parser
(Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "updated_at"
Parser
(Maybe Int
-> SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Int)
-> Parser
(SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "watchers"
Parser
(SimpleOwner
-> Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser SimpleOwner
-> Parser
(Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser SimpleOwner
forall a. FromJSON a => Object -> Text -> Parser a
.: "owner"
Parser
(Name Repo
-> Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Name Repo)
-> Parser
(Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Name Repo)
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
Parser
(Maybe Language
-> Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Language)
-> Parser
(Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Language)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "language"
Parser
(Maybe Text
-> Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Text)
-> Parser
(Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "default_branch"
Parser
(Maybe UTCTime
-> Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe UTCTime)
-> Parser
(Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe UTCTime)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "pushed_at"
Parser
(Id Repo
-> URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Id Repo)
-> Parser
(URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Id Repo)
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
Parser
(URL
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser URL
-> Parser
(Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser URL
forall a. FromJSON a => Object -> Text -> Parser a
.: "url"
Parser
(Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Int)
-> Parser
(Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Int)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "open_issues"
Parser
(Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Bool)
-> Parser
(Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "has_wiki"
Parser
(Maybe Bool
-> Maybe Bool
-> Maybe RepoRef
-> Maybe RepoRef
-> URL
-> Int
-> Repo)
-> Parser (Maybe Bool)
-> Parser
(Maybe Bool
-> Maybe RepoRef -> Maybe RepoRef -> URL -> Int -> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "has_issues"
Parser
(Maybe Bool
-> Maybe RepoRef -> Maybe RepoRef -> URL -> Int -> Repo)
-> Parser (Maybe Bool)
-> Parser (Maybe RepoRef -> Maybe RepoRef -> URL -> Int -> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe Bool)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "has_downloads"
Parser (Maybe RepoRef -> Maybe RepoRef -> URL -> Int -> Repo)
-> Parser (Maybe RepoRef)
-> Parser (Maybe RepoRef -> URL -> Int -> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RepoRef)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "parent"
Parser (Maybe RepoRef -> URL -> Int -> Repo)
-> Parser (Maybe RepoRef) -> Parser (URL -> Int -> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Maybe RepoRef)
forall a. FromJSON a => Object -> Text -> Parser (Maybe a)
.:? "source"
Parser (URL -> Int -> Repo) -> Parser URL -> Parser (Int -> Repo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser URL
forall a. FromJSON a => Object -> Text -> Parser a
.: "hooks_url"
Parser (Int -> Repo) -> Parser Int -> Parser Repo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "stargazers_count"
instance ToJSON NewRepo where
toJSON :: NewRepo -> Value
toJSON (NewRepo { newRepoName :: NewRepo -> Name Repo
newRepoName = Name Repo
name
, newRepoDescription :: NewRepo -> Maybe Text
newRepoDescription = Maybe Text
description
, newRepoHomepage :: NewRepo -> Maybe Text
newRepoHomepage = Maybe Text
homepage
, newRepoPrivate :: NewRepo -> Maybe Bool
newRepoPrivate = Maybe Bool
private
, newRepoHasIssues :: NewRepo -> Maybe Bool
newRepoHasIssues = Maybe Bool
hasIssues
, newRepoHasWiki :: NewRepo -> Maybe Bool
newRepoHasWiki = Maybe Bool
hasWiki
, newRepoAutoInit :: NewRepo -> Maybe Bool
newRepoAutoInit = Maybe Bool
autoInit
}) = [Pair] -> Value
object
[ "name" Text -> Name Repo -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Name Repo
name
, "description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
description
, "homepage" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
homepage
, "private" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
private
, "has_issues" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
hasIssues
, "has_wiki" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
hasWiki
, "auto_init" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
autoInit
]
instance ToJSON EditRepo where
toJSON :: EditRepo -> Value
toJSON (EditRepo { editName :: EditRepo -> Maybe (Name Repo)
editName = Maybe (Name Repo)
name
, editDescription :: EditRepo -> Maybe Text
editDescription = Maybe Text
description
, editHomepage :: EditRepo -> Maybe Text
editHomepage = Maybe Text
homepage
, editPublic :: EditRepo -> Maybe Bool
editPublic = Maybe Bool
public
, editHasIssues :: EditRepo -> Maybe Bool
editHasIssues = Maybe Bool
hasIssues
, editHasWiki :: EditRepo -> Maybe Bool
editHasWiki = Maybe Bool
hasWiki
, editHasDownloads :: EditRepo -> Maybe Bool
editHasDownloads = Maybe Bool
hasDownloads
}) = [Pair] -> Value
object
[ "name" Text -> Maybe (Name Repo) -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe (Name Repo)
name
, "description" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
description
, "homepage" Text -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Text
homepage
, "public" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
public
, "has_issues" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
hasIssues
, "has_wiki" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
hasWiki
, "has_downloads" Text -> Maybe Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Maybe Bool
hasDownloads
]
instance FromJSON RepoRef where
parseJSON :: Value -> Parser RepoRef
parseJSON = String -> (Object -> Parser RepoRef) -> Value -> Parser RepoRef
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "RepoRef" ((Object -> Parser RepoRef) -> Value -> Parser RepoRef)
-> (Object -> Parser RepoRef) -> Value -> Parser RepoRef
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> SimpleOwner -> Name Repo -> RepoRef
RepoRef
(SimpleOwner -> Name Repo -> RepoRef)
-> Parser SimpleOwner -> Parser (Name Repo -> RepoRef)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser SimpleOwner
forall a. FromJSON a => Object -> Text -> Parser a
.: "owner"
Parser (Name Repo -> RepoRef)
-> Parser (Name Repo) -> Parser RepoRef
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Name Repo)
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
instance FromJSON Contributor where
parseJSON :: Value -> Parser Contributor
parseJSON = String
-> (Object -> Parser Contributor) -> Value -> Parser Contributor
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject "Contributor" ((Object -> Parser Contributor) -> Value -> Parser Contributor)
-> (Object -> Parser Contributor) -> Value -> Parser Contributor
forall a b. (a -> b) -> a -> b
$ \o :: Object
o -> do
Text
t <- Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "type"
case (Text
t :: Text) of
"Anonymous" -> Int -> Text -> Contributor
AnonymousContributor
(Int -> Text -> Contributor)
-> Parser Int -> Parser (Text -> Contributor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "contributions"
Parser (Text -> Contributor) -> Parser Text -> Parser Contributor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "name"
_ -> Int -> URL -> Name User -> URL -> Id User -> Text -> Contributor
KnownContributor
(Int -> URL -> Name User -> URL -> Id User -> Text -> Contributor)
-> Parser Int
-> Parser
(URL -> Name User -> URL -> Id User -> Text -> Contributor)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: "contributions"
Parser (URL -> Name User -> URL -> Id User -> Text -> Contributor)
-> Parser URL
-> Parser (Name User -> URL -> Id User -> Text -> Contributor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser URL
forall a. FromJSON a => Object -> Text -> Parser a
.: "avatar_url"
Parser (Name User -> URL -> Id User -> Text -> Contributor)
-> Parser (Name User)
-> Parser (URL -> Id User -> Text -> Contributor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Name User)
forall a. FromJSON a => Object -> Text -> Parser a
.: "login"
Parser (URL -> Id User -> Text -> Contributor)
-> Parser URL -> Parser (Id User -> Text -> Contributor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser URL
forall a. FromJSON a => Object -> Text -> Parser a
.: "url"
Parser (Id User -> Text -> Contributor)
-> Parser (Id User) -> Parser (Text -> Contributor)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser (Id User)
forall a. FromJSON a => Object -> Text -> Parser a
.: "id"
Parser (Text -> Contributor) -> Parser Text -> Parser Contributor
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Text -> Parser Text
forall a. FromJSON a => Object -> Text -> Parser a
.: "gravatar_id"
instance FromJSON Language where
parseJSON :: Value -> Parser Language
parseJSON = String -> (Text -> Parser Language) -> Value -> Parser Language
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText "Language" (Language -> Parser Language
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Language -> Parser Language)
-> (Text -> Language) -> Text -> Parser Language
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Language
Language)
instance ToJSON Language where
toJSON :: Language -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Language -> Text) -> Language -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Language -> Text
getLanguage
#if MIN_VERSION_aeson(1,0,0)
instance FromJSONKey Language where
fromJSONKey :: FromJSONKeyFunction Language
fromJSONKey = FromJSONKeyFunction Language
forall a. Coercible Text a => FromJSONKeyFunction a
fromJSONKeyCoerce
#else
instance FromJSON a => FromJSON (HM.HashMap Language a) where
parseJSON = fmap mapKeyLanguage . parseJSON
where
mapKeyLanguage :: HM.HashMap Text a -> HM.HashMap Language a
#ifdef UNSAFE
mapKeyLanguage = unsafeCoerce
#else
mapKeyLanguage = mapKey Language
mapKey :: (Eq k2, Hashable k2) => (k1 -> k2) -> HM.HashMap k1 a -> HM.HashMap k2 a
mapKey f = HM.fromList . map (first f) . HM.toList
#endif
#endif
data ArchiveFormat
= ArchiveFormatTarball
| ArchiveFormatZipball
deriving (Int -> ArchiveFormat -> ShowS
[ArchiveFormat] -> ShowS
ArchiveFormat -> String
(Int -> ArchiveFormat -> ShowS)
-> (ArchiveFormat -> String)
-> ([ArchiveFormat] -> ShowS)
-> Show ArchiveFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ArchiveFormat] -> ShowS
$cshowList :: [ArchiveFormat] -> ShowS
show :: ArchiveFormat -> String
$cshow :: ArchiveFormat -> String
showsPrec :: Int -> ArchiveFormat -> ShowS
$cshowsPrec :: Int -> ArchiveFormat -> ShowS
Show, ArchiveFormat -> ArchiveFormat -> Bool
(ArchiveFormat -> ArchiveFormat -> Bool)
-> (ArchiveFormat -> ArchiveFormat -> Bool) -> Eq ArchiveFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ArchiveFormat -> ArchiveFormat -> Bool
$c/= :: ArchiveFormat -> ArchiveFormat -> Bool
== :: ArchiveFormat -> ArchiveFormat -> Bool
$c== :: ArchiveFormat -> ArchiveFormat -> Bool
Eq, Eq ArchiveFormat
Eq ArchiveFormat =>
(ArchiveFormat -> ArchiveFormat -> Ordering)
-> (ArchiveFormat -> ArchiveFormat -> Bool)
-> (ArchiveFormat -> ArchiveFormat -> Bool)
-> (ArchiveFormat -> ArchiveFormat -> Bool)
-> (ArchiveFormat -> ArchiveFormat -> Bool)
-> (ArchiveFormat -> ArchiveFormat -> ArchiveFormat)
-> (ArchiveFormat -> ArchiveFormat -> ArchiveFormat)
-> Ord ArchiveFormat
ArchiveFormat -> ArchiveFormat -> Bool
ArchiveFormat -> ArchiveFormat -> Ordering
ArchiveFormat -> ArchiveFormat -> ArchiveFormat
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 :: ArchiveFormat -> ArchiveFormat -> ArchiveFormat
$cmin :: ArchiveFormat -> ArchiveFormat -> ArchiveFormat
max :: ArchiveFormat -> ArchiveFormat -> ArchiveFormat
$cmax :: ArchiveFormat -> ArchiveFormat -> ArchiveFormat
>= :: ArchiveFormat -> ArchiveFormat -> Bool
$c>= :: ArchiveFormat -> ArchiveFormat -> Bool
> :: ArchiveFormat -> ArchiveFormat -> Bool
$c> :: ArchiveFormat -> ArchiveFormat -> Bool
<= :: ArchiveFormat -> ArchiveFormat -> Bool
$c<= :: ArchiveFormat -> ArchiveFormat -> Bool
< :: ArchiveFormat -> ArchiveFormat -> Bool
$c< :: ArchiveFormat -> ArchiveFormat -> Bool
compare :: ArchiveFormat -> ArchiveFormat -> Ordering
$ccompare :: ArchiveFormat -> ArchiveFormat -> Ordering
$cp1Ord :: Eq ArchiveFormat
Ord, Int -> ArchiveFormat
ArchiveFormat -> Int
ArchiveFormat -> [ArchiveFormat]
ArchiveFormat -> ArchiveFormat
ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
ArchiveFormat -> ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
(ArchiveFormat -> ArchiveFormat)
-> (ArchiveFormat -> ArchiveFormat)
-> (Int -> ArchiveFormat)
-> (ArchiveFormat -> Int)
-> (ArchiveFormat -> [ArchiveFormat])
-> (ArchiveFormat -> ArchiveFormat -> [ArchiveFormat])
-> (ArchiveFormat -> ArchiveFormat -> [ArchiveFormat])
-> (ArchiveFormat
-> ArchiveFormat -> ArchiveFormat -> [ArchiveFormat])
-> Enum ArchiveFormat
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 :: ArchiveFormat -> ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
$cenumFromThenTo :: ArchiveFormat -> ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
enumFromTo :: ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
$cenumFromTo :: ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
enumFromThen :: ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
$cenumFromThen :: ArchiveFormat -> ArchiveFormat -> [ArchiveFormat]
enumFrom :: ArchiveFormat -> [ArchiveFormat]
$cenumFrom :: ArchiveFormat -> [ArchiveFormat]
fromEnum :: ArchiveFormat -> Int
$cfromEnum :: ArchiveFormat -> Int
toEnum :: Int -> ArchiveFormat
$ctoEnum :: Int -> ArchiveFormat
pred :: ArchiveFormat -> ArchiveFormat
$cpred :: ArchiveFormat -> ArchiveFormat
succ :: ArchiveFormat -> ArchiveFormat
$csucc :: ArchiveFormat -> ArchiveFormat
Enum, ArchiveFormat
ArchiveFormat -> ArchiveFormat -> Bounded ArchiveFormat
forall a. a -> a -> Bounded a
maxBound :: ArchiveFormat
$cmaxBound :: ArchiveFormat
minBound :: ArchiveFormat
$cminBound :: ArchiveFormat
Bounded, Typeable, Typeable ArchiveFormat
Constr
DataType
Typeable ArchiveFormat =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArchiveFormat -> c ArchiveFormat)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveFormat)
-> (ArchiveFormat -> Constr)
-> (ArchiveFormat -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArchiveFormat))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveFormat))
-> ((forall b. Data b => b -> b) -> ArchiveFormat -> ArchiveFormat)
-> (forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r)
-> (forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r)
-> (forall u. (forall d. Data d => d -> u) -> ArchiveFormat -> [u])
-> (forall u.
Int -> (forall d. Data d => d -> u) -> ArchiveFormat -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat)
-> Data ArchiveFormat
ArchiveFormat -> Constr
ArchiveFormat -> DataType
(forall b. Data b => b -> b) -> ArchiveFormat -> ArchiveFormat
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArchiveFormat -> c ArchiveFormat
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveFormat
forall a.
Typeable a =>
(forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> ArchiveFormat -> u
forall u. (forall d. Data d => d -> u) -> ArchiveFormat -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveFormat
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArchiveFormat -> c ArchiveFormat
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArchiveFormat)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveFormat)
$cArchiveFormatZipball :: Constr
$cArchiveFormatTarball :: Constr
$tArchiveFormat :: DataType
gmapMo :: (forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
gmapMp :: (forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
gmapM :: (forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ArchiveFormat -> m ArchiveFormat
gmapQi :: Int -> (forall d. Data d => d -> u) -> ArchiveFormat -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ArchiveFormat -> u
gmapQ :: (forall d. Data d => d -> u) -> ArchiveFormat -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ArchiveFormat -> [u]
gmapQr :: (r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r
gmapQl :: (r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ArchiveFormat -> r
gmapT :: (forall b. Data b => b -> b) -> ArchiveFormat -> ArchiveFormat
$cgmapT :: (forall b. Data b => b -> b) -> ArchiveFormat -> ArchiveFormat
dataCast2 :: (forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveFormat)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ArchiveFormat)
dataCast1 :: (forall d. Data d => c (t d)) -> Maybe (c ArchiveFormat)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ArchiveFormat)
dataTypeOf :: ArchiveFormat -> DataType
$cdataTypeOf :: ArchiveFormat -> DataType
toConstr :: ArchiveFormat -> Constr
$ctoConstr :: ArchiveFormat -> Constr
gunfold :: (forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveFormat
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ArchiveFormat
gfoldl :: (forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArchiveFormat -> c ArchiveFormat
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ArchiveFormat -> c ArchiveFormat
$cp1Data :: Typeable ArchiveFormat
Data, (forall x. ArchiveFormat -> Rep ArchiveFormat x)
-> (forall x. Rep ArchiveFormat x -> ArchiveFormat)
-> Generic ArchiveFormat
forall x. Rep ArchiveFormat x -> ArchiveFormat
forall x. ArchiveFormat -> Rep ArchiveFormat x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ArchiveFormat x -> ArchiveFormat
$cfrom :: forall x. ArchiveFormat -> Rep ArchiveFormat x
Generic)
instance IsPathPart ArchiveFormat where
toPathPart :: ArchiveFormat -> Text
toPathPart af :: ArchiveFormat
af = case ArchiveFormat
af of
ArchiveFormatTarball -> "tarball"
ArchiveFormatZipball -> "zipball"