{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP #-}
-----------------------------------------------------------------------------
-- |
-- License     :  BSD-3-Clause
-- Maintainer  :  Oleg Grenrus <oleg.grenrus@iki.fi>
--
module GitHub.Data.Content where

import GitHub.Data.GitData
import GitHub.Data.URL
import GitHub.Internal.Prelude
import Prelude ()

import Data.Aeson.Types (Pair)
import qualified Data.Text as T

#if MIN_VERSION_aeson(2,0,0)
import Data.Aeson (Key)
#endif

data Content
  = ContentFile !ContentFileData
  | ContentDirectory !(Vector ContentItem)
 deriving (Int -> Content -> ShowS
[Content] -> ShowS
Content -> String
(Int -> Content -> ShowS)
-> (Content -> String) -> ([Content] -> ShowS) -> Show Content
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Content] -> ShowS
$cshowList :: [Content] -> ShowS
show :: Content -> String
$cshow :: Content -> String
showsPrec :: Int -> Content -> ShowS
$cshowsPrec :: Int -> Content -> ShowS
Show, Typeable Content
Typeable Content
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Content -> c Content)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Content)
-> (Content -> Constr)
-> (Content -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Content))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content))
-> ((forall b. Data b => b -> b) -> Content -> Content)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Content -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Content -> r)
-> (forall u. (forall d. Data d => d -> u) -> Content -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Content -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Content -> m Content)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Content -> m Content)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Content -> m Content)
-> Data Content
Content -> DataType
Content -> Constr
(forall b. Data b => b -> b) -> Content -> Content
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) -> Content -> u
forall u. (forall d. Data d => d -> u) -> Content -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Content -> m Content
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Content -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Content -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Content -> r
gmapT :: (forall b. Data b => b -> b) -> Content -> Content
$cgmapT :: (forall b. Data b => b -> b) -> Content -> Content
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Content)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Content)
dataTypeOf :: Content -> DataType
$cdataTypeOf :: Content -> DataType
toConstr :: Content -> Constr
$ctoConstr :: Content -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Content
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Content -> c Content
Data, Typeable, Content -> Content -> Bool
(Content -> Content -> Bool)
-> (Content -> Content -> Bool) -> Eq Content
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Content -> Content -> Bool
$c/= :: Content -> Content -> Bool
== :: Content -> Content -> Bool
$c== :: Content -> Content -> Bool
Eq, Eq Content
Eq Content
-> (Content -> Content -> Ordering)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Bool)
-> (Content -> Content -> Content)
-> (Content -> Content -> Content)
-> Ord Content
Content -> Content -> Bool
Content -> Content -> Ordering
Content -> Content -> Content
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 :: Content -> Content -> Content
$cmin :: Content -> Content -> Content
max :: Content -> Content -> Content
$cmax :: Content -> Content -> Content
>= :: Content -> Content -> Bool
$c>= :: Content -> Content -> Bool
> :: Content -> Content -> Bool
$c> :: Content -> Content -> Bool
<= :: Content -> Content -> Bool
$c<= :: Content -> Content -> Bool
< :: Content -> Content -> Bool
$c< :: Content -> Content -> Bool
compare :: Content -> Content -> Ordering
$ccompare :: Content -> Content -> Ordering
Ord, (forall x. Content -> Rep Content x)
-> (forall x. Rep Content x -> Content) -> Generic Content
forall x. Rep Content x -> Content
forall x. Content -> Rep Content x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Content x -> Content
$cfrom :: forall x. Content -> Rep Content x
Generic)

instance NFData Content where rnf :: Content -> ()
rnf = Content -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Content

data ContentFileData = ContentFileData {
   ContentFileData -> ContentInfo
contentFileInfo     :: !ContentInfo
  ,ContentFileData -> Text
contentFileEncoding :: !Text
  ,ContentFileData -> Int
contentFileSize     :: !Int
  ,ContentFileData -> Text
contentFileContent  :: !Text
} deriving (Int -> ContentFileData -> ShowS
[ContentFileData] -> ShowS
ContentFileData -> String
(Int -> ContentFileData -> ShowS)
-> (ContentFileData -> String)
-> ([ContentFileData] -> ShowS)
-> Show ContentFileData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentFileData] -> ShowS
$cshowList :: [ContentFileData] -> ShowS
show :: ContentFileData -> String
$cshow :: ContentFileData -> String
showsPrec :: Int -> ContentFileData -> ShowS
$cshowsPrec :: Int -> ContentFileData -> ShowS
Show, Typeable ContentFileData
Typeable ContentFileData
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ContentFileData -> c ContentFileData)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContentFileData)
-> (ContentFileData -> Constr)
-> (ContentFileData -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContentFileData))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContentFileData))
-> ((forall b. Data b => b -> b)
    -> ContentFileData -> ContentFileData)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentFileData -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentFileData -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ContentFileData -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContentFileData -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ContentFileData -> m ContentFileData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContentFileData -> m ContentFileData)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContentFileData -> m ContentFileData)
-> Data ContentFileData
ContentFileData -> DataType
ContentFileData -> Constr
(forall b. Data b => b -> b) -> ContentFileData -> ContentFileData
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) -> ContentFileData -> u
forall u. (forall d. Data d => d -> u) -> ContentFileData -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentFileData -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentFileData -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentFileData
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentFileData -> c ContentFileData
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentFileData)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentFileData)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentFileData -> m ContentFileData
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContentFileData -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContentFileData -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ContentFileData -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContentFileData -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentFileData -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentFileData -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentFileData -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentFileData -> r
gmapT :: (forall b. Data b => b -> b) -> ContentFileData -> ContentFileData
$cgmapT :: (forall b. Data b => b -> b) -> ContentFileData -> ContentFileData
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentFileData)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentFileData)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentFileData)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentFileData)
dataTypeOf :: ContentFileData -> DataType
$cdataTypeOf :: ContentFileData -> DataType
toConstr :: ContentFileData -> Constr
$ctoConstr :: ContentFileData -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentFileData
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentFileData
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentFileData -> c ContentFileData
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentFileData -> c ContentFileData
Data, Typeable, ContentFileData -> ContentFileData -> Bool
(ContentFileData -> ContentFileData -> Bool)
-> (ContentFileData -> ContentFileData -> Bool)
-> Eq ContentFileData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentFileData -> ContentFileData -> Bool
$c/= :: ContentFileData -> ContentFileData -> Bool
== :: ContentFileData -> ContentFileData -> Bool
$c== :: ContentFileData -> ContentFileData -> Bool
Eq, Eq ContentFileData
Eq ContentFileData
-> (ContentFileData -> ContentFileData -> Ordering)
-> (ContentFileData -> ContentFileData -> Bool)
-> (ContentFileData -> ContentFileData -> Bool)
-> (ContentFileData -> ContentFileData -> Bool)
-> (ContentFileData -> ContentFileData -> Bool)
-> (ContentFileData -> ContentFileData -> ContentFileData)
-> (ContentFileData -> ContentFileData -> ContentFileData)
-> Ord ContentFileData
ContentFileData -> ContentFileData -> Bool
ContentFileData -> ContentFileData -> Ordering
ContentFileData -> ContentFileData -> ContentFileData
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 :: ContentFileData -> ContentFileData -> ContentFileData
$cmin :: ContentFileData -> ContentFileData -> ContentFileData
max :: ContentFileData -> ContentFileData -> ContentFileData
$cmax :: ContentFileData -> ContentFileData -> ContentFileData
>= :: ContentFileData -> ContentFileData -> Bool
$c>= :: ContentFileData -> ContentFileData -> Bool
> :: ContentFileData -> ContentFileData -> Bool
$c> :: ContentFileData -> ContentFileData -> Bool
<= :: ContentFileData -> ContentFileData -> Bool
$c<= :: ContentFileData -> ContentFileData -> Bool
< :: ContentFileData -> ContentFileData -> Bool
$c< :: ContentFileData -> ContentFileData -> Bool
compare :: ContentFileData -> ContentFileData -> Ordering
$ccompare :: ContentFileData -> ContentFileData -> Ordering
Ord, (forall x. ContentFileData -> Rep ContentFileData x)
-> (forall x. Rep ContentFileData x -> ContentFileData)
-> Generic ContentFileData
forall x. Rep ContentFileData x -> ContentFileData
forall x. ContentFileData -> Rep ContentFileData x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentFileData x -> ContentFileData
$cfrom :: forall x. ContentFileData -> Rep ContentFileData x
Generic)

instance NFData ContentFileData where rnf :: ContentFileData -> ()
rnf = ContentFileData -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary ContentFileData

-- | An item in a directory listing.
data ContentItem = ContentItem {
   ContentItem -> ContentItemType
contentItemType :: !ContentItemType
  ,ContentItem -> ContentInfo
contentItemInfo :: !ContentInfo
} deriving (Int -> ContentItem -> ShowS
[ContentItem] -> ShowS
ContentItem -> String
(Int -> ContentItem -> ShowS)
-> (ContentItem -> String)
-> ([ContentItem] -> ShowS)
-> Show ContentItem
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentItem] -> ShowS
$cshowList :: [ContentItem] -> ShowS
show :: ContentItem -> String
$cshow :: ContentItem -> String
showsPrec :: Int -> ContentItem -> ShowS
$cshowsPrec :: Int -> ContentItem -> ShowS
Show, Typeable ContentItem
Typeable ContentItem
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ContentItem -> c ContentItem)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContentItem)
-> (ContentItem -> Constr)
-> (ContentItem -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContentItem))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContentItem))
-> ((forall b. Data b => b -> b) -> ContentItem -> ContentItem)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentItem -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentItem -> r)
-> (forall u. (forall d. Data d => d -> u) -> ContentItem -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContentItem -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ContentItem -> m ContentItem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ContentItem -> m ContentItem)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ContentItem -> m ContentItem)
-> Data ContentItem
ContentItem -> DataType
ContentItem -> Constr
(forall b. Data b => b -> b) -> ContentItem -> ContentItem
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) -> ContentItem -> u
forall u. (forall d. Data d => d -> u) -> ContentItem -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItem -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItem -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentItem
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentItem -> c ContentItem
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentItem)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentItem)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentItem -> m ContentItem
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ContentItem -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ContentItem -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ContentItem -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContentItem -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItem -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItem -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItem -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItem -> r
gmapT :: (forall b. Data b => b -> b) -> ContentItem -> ContentItem
$cgmapT :: (forall b. Data b => b -> b) -> ContentItem -> ContentItem
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentItem)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentItem)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentItem)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentItem)
dataTypeOf :: ContentItem -> DataType
$cdataTypeOf :: ContentItem -> DataType
toConstr :: ContentItem -> Constr
$ctoConstr :: ContentItem -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentItem
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentItem
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentItem -> c ContentItem
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentItem -> c ContentItem
Data, Typeable, ContentItem -> ContentItem -> Bool
(ContentItem -> ContentItem -> Bool)
-> (ContentItem -> ContentItem -> Bool) -> Eq ContentItem
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentItem -> ContentItem -> Bool
$c/= :: ContentItem -> ContentItem -> Bool
== :: ContentItem -> ContentItem -> Bool
$c== :: ContentItem -> ContentItem -> Bool
Eq, Eq ContentItem
Eq ContentItem
-> (ContentItem -> ContentItem -> Ordering)
-> (ContentItem -> ContentItem -> Bool)
-> (ContentItem -> ContentItem -> Bool)
-> (ContentItem -> ContentItem -> Bool)
-> (ContentItem -> ContentItem -> Bool)
-> (ContentItem -> ContentItem -> ContentItem)
-> (ContentItem -> ContentItem -> ContentItem)
-> Ord ContentItem
ContentItem -> ContentItem -> Bool
ContentItem -> ContentItem -> Ordering
ContentItem -> ContentItem -> ContentItem
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 :: ContentItem -> ContentItem -> ContentItem
$cmin :: ContentItem -> ContentItem -> ContentItem
max :: ContentItem -> ContentItem -> ContentItem
$cmax :: ContentItem -> ContentItem -> ContentItem
>= :: ContentItem -> ContentItem -> Bool
$c>= :: ContentItem -> ContentItem -> Bool
> :: ContentItem -> ContentItem -> Bool
$c> :: ContentItem -> ContentItem -> Bool
<= :: ContentItem -> ContentItem -> Bool
$c<= :: ContentItem -> ContentItem -> Bool
< :: ContentItem -> ContentItem -> Bool
$c< :: ContentItem -> ContentItem -> Bool
compare :: ContentItem -> ContentItem -> Ordering
$ccompare :: ContentItem -> ContentItem -> Ordering
Ord, (forall x. ContentItem -> Rep ContentItem x)
-> (forall x. Rep ContentItem x -> ContentItem)
-> Generic ContentItem
forall x. Rep ContentItem x -> ContentItem
forall x. ContentItem -> Rep ContentItem x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentItem x -> ContentItem
$cfrom :: forall x. ContentItem -> Rep ContentItem x
Generic)

instance NFData ContentItem where rnf :: ContentItem -> ()
rnf = ContentItem -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary ContentItem

data ContentItemType = ItemFile | ItemDir
  deriving (Int -> ContentItemType -> ShowS
[ContentItemType] -> ShowS
ContentItemType -> String
(Int -> ContentItemType -> ShowS)
-> (ContentItemType -> String)
-> ([ContentItemType] -> ShowS)
-> Show ContentItemType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentItemType] -> ShowS
$cshowList :: [ContentItemType] -> ShowS
show :: ContentItemType -> String
$cshow :: ContentItemType -> String
showsPrec :: Int -> ContentItemType -> ShowS
$cshowsPrec :: Int -> ContentItemType -> ShowS
Show, Typeable ContentItemType
Typeable ContentItemType
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ContentItemType -> c ContentItemType)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContentItemType)
-> (ContentItemType -> Constr)
-> (ContentItemType -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContentItemType))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContentItemType))
-> ((forall b. Data b => b -> b)
    -> ContentItemType -> ContentItemType)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentItemType -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentItemType -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ContentItemType -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContentItemType -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ContentItemType -> m ContentItemType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContentItemType -> m ContentItemType)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContentItemType -> m ContentItemType)
-> Data ContentItemType
ContentItemType -> DataType
ContentItemType -> Constr
(forall b. Data b => b -> b) -> ContentItemType -> ContentItemType
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) -> ContentItemType -> u
forall u. (forall d. Data d => d -> u) -> ContentItemType -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItemType -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItemType -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentItemType
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentItemType -> c ContentItemType
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentItemType)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentItemType)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentItemType -> m ContentItemType
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContentItemType -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContentItemType -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ContentItemType -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContentItemType -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItemType -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItemType -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItemType -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentItemType -> r
gmapT :: (forall b. Data b => b -> b) -> ContentItemType -> ContentItemType
$cgmapT :: (forall b. Data b => b -> b) -> ContentItemType -> ContentItemType
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentItemType)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentItemType)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentItemType)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentItemType)
dataTypeOf :: ContentItemType -> DataType
$cdataTypeOf :: ContentItemType -> DataType
toConstr :: ContentItemType -> Constr
$ctoConstr :: ContentItemType -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentItemType
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentItemType
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentItemType -> c ContentItemType
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentItemType -> c ContentItemType
Data, Typeable, ContentItemType -> ContentItemType -> Bool
(ContentItemType -> ContentItemType -> Bool)
-> (ContentItemType -> ContentItemType -> Bool)
-> Eq ContentItemType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentItemType -> ContentItemType -> Bool
$c/= :: ContentItemType -> ContentItemType -> Bool
== :: ContentItemType -> ContentItemType -> Bool
$c== :: ContentItemType -> ContentItemType -> Bool
Eq, Eq ContentItemType
Eq ContentItemType
-> (ContentItemType -> ContentItemType -> Ordering)
-> (ContentItemType -> ContentItemType -> Bool)
-> (ContentItemType -> ContentItemType -> Bool)
-> (ContentItemType -> ContentItemType -> Bool)
-> (ContentItemType -> ContentItemType -> Bool)
-> (ContentItemType -> ContentItemType -> ContentItemType)
-> (ContentItemType -> ContentItemType -> ContentItemType)
-> Ord ContentItemType
ContentItemType -> ContentItemType -> Bool
ContentItemType -> ContentItemType -> Ordering
ContentItemType -> ContentItemType -> ContentItemType
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 :: ContentItemType -> ContentItemType -> ContentItemType
$cmin :: ContentItemType -> ContentItemType -> ContentItemType
max :: ContentItemType -> ContentItemType -> ContentItemType
$cmax :: ContentItemType -> ContentItemType -> ContentItemType
>= :: ContentItemType -> ContentItemType -> Bool
$c>= :: ContentItemType -> ContentItemType -> Bool
> :: ContentItemType -> ContentItemType -> Bool
$c> :: ContentItemType -> ContentItemType -> Bool
<= :: ContentItemType -> ContentItemType -> Bool
$c<= :: ContentItemType -> ContentItemType -> Bool
< :: ContentItemType -> ContentItemType -> Bool
$c< :: ContentItemType -> ContentItemType -> Bool
compare :: ContentItemType -> ContentItemType -> Ordering
$ccompare :: ContentItemType -> ContentItemType -> Ordering
Ord, (forall x. ContentItemType -> Rep ContentItemType x)
-> (forall x. Rep ContentItemType x -> ContentItemType)
-> Generic ContentItemType
forall x. Rep ContentItemType x -> ContentItemType
forall x. ContentItemType -> Rep ContentItemType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentItemType x -> ContentItemType
$cfrom :: forall x. ContentItemType -> Rep ContentItemType x
Generic)

instance NFData ContentItemType where rnf :: ContentItemType -> ()
rnf = ContentItemType -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary ContentItemType

-- | Information common to both kinds of Content: files and directories.
data ContentInfo = ContentInfo {
   ContentInfo -> Text
contentName    :: !Text
  ,ContentInfo -> Text
contentPath    :: !Text
  ,ContentInfo -> Text
contentSha     :: !Text
  ,ContentInfo -> URL
contentUrl     :: !URL
  ,ContentInfo -> URL
contentGitUrl  :: !URL
  ,ContentInfo -> URL
contentHtmlUrl :: !URL
} deriving (Int -> ContentInfo -> ShowS
[ContentInfo] -> ShowS
ContentInfo -> String
(Int -> ContentInfo -> ShowS)
-> (ContentInfo -> String)
-> ([ContentInfo] -> ShowS)
-> Show ContentInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentInfo] -> ShowS
$cshowList :: [ContentInfo] -> ShowS
show :: ContentInfo -> String
$cshow :: ContentInfo -> String
showsPrec :: Int -> ContentInfo -> ShowS
$cshowsPrec :: Int -> ContentInfo -> ShowS
Show, Typeable ContentInfo
Typeable ContentInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ContentInfo -> c ContentInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContentInfo)
-> (ContentInfo -> Constr)
-> (ContentInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContentInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContentInfo))
-> ((forall b. Data b => b -> b) -> ContentInfo -> ContentInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentInfo -> r)
-> (forall u. (forall d. Data d => d -> u) -> ContentInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContentInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo)
-> Data ContentInfo
ContentInfo -> DataType
ContentInfo -> Constr
(forall b. Data b => b -> b) -> ContentInfo -> ContentInfo
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) -> ContentInfo -> u
forall u. (forall d. Data d => d -> u) -> ContentInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentInfo -> c ContentInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentInfo -> m ContentInfo
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ContentInfo -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ContentInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ContentInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContentInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentInfo -> r
gmapT :: (forall b. Data b => b -> b) -> ContentInfo -> ContentInfo
$cgmapT :: (forall b. Data b => b -> b) -> ContentInfo -> ContentInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentInfo)
dataTypeOf :: ContentInfo -> DataType
$cdataTypeOf :: ContentInfo -> DataType
toConstr :: ContentInfo -> Constr
$ctoConstr :: ContentInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentInfo -> c ContentInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentInfo -> c ContentInfo
Data, Typeable, ContentInfo -> ContentInfo -> Bool
(ContentInfo -> ContentInfo -> Bool)
-> (ContentInfo -> ContentInfo -> Bool) -> Eq ContentInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentInfo -> ContentInfo -> Bool
$c/= :: ContentInfo -> ContentInfo -> Bool
== :: ContentInfo -> ContentInfo -> Bool
$c== :: ContentInfo -> ContentInfo -> Bool
Eq, Eq ContentInfo
Eq ContentInfo
-> (ContentInfo -> ContentInfo -> Ordering)
-> (ContentInfo -> ContentInfo -> Bool)
-> (ContentInfo -> ContentInfo -> Bool)
-> (ContentInfo -> ContentInfo -> Bool)
-> (ContentInfo -> ContentInfo -> Bool)
-> (ContentInfo -> ContentInfo -> ContentInfo)
-> (ContentInfo -> ContentInfo -> ContentInfo)
-> Ord ContentInfo
ContentInfo -> ContentInfo -> Bool
ContentInfo -> ContentInfo -> Ordering
ContentInfo -> ContentInfo -> ContentInfo
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 :: ContentInfo -> ContentInfo -> ContentInfo
$cmin :: ContentInfo -> ContentInfo -> ContentInfo
max :: ContentInfo -> ContentInfo -> ContentInfo
$cmax :: ContentInfo -> ContentInfo -> ContentInfo
>= :: ContentInfo -> ContentInfo -> Bool
$c>= :: ContentInfo -> ContentInfo -> Bool
> :: ContentInfo -> ContentInfo -> Bool
$c> :: ContentInfo -> ContentInfo -> Bool
<= :: ContentInfo -> ContentInfo -> Bool
$c<= :: ContentInfo -> ContentInfo -> Bool
< :: ContentInfo -> ContentInfo -> Bool
$c< :: ContentInfo -> ContentInfo -> Bool
compare :: ContentInfo -> ContentInfo -> Ordering
$ccompare :: ContentInfo -> ContentInfo -> Ordering
Ord, (forall x. ContentInfo -> Rep ContentInfo x)
-> (forall x. Rep ContentInfo x -> ContentInfo)
-> Generic ContentInfo
forall x. Rep ContentInfo x -> ContentInfo
forall x. ContentInfo -> Rep ContentInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentInfo x -> ContentInfo
$cfrom :: forall x. ContentInfo -> Rep ContentInfo x
Generic)

instance NFData ContentInfo where rnf :: ContentInfo -> ()
rnf = ContentInfo -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary ContentInfo

data ContentResultInfo = ContentResultInfo
    { ContentResultInfo -> ContentInfo
contentResultInfo :: !ContentInfo
    , ContentResultInfo -> Int
contentResultSize :: !Int
    } deriving (Int -> ContentResultInfo -> ShowS
[ContentResultInfo] -> ShowS
ContentResultInfo -> String
(Int -> ContentResultInfo -> ShowS)
-> (ContentResultInfo -> String)
-> ([ContentResultInfo] -> ShowS)
-> Show ContentResultInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentResultInfo] -> ShowS
$cshowList :: [ContentResultInfo] -> ShowS
show :: ContentResultInfo -> String
$cshow :: ContentResultInfo -> String
showsPrec :: Int -> ContentResultInfo -> ShowS
$cshowsPrec :: Int -> ContentResultInfo -> ShowS
Show, Typeable ContentResultInfo
Typeable ContentResultInfo
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g)
    -> ContentResultInfo
    -> c ContentResultInfo)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContentResultInfo)
-> (ContentResultInfo -> Constr)
-> (ContentResultInfo -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContentResultInfo))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContentResultInfo))
-> ((forall b. Data b => b -> b)
    -> ContentResultInfo -> ContentResultInfo)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r)
-> (forall u.
    (forall d. Data d => d -> u) -> ContentResultInfo -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContentResultInfo -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d)
    -> ContentResultInfo -> m ContentResultInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContentResultInfo -> m ContentResultInfo)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d)
    -> ContentResultInfo -> m ContentResultInfo)
-> Data ContentResultInfo
ContentResultInfo -> DataType
ContentResultInfo -> Constr
(forall b. Data b => b -> b)
-> ContentResultInfo -> ContentResultInfo
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) -> ContentResultInfo -> u
forall u. (forall d. Data d => d -> u) -> ContentResultInfo -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentResultInfo
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentResultInfo -> c ContentResultInfo
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentResultInfo)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentResultInfo)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d)
-> ContentResultInfo -> m ContentResultInfo
gmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContentResultInfo -> u
$cgmapQi :: forall u.
Int -> (forall d. Data d => d -> u) -> ContentResultInfo -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ContentResultInfo -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContentResultInfo -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResultInfo -> r
gmapT :: (forall b. Data b => b -> b)
-> ContentResultInfo -> ContentResultInfo
$cgmapT :: (forall b. Data b => b -> b)
-> ContentResultInfo -> ContentResultInfo
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentResultInfo)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentResultInfo)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentResultInfo)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentResultInfo)
dataTypeOf :: ContentResultInfo -> DataType
$cdataTypeOf :: ContentResultInfo -> DataType
toConstr :: ContentResultInfo -> Constr
$ctoConstr :: ContentResultInfo -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentResultInfo
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentResultInfo
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentResultInfo -> c ContentResultInfo
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentResultInfo -> c ContentResultInfo
Data, Typeable, ContentResultInfo -> ContentResultInfo -> Bool
(ContentResultInfo -> ContentResultInfo -> Bool)
-> (ContentResultInfo -> ContentResultInfo -> Bool)
-> Eq ContentResultInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentResultInfo -> ContentResultInfo -> Bool
$c/= :: ContentResultInfo -> ContentResultInfo -> Bool
== :: ContentResultInfo -> ContentResultInfo -> Bool
$c== :: ContentResultInfo -> ContentResultInfo -> Bool
Eq, Eq ContentResultInfo
Eq ContentResultInfo
-> (ContentResultInfo -> ContentResultInfo -> Ordering)
-> (ContentResultInfo -> ContentResultInfo -> Bool)
-> (ContentResultInfo -> ContentResultInfo -> Bool)
-> (ContentResultInfo -> ContentResultInfo -> Bool)
-> (ContentResultInfo -> ContentResultInfo -> Bool)
-> (ContentResultInfo -> ContentResultInfo -> ContentResultInfo)
-> (ContentResultInfo -> ContentResultInfo -> ContentResultInfo)
-> Ord ContentResultInfo
ContentResultInfo -> ContentResultInfo -> Bool
ContentResultInfo -> ContentResultInfo -> Ordering
ContentResultInfo -> ContentResultInfo -> ContentResultInfo
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 :: ContentResultInfo -> ContentResultInfo -> ContentResultInfo
$cmin :: ContentResultInfo -> ContentResultInfo -> ContentResultInfo
max :: ContentResultInfo -> ContentResultInfo -> ContentResultInfo
$cmax :: ContentResultInfo -> ContentResultInfo -> ContentResultInfo
>= :: ContentResultInfo -> ContentResultInfo -> Bool
$c>= :: ContentResultInfo -> ContentResultInfo -> Bool
> :: ContentResultInfo -> ContentResultInfo -> Bool
$c> :: ContentResultInfo -> ContentResultInfo -> Bool
<= :: ContentResultInfo -> ContentResultInfo -> Bool
$c<= :: ContentResultInfo -> ContentResultInfo -> Bool
< :: ContentResultInfo -> ContentResultInfo -> Bool
$c< :: ContentResultInfo -> ContentResultInfo -> Bool
compare :: ContentResultInfo -> ContentResultInfo -> Ordering
$ccompare :: ContentResultInfo -> ContentResultInfo -> Ordering
Ord, (forall x. ContentResultInfo -> Rep ContentResultInfo x)
-> (forall x. Rep ContentResultInfo x -> ContentResultInfo)
-> Generic ContentResultInfo
forall x. Rep ContentResultInfo x -> ContentResultInfo
forall x. ContentResultInfo -> Rep ContentResultInfo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentResultInfo x -> ContentResultInfo
$cfrom :: forall x. ContentResultInfo -> Rep ContentResultInfo x
Generic)

instance NFData ContentResultInfo where rnf :: ContentResultInfo -> ()
rnf = ContentResultInfo -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary ContentResultInfo

data ContentResult = ContentResult
    { ContentResult -> ContentResultInfo
contentResultContent  :: !ContentResultInfo
    , ContentResult -> GitCommit
contentResultCommit   :: !GitCommit
    } deriving (Int -> ContentResult -> ShowS
[ContentResult] -> ShowS
ContentResult -> String
(Int -> ContentResult -> ShowS)
-> (ContentResult -> String)
-> ([ContentResult] -> ShowS)
-> Show ContentResult
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentResult] -> ShowS
$cshowList :: [ContentResult] -> ShowS
show :: ContentResult -> String
$cshow :: ContentResult -> String
showsPrec :: Int -> ContentResult -> ShowS
$cshowsPrec :: Int -> ContentResult -> ShowS
Show, Typeable ContentResult
Typeable ContentResult
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> ContentResult -> c ContentResult)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c ContentResult)
-> (ContentResult -> Constr)
-> (ContentResult -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c ContentResult))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c ContentResult))
-> ((forall b. Data b => b -> b) -> ContentResult -> ContentResult)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentResult -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> ContentResult -> r)
-> (forall u. (forall d. Data d => d -> u) -> ContentResult -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> ContentResult -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> ContentResult -> m ContentResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ContentResult -> m ContentResult)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> ContentResult -> m ContentResult)
-> Data ContentResult
ContentResult -> DataType
ContentResult -> Constr
(forall b. Data b => b -> b) -> ContentResult -> ContentResult
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) -> ContentResult -> u
forall u. (forall d. Data d => d -> u) -> ContentResult -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResult -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResult -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentResult
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentResult -> c ContentResult
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentResult)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentResult)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> ContentResult -> m ContentResult
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ContentResult -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> ContentResult -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> ContentResult -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> ContentResult -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResult -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResult -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResult -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> ContentResult -> r
gmapT :: (forall b. Data b => b -> b) -> ContentResult -> ContentResult
$cgmapT :: (forall b. Data b => b -> b) -> ContentResult -> ContentResult
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentResult)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e))
-> Maybe (c ContentResult)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentResult)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c ContentResult)
dataTypeOf :: ContentResult -> DataType
$cdataTypeOf :: ContentResult -> DataType
toConstr :: ContentResult -> Constr
$ctoConstr :: ContentResult -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentResult
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c ContentResult
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentResult -> c ContentResult
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> ContentResult -> c ContentResult
Data, Typeable, ContentResult -> ContentResult -> Bool
(ContentResult -> ContentResult -> Bool)
-> (ContentResult -> ContentResult -> Bool) -> Eq ContentResult
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentResult -> ContentResult -> Bool
$c/= :: ContentResult -> ContentResult -> Bool
== :: ContentResult -> ContentResult -> Bool
$c== :: ContentResult -> ContentResult -> Bool
Eq, Eq ContentResult
Eq ContentResult
-> (ContentResult -> ContentResult -> Ordering)
-> (ContentResult -> ContentResult -> Bool)
-> (ContentResult -> ContentResult -> Bool)
-> (ContentResult -> ContentResult -> Bool)
-> (ContentResult -> ContentResult -> Bool)
-> (ContentResult -> ContentResult -> ContentResult)
-> (ContentResult -> ContentResult -> ContentResult)
-> Ord ContentResult
ContentResult -> ContentResult -> Bool
ContentResult -> ContentResult -> Ordering
ContentResult -> ContentResult -> ContentResult
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 :: ContentResult -> ContentResult -> ContentResult
$cmin :: ContentResult -> ContentResult -> ContentResult
max :: ContentResult -> ContentResult -> ContentResult
$cmax :: ContentResult -> ContentResult -> ContentResult
>= :: ContentResult -> ContentResult -> Bool
$c>= :: ContentResult -> ContentResult -> Bool
> :: ContentResult -> ContentResult -> Bool
$c> :: ContentResult -> ContentResult -> Bool
<= :: ContentResult -> ContentResult -> Bool
$c<= :: ContentResult -> ContentResult -> Bool
< :: ContentResult -> ContentResult -> Bool
$c< :: ContentResult -> ContentResult -> Bool
compare :: ContentResult -> ContentResult -> Ordering
$ccompare :: ContentResult -> ContentResult -> Ordering
Ord, (forall x. ContentResult -> Rep ContentResult x)
-> (forall x. Rep ContentResult x -> ContentResult)
-> Generic ContentResult
forall x. Rep ContentResult x -> ContentResult
forall x. ContentResult -> Rep ContentResult x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentResult x -> ContentResult
$cfrom :: forall x. ContentResult -> Rep ContentResult x
Generic)

instance NFData ContentResult where rnf :: ContentResult -> ()
rnf = ContentResult -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary ContentResult

data Author = Author
    { Author -> Text
authorName  :: !Text
    , Author -> Text
authorEmail :: !Text
    }
    deriving (Author -> Author -> Bool
(Author -> Author -> Bool)
-> (Author -> Author -> Bool) -> Eq Author
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Author -> Author -> Bool
$c/= :: Author -> Author -> Bool
== :: Author -> Author -> Bool
$c== :: Author -> Author -> Bool
Eq, Eq Author
Eq Author
-> (Author -> Author -> Ordering)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Bool)
-> (Author -> Author -> Author)
-> (Author -> Author -> Author)
-> Ord Author
Author -> Author -> Bool
Author -> Author -> Ordering
Author -> Author -> Author
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 :: Author -> Author -> Author
$cmin :: Author -> Author -> Author
max :: Author -> Author -> Author
$cmax :: Author -> Author -> Author
>= :: Author -> Author -> Bool
$c>= :: Author -> Author -> Bool
> :: Author -> Author -> Bool
$c> :: Author -> Author -> Bool
<= :: Author -> Author -> Bool
$c<= :: Author -> Author -> Bool
< :: Author -> Author -> Bool
$c< :: Author -> Author -> Bool
compare :: Author -> Author -> Ordering
$ccompare :: Author -> Author -> Ordering
Ord, Int -> Author -> ShowS
[Author] -> ShowS
Author -> String
(Int -> Author -> ShowS)
-> (Author -> String) -> ([Author] -> ShowS) -> Show Author
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Author] -> ShowS
$cshowList :: [Author] -> ShowS
show :: Author -> String
$cshow :: Author -> String
showsPrec :: Int -> Author -> ShowS
$cshowsPrec :: Int -> Author -> ShowS
Show, Typeable Author
Typeable Author
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> Author -> c Author)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Author)
-> (Author -> Constr)
-> (Author -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Author))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Author))
-> ((forall b. Data b => b -> b) -> Author -> Author)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Author -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Author -> r)
-> (forall u. (forall d. Data d => d -> u) -> Author -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Author -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Author -> m Author)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Author -> m Author)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Author -> m Author)
-> Data Author
Author -> DataType
Author -> Constr
(forall b. Data b => b -> b) -> Author -> Author
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) -> Author -> u
forall u. (forall d. Data d => d -> u) -> Author -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Author -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Author -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Author -> m Author
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Author -> m Author
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Author
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Author -> c Author
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Author)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Author)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Author -> m Author
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Author -> m Author
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Author -> m Author
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Author -> m Author
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Author -> m Author
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Author -> m Author
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Author -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Author -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> Author -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Author -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Author -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> Author -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Author -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> Author -> r
gmapT :: (forall b. Data b => b -> b) -> Author -> Author
$cgmapT :: (forall b. Data b => b -> b) -> Author -> Author
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Author)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Author)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Author)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Author)
dataTypeOf :: Author -> DataType
$cdataTypeOf :: Author -> DataType
toConstr :: Author -> Constr
$ctoConstr :: Author -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Author
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Author
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Author -> c Author
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Author -> c Author
Data, Typeable, (forall x. Author -> Rep Author x)
-> (forall x. Rep Author x -> Author) -> Generic Author
forall x. Rep Author x -> Author
forall x. Author -> Rep Author x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Author x -> Author
$cfrom :: forall x. Author -> Rep Author x
Generic)

instance NFData Author where rnf :: Author -> ()
rnf = Author -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary Author

data CreateFile = CreateFile
    { CreateFile -> Text
createFilePath      :: !Text
    , CreateFile -> Text
createFileMessage   :: !Text
    , CreateFile -> Text
createFileContent   :: !Text
    , CreateFile -> Maybe Text
createFileBranch    :: !(Maybe Text)
    , CreateFile -> Maybe Author
createFileAuthor    :: !(Maybe Author)
    , CreateFile -> Maybe Author
createFileCommitter :: !(Maybe Author)
    }
    deriving (CreateFile -> CreateFile -> Bool
(CreateFile -> CreateFile -> Bool)
-> (CreateFile -> CreateFile -> Bool) -> Eq CreateFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFile -> CreateFile -> Bool
$c/= :: CreateFile -> CreateFile -> Bool
== :: CreateFile -> CreateFile -> Bool
$c== :: CreateFile -> CreateFile -> Bool
Eq, Eq CreateFile
Eq CreateFile
-> (CreateFile -> CreateFile -> Ordering)
-> (CreateFile -> CreateFile -> Bool)
-> (CreateFile -> CreateFile -> Bool)
-> (CreateFile -> CreateFile -> Bool)
-> (CreateFile -> CreateFile -> Bool)
-> (CreateFile -> CreateFile -> CreateFile)
-> (CreateFile -> CreateFile -> CreateFile)
-> Ord CreateFile
CreateFile -> CreateFile -> Bool
CreateFile -> CreateFile -> Ordering
CreateFile -> CreateFile -> CreateFile
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 :: CreateFile -> CreateFile -> CreateFile
$cmin :: CreateFile -> CreateFile -> CreateFile
max :: CreateFile -> CreateFile -> CreateFile
$cmax :: CreateFile -> CreateFile -> CreateFile
>= :: CreateFile -> CreateFile -> Bool
$c>= :: CreateFile -> CreateFile -> Bool
> :: CreateFile -> CreateFile -> Bool
$c> :: CreateFile -> CreateFile -> Bool
<= :: CreateFile -> CreateFile -> Bool
$c<= :: CreateFile -> CreateFile -> Bool
< :: CreateFile -> CreateFile -> Bool
$c< :: CreateFile -> CreateFile -> Bool
compare :: CreateFile -> CreateFile -> Ordering
$ccompare :: CreateFile -> CreateFile -> Ordering
Ord, Int -> CreateFile -> ShowS
[CreateFile] -> ShowS
CreateFile -> String
(Int -> CreateFile -> ShowS)
-> (CreateFile -> String)
-> ([CreateFile] -> ShowS)
-> Show CreateFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFile] -> ShowS
$cshowList :: [CreateFile] -> ShowS
show :: CreateFile -> String
$cshow :: CreateFile -> String
showsPrec :: Int -> CreateFile -> ShowS
$cshowsPrec :: Int -> CreateFile -> ShowS
Show, Typeable CreateFile
Typeable CreateFile
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> CreateFile -> c CreateFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c CreateFile)
-> (CreateFile -> Constr)
-> (CreateFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c CreateFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c CreateFile))
-> ((forall b. Data b => b -> b) -> CreateFile -> CreateFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> CreateFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> CreateFile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> CreateFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> CreateFile -> m CreateFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CreateFile -> m CreateFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> CreateFile -> m CreateFile)
-> Data CreateFile
CreateFile -> DataType
CreateFile -> Constr
(forall b. Data b => b -> b) -> CreateFile -> CreateFile
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) -> CreateFile -> u
forall u. (forall d. Data d => d -> u) -> CreateFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateFile -> c CreateFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CreateFile)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> CreateFile -> m CreateFile
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CreateFile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> CreateFile -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> CreateFile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> CreateFile -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> CreateFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateFile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> CreateFile -> r
gmapT :: (forall b. Data b => b -> b) -> CreateFile -> CreateFile
$cgmapT :: (forall b. Data b => b -> b) -> CreateFile -> CreateFile
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CreateFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c CreateFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateFile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c CreateFile)
dataTypeOf :: CreateFile -> DataType
$cdataTypeOf :: CreateFile -> DataType
toConstr :: CreateFile -> Constr
$ctoConstr :: CreateFile -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c CreateFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateFile -> c CreateFile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> CreateFile -> c CreateFile
Data, Typeable, (forall x. CreateFile -> Rep CreateFile x)
-> (forall x. Rep CreateFile x -> CreateFile) -> Generic CreateFile
forall x. Rep CreateFile x -> CreateFile
forall x. CreateFile -> Rep CreateFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFile x -> CreateFile
$cfrom :: forall x. CreateFile -> Rep CreateFile x
Generic)

instance NFData CreateFile where rnf :: CreateFile -> ()
rnf = CreateFile -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary CreateFile

data UpdateFile = UpdateFile
    { UpdateFile -> Text
updateFilePath      :: !Text
    , UpdateFile -> Text
updateFileMessage   :: !Text
    , UpdateFile -> Text
updateFileContent   :: !Text
    , UpdateFile -> Text
updateFileSHA       :: !Text
    , UpdateFile -> Maybe Text
updateFileBranch    :: !(Maybe Text)
    , UpdateFile -> Maybe Author
updateFileAuthor    :: !(Maybe Author)
    , UpdateFile -> Maybe Author
updateFileCommitter :: !(Maybe Author)
    }
    deriving (UpdateFile -> UpdateFile -> Bool
(UpdateFile -> UpdateFile -> Bool)
-> (UpdateFile -> UpdateFile -> Bool) -> Eq UpdateFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFile -> UpdateFile -> Bool
$c/= :: UpdateFile -> UpdateFile -> Bool
== :: UpdateFile -> UpdateFile -> Bool
$c== :: UpdateFile -> UpdateFile -> Bool
Eq, Eq UpdateFile
Eq UpdateFile
-> (UpdateFile -> UpdateFile -> Ordering)
-> (UpdateFile -> UpdateFile -> Bool)
-> (UpdateFile -> UpdateFile -> Bool)
-> (UpdateFile -> UpdateFile -> Bool)
-> (UpdateFile -> UpdateFile -> Bool)
-> (UpdateFile -> UpdateFile -> UpdateFile)
-> (UpdateFile -> UpdateFile -> UpdateFile)
-> Ord UpdateFile
UpdateFile -> UpdateFile -> Bool
UpdateFile -> UpdateFile -> Ordering
UpdateFile -> UpdateFile -> UpdateFile
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 :: UpdateFile -> UpdateFile -> UpdateFile
$cmin :: UpdateFile -> UpdateFile -> UpdateFile
max :: UpdateFile -> UpdateFile -> UpdateFile
$cmax :: UpdateFile -> UpdateFile -> UpdateFile
>= :: UpdateFile -> UpdateFile -> Bool
$c>= :: UpdateFile -> UpdateFile -> Bool
> :: UpdateFile -> UpdateFile -> Bool
$c> :: UpdateFile -> UpdateFile -> Bool
<= :: UpdateFile -> UpdateFile -> Bool
$c<= :: UpdateFile -> UpdateFile -> Bool
< :: UpdateFile -> UpdateFile -> Bool
$c< :: UpdateFile -> UpdateFile -> Bool
compare :: UpdateFile -> UpdateFile -> Ordering
$ccompare :: UpdateFile -> UpdateFile -> Ordering
Ord, Int -> UpdateFile -> ShowS
[UpdateFile] -> ShowS
UpdateFile -> String
(Int -> UpdateFile -> ShowS)
-> (UpdateFile -> String)
-> ([UpdateFile] -> ShowS)
-> Show UpdateFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFile] -> ShowS
$cshowList :: [UpdateFile] -> ShowS
show :: UpdateFile -> String
$cshow :: UpdateFile -> String
showsPrec :: Int -> UpdateFile -> ShowS
$cshowsPrec :: Int -> UpdateFile -> ShowS
Show, Typeable UpdateFile
Typeable UpdateFile
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> UpdateFile -> c UpdateFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c UpdateFile)
-> (UpdateFile -> Constr)
-> (UpdateFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c UpdateFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c UpdateFile))
-> ((forall b. Data b => b -> b) -> UpdateFile -> UpdateFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> UpdateFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> UpdateFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> UpdateFile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> UpdateFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile)
-> Data UpdateFile
UpdateFile -> DataType
UpdateFile -> Constr
(forall b. Data b => b -> b) -> UpdateFile -> UpdateFile
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) -> UpdateFile -> u
forall u. (forall d. Data d => d -> u) -> UpdateFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateFile -> c UpdateFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpdateFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpdateFile)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> UpdateFile -> m UpdateFile
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UpdateFile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> UpdateFile -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> UpdateFile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> UpdateFile -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateFile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> UpdateFile -> r
gmapT :: (forall b. Data b => b -> b) -> UpdateFile -> UpdateFile
$cgmapT :: (forall b. Data b => b -> b) -> UpdateFile -> UpdateFile
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpdateFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c UpdateFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpdateFile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c UpdateFile)
dataTypeOf :: UpdateFile -> DataType
$cdataTypeOf :: UpdateFile -> DataType
toConstr :: UpdateFile -> Constr
$ctoConstr :: UpdateFile -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c UpdateFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateFile -> c UpdateFile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> UpdateFile -> c UpdateFile
Data, Typeable, (forall x. UpdateFile -> Rep UpdateFile x)
-> (forall x. Rep UpdateFile x -> UpdateFile) -> Generic UpdateFile
forall x. Rep UpdateFile x -> UpdateFile
forall x. UpdateFile -> Rep UpdateFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFile x -> UpdateFile
$cfrom :: forall x. UpdateFile -> Rep UpdateFile x
Generic)

instance NFData UpdateFile where rnf :: UpdateFile -> ()
rnf = UpdateFile -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary UpdateFile

data DeleteFile = DeleteFile
    { DeleteFile -> Text
deleteFilePath      :: !Text
    , DeleteFile -> Text
deleteFileMessage   :: !Text
    , DeleteFile -> Text
deleteFileSHA       :: !Text
    , DeleteFile -> Maybe Text
deleteFileBranch    :: !(Maybe Text)
    , DeleteFile -> Maybe Author
deleteFileAuthor    :: !(Maybe Author)
    , DeleteFile -> Maybe Author
deleteFileCommitter :: !(Maybe Author)
    }
    deriving (DeleteFile -> DeleteFile -> Bool
(DeleteFile -> DeleteFile -> Bool)
-> (DeleteFile -> DeleteFile -> Bool) -> Eq DeleteFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFile -> DeleteFile -> Bool
$c/= :: DeleteFile -> DeleteFile -> Bool
== :: DeleteFile -> DeleteFile -> Bool
$c== :: DeleteFile -> DeleteFile -> Bool
Eq, Eq DeleteFile
Eq DeleteFile
-> (DeleteFile -> DeleteFile -> Ordering)
-> (DeleteFile -> DeleteFile -> Bool)
-> (DeleteFile -> DeleteFile -> Bool)
-> (DeleteFile -> DeleteFile -> Bool)
-> (DeleteFile -> DeleteFile -> Bool)
-> (DeleteFile -> DeleteFile -> DeleteFile)
-> (DeleteFile -> DeleteFile -> DeleteFile)
-> Ord DeleteFile
DeleteFile -> DeleteFile -> Bool
DeleteFile -> DeleteFile -> Ordering
DeleteFile -> DeleteFile -> DeleteFile
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 :: DeleteFile -> DeleteFile -> DeleteFile
$cmin :: DeleteFile -> DeleteFile -> DeleteFile
max :: DeleteFile -> DeleteFile -> DeleteFile
$cmax :: DeleteFile -> DeleteFile -> DeleteFile
>= :: DeleteFile -> DeleteFile -> Bool
$c>= :: DeleteFile -> DeleteFile -> Bool
> :: DeleteFile -> DeleteFile -> Bool
$c> :: DeleteFile -> DeleteFile -> Bool
<= :: DeleteFile -> DeleteFile -> Bool
$c<= :: DeleteFile -> DeleteFile -> Bool
< :: DeleteFile -> DeleteFile -> Bool
$c< :: DeleteFile -> DeleteFile -> Bool
compare :: DeleteFile -> DeleteFile -> Ordering
$ccompare :: DeleteFile -> DeleteFile -> Ordering
Ord, Int -> DeleteFile -> ShowS
[DeleteFile] -> ShowS
DeleteFile -> String
(Int -> DeleteFile -> ShowS)
-> (DeleteFile -> String)
-> ([DeleteFile] -> ShowS)
-> Show DeleteFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFile] -> ShowS
$cshowList :: [DeleteFile] -> ShowS
show :: DeleteFile -> String
$cshow :: DeleteFile -> String
showsPrec :: Int -> DeleteFile -> ShowS
$cshowsPrec :: Int -> DeleteFile -> ShowS
Show, Typeable DeleteFile
Typeable DeleteFile
-> (forall (c :: * -> *).
    (forall d b. Data d => c (d -> b) -> d -> c b)
    -> (forall g. g -> c g) -> DeleteFile -> c DeleteFile)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c DeleteFile)
-> (DeleteFile -> Constr)
-> (DeleteFile -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c DeleteFile))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e))
    -> Maybe (c DeleteFile))
-> ((forall b. Data b => b -> b) -> DeleteFile -> DeleteFile)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteFile -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> DeleteFile -> r)
-> (forall u. (forall d. Data d => d -> u) -> DeleteFile -> [u])
-> (forall u.
    Int -> (forall d. Data d => d -> u) -> DeleteFile -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile)
-> Data DeleteFile
DeleteFile -> DataType
DeleteFile -> Constr
(forall b. Data b => b -> b) -> DeleteFile -> DeleteFile
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) -> DeleteFile -> u
forall u. (forall d. Data d => d -> u) -> DeleteFile -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFile -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFile -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteFile
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeleteFile -> c DeleteFile
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteFile)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeleteFile)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> DeleteFile -> m DeleteFile
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DeleteFile -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> DeleteFile -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> DeleteFile -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> DeleteFile -> [u]
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFile -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFile -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFile -> r
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> DeleteFile -> r
gmapT :: (forall b. Data b => b -> b) -> DeleteFile -> DeleteFile
$cgmapT :: (forall b. Data b => b -> b) -> DeleteFile -> DeleteFile
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeleteFile)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c DeleteFile)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteFile)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c DeleteFile)
dataTypeOf :: DeleteFile -> DataType
$cdataTypeOf :: DeleteFile -> DataType
toConstr :: DeleteFile -> Constr
$ctoConstr :: DeleteFile -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteFile
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c DeleteFile
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeleteFile -> c DeleteFile
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> DeleteFile -> c DeleteFile
Data, Typeable, (forall x. DeleteFile -> Rep DeleteFile x)
-> (forall x. Rep DeleteFile x -> DeleteFile) -> Generic DeleteFile
forall x. Rep DeleteFile x -> DeleteFile
forall x. DeleteFile -> Rep DeleteFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteFile x -> DeleteFile
$cfrom :: forall x. DeleteFile -> Rep DeleteFile x
Generic)

instance NFData DeleteFile where rnf :: DeleteFile -> ()
rnf = DeleteFile -> ()
forall a. (Generic a, GNFData (Rep a)) => a -> ()
genericRnf
instance Binary DeleteFile

instance FromJSON Content where
  parseJSON :: Value -> Parser Content
parseJSON o :: Value
o@(Object Object
_) = ContentFileData -> Content
ContentFile (ContentFileData -> Content)
-> Parser ContentFileData -> Parser Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ContentFileData
forall a. FromJSON a => Value -> Parser a
parseJSON Value
o
  parseJSON (Array Array
os) = Vector ContentItem -> Content
ContentDirectory (Vector ContentItem -> Content)
-> Parser (Vector ContentItem) -> Parser Content
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Value -> Parser ContentItem)
-> Array -> Parser (Vector ContentItem)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse Value -> Parser ContentItem
forall a. FromJSON a => Value -> Parser a
parseJSON Array
os
  parseJSON Value
_ = String -> Parser Content
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Could not build a Content"

instance FromJSON ContentFileData where
  parseJSON :: Value -> Parser ContentFileData
parseJSON = String
-> (Object -> Parser ContentFileData)
-> Value
-> Parser ContentFileData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContentFileData" ((Object -> Parser ContentFileData)
 -> Value -> Parser ContentFileData)
-> (Object -> Parser ContentFileData)
-> Value
-> Parser ContentFileData
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ContentInfo -> Text -> Int -> Text -> ContentFileData
ContentFileData (ContentInfo -> Text -> Int -> Text -> ContentFileData)
-> Parser ContentInfo
-> Parser (Text -> Int -> Text -> ContentFileData)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ContentInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
                    Parser (Text -> Int -> Text -> ContentFileData)
-> Parser Text -> Parser (Int -> Text -> ContentFileData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"encoding"
                    Parser (Int -> Text -> ContentFileData)
-> Parser Int -> Parser (Text -> ContentFileData)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"
                    Parser (Text -> ContentFileData)
-> Parser Text -> Parser ContentFileData
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"

instance FromJSON ContentItem where
  parseJSON :: Value -> Parser ContentItem
parseJSON = String
-> (Object -> Parser ContentItem) -> Value -> Parser ContentItem
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContentItem" ((Object -> Parser ContentItem) -> Value -> Parser ContentItem)
-> (Object -> Parser ContentItem) -> Value -> Parser ContentItem
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ContentItemType -> ContentInfo -> ContentItem
ContentItem (ContentItemType -> ContentInfo -> ContentItem)
-> Parser ContentItemType -> Parser (ContentInfo -> ContentItem)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ContentItemType
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
                Parser (ContentInfo -> ContentItem)
-> Parser ContentInfo -> Parser ContentItem
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Value -> Parser ContentInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)

instance FromJSON ContentItemType where
  parseJSON :: Value -> Parser ContentItemType
parseJSON = String
-> (Text -> Parser ContentItemType)
-> Value
-> Parser ContentItemType
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"ContentItemType" ((Text -> Parser ContentItemType)
 -> Value -> Parser ContentItemType)
-> (Text -> Parser ContentItemType)
-> Value
-> Parser ContentItemType
forall a b. (a -> b) -> a -> b
$ \Text
t -> case Text -> Text
T.toLower Text
t of
    Text
"file" -> ContentItemType -> Parser ContentItemType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentItemType
ItemFile
    Text
"dir"  -> ContentItemType -> Parser ContentItemType
forall (f :: * -> *) a. Applicative f => a -> f a
pure ContentItemType
ItemDir
    Text
_      -> String -> Parser ContentItemType
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ContentItemType)
-> String -> Parser ContentItemType
forall a b. (a -> b) -> a -> b
$ String
"Unknown ContentItemType: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
t

instance FromJSON ContentInfo where
  parseJSON :: Value -> Parser ContentInfo
parseJSON = String
-> (Object -> Parser ContentInfo) -> Value -> Parser ContentInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContentInfo" ((Object -> Parser ContentInfo) -> Value -> Parser ContentInfo)
-> (Object -> Parser ContentInfo) -> Value -> Parser ContentInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    Text -> Text -> Text -> URL -> URL -> URL -> ContentInfo
ContentInfo (Text -> Text -> Text -> URL -> URL -> URL -> ContentInfo)
-> Parser Text
-> Parser (Text -> Text -> URL -> URL -> URL -> ContentInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                Parser (Text -> Text -> URL -> URL -> URL -> ContentInfo)
-> Parser Text -> Parser (Text -> URL -> URL -> URL -> ContentInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"path"
                Parser (Text -> URL -> URL -> URL -> ContentInfo)
-> Parser Text -> Parser (URL -> URL -> URL -> ContentInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"sha"
                Parser (URL -> URL -> URL -> ContentInfo)
-> Parser URL -> Parser (URL -> URL -> ContentInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser URL
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"url"
                Parser (URL -> URL -> ContentInfo)
-> Parser URL -> Parser (URL -> ContentInfo)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser URL
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"git_url"
                Parser (URL -> ContentInfo) -> Parser URL -> Parser ContentInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser URL
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"html_url"

instance FromJSON ContentResultInfo where
  parseJSON :: Value -> Parser ContentResultInfo
parseJSON = String
-> (Object -> Parser ContentResultInfo)
-> Value
-> Parser ContentResultInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContentResultInfo" ((Object -> Parser ContentResultInfo)
 -> Value -> Parser ContentResultInfo)
-> (Object -> Parser ContentResultInfo)
-> Value
-> Parser ContentResultInfo
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ContentInfo -> Int -> ContentResultInfo
ContentResultInfo (ContentInfo -> Int -> ContentResultInfo)
-> Parser ContentInfo -> Parser (Int -> ContentResultInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser ContentInfo
forall a. FromJSON a => Value -> Parser a
parseJSON (Object -> Value
Object Object
o)
                  Parser (Int -> ContentResultInfo)
-> Parser Int -> Parser ContentResultInfo
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size"

instance FromJSON ContentResult where
  parseJSON :: Value -> Parser ContentResult
parseJSON = String
-> (Object -> Parser ContentResult)
-> Value
-> Parser ContentResult
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ContentResult" ((Object -> Parser ContentResult) -> Value -> Parser ContentResult)
-> (Object -> Parser ContentResult)
-> Value
-> Parser ContentResult
forall a b. (a -> b) -> a -> b
$ \Object
o ->
    ContentResultInfo -> GitCommit -> ContentResult
ContentResult (ContentResultInfo -> GitCommit -> ContentResult)
-> Parser ContentResultInfo -> Parser (GitCommit -> ContentResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser ContentResultInfo
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"content"
                  Parser (GitCommit -> ContentResult)
-> Parser GitCommit -> Parser ContentResult
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser GitCommit
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"commit"

instance ToJSON Author where
  toJSON :: Author -> Value
toJSON Author {Text
authorEmail :: Text
authorName :: Text
authorEmail :: Author -> Text
authorName :: Author -> Text
..} = [Pair] -> Value
object
    [ Key
"name"  Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
authorName
    , Key
"email" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
authorEmail
    ]

instance ToJSON CreateFile where
  toJSON :: CreateFile -> Value
toJSON CreateFile {Maybe Text
Maybe Author
Text
createFileCommitter :: Maybe Author
createFileAuthor :: Maybe Author
createFileBranch :: Maybe Text
createFileContent :: Text
createFileMessage :: Text
createFilePath :: Text
createFileCommitter :: CreateFile -> Maybe Author
createFileAuthor :: CreateFile -> Maybe Author
createFileBranch :: CreateFile -> Maybe Text
createFileContent :: CreateFile -> Text
createFileMessage :: CreateFile -> Text
createFilePath :: CreateFile -> Text
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"path"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createFilePath
    , Key
"message"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createFileMessage
    , Key
"content"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
createFileContent
    ]
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"branch"    Key -> Maybe Text -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Text
createFileBranch
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"author"    Key -> Maybe Author -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Author
createFileAuthor
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"committer" Key -> Maybe Author -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Author
createFileCommitter

instance ToJSON UpdateFile where
  toJSON :: UpdateFile -> Value
toJSON UpdateFile {Maybe Text
Maybe Author
Text
updateFileCommitter :: Maybe Author
updateFileAuthor :: Maybe Author
updateFileBranch :: Maybe Text
updateFileSHA :: Text
updateFileContent :: Text
updateFileMessage :: Text
updateFilePath :: Text
updateFileCommitter :: UpdateFile -> Maybe Author
updateFileAuthor :: UpdateFile -> Maybe Author
updateFileBranch :: UpdateFile -> Maybe Text
updateFileSHA :: UpdateFile -> Text
updateFileContent :: UpdateFile -> Text
updateFileMessage :: UpdateFile -> Text
updateFilePath :: UpdateFile -> Text
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"path"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
updateFilePath
    , Key
"message"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
updateFileMessage
    , Key
"content"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
updateFileContent
    , Key
"sha"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
updateFileSHA
    ]
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"branch"    Key -> Maybe Text -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Text
updateFileBranch
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"author"    Key -> Maybe Author -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Author
updateFileAuthor
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"committer" Key -> Maybe Author -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Author
updateFileCommitter

instance ToJSON DeleteFile where
  toJSON :: DeleteFile -> Value
toJSON DeleteFile {Maybe Text
Maybe Author
Text
deleteFileCommitter :: Maybe Author
deleteFileAuthor :: Maybe Author
deleteFileBranch :: Maybe Text
deleteFileSHA :: Text
deleteFileMessage :: Text
deleteFilePath :: Text
deleteFileCommitter :: DeleteFile -> Maybe Author
deleteFileAuthor :: DeleteFile -> Maybe Author
deleteFileBranch :: DeleteFile -> Maybe Text
deleteFileSHA :: DeleteFile -> Text
deleteFileMessage :: DeleteFile -> Text
deleteFilePath :: DeleteFile -> Text
..} = [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
    [ Key
"path"       Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deleteFilePath
    , Key
"message"    Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deleteFileMessage
    , Key
"sha"        Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text
deleteFileSHA
    ]
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"branch"    Key -> Maybe Text -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Text
deleteFileBranch
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"author"    Key -> Maybe Author -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Author
deleteFileAuthor
    [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ Key
"committer" Key -> Maybe Author -> [Pair]
forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe Author
deleteFileCommitter

#if MIN_VERSION_aeson(2,0,0)
(.=?) :: ToJSON v => Key -> Maybe v -> [Pair]
#else
(.=?) :: ToJSON v => Text -> Maybe v -> [Pair]
#endif
Key
name .=? :: forall v. ToJSON v => Key -> Maybe v -> [Pair]
.=? Maybe v
value = [Pair] -> (v -> [Pair]) -> Maybe v -> [Pair]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Pair -> [Pair]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Pair -> [Pair]) -> (v -> Pair) -> v -> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Key
name Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.=)) Maybe v
value