-- |
-- Module: PowerDNS.API.Servers
-- Description: Servers endpoints for PowerDNS API
--
-- This module implements the endpoints described at [Servers API](https://doc.powerdns.com/authoritative/http-api/server.html)

{-# LANGUAGE DataKinds          #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE TemplateHaskell    #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE TypeOperators      #-}
{-# LANGUAGE OverloadedStrings  #-}
module PowerDNS.API.Servers
  (
  -- * API
    ServersAPI(..)

  -- * Data types
  , Server(..)
  , ObjectType(..)
  , SearchResult(..)
  , CacheFlushResult(..)
  , AnyStatisticItem(..)
  , StatisticItem(..)
  , MapStatisticItem(..)
  , RingStatisticItem(..)
  , SimpleStatisticItem(..)
  )
where


import           Data.Char (toLower)
import           Data.Data (Data)
import           Text.Read (readMaybe)

import           Control.DeepSeq (NFData)
import           Data.Aeson.TH (defaultOptions
                            , fieldLabelModifier, constructorTagModifier
                            , deriveJSON
                            , allNullaryToStringTag
                            )
import           Data.Aeson (FromJSON(..), ToJSON(..), Value(String), (.:), (.=)
                            , withObject, object
                            )
import           Data.Aeson.Types (Parser)
import qualified Data.Text as T
import           Servant.API
import           Servant.API.Generic

import           PowerDNS.Internal.Utils (Empty(..), strip, map1)

----------------------------------------------------------------------------------------

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

$(deriveJSON defaultOptions { fieldLabelModifier = strip "server_" } ''Server)

----------------------------------------------------------------------------------------

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

$(deriveJSON defaultOptions { constructorTagModifier = map1 toLower . strip "Ty"
                            , allNullaryToStringTag = True } ''ObjectType)

instance FromHttpApiData ObjectType where
  parseQueryParam :: Text -> Either Text ObjectType
parseQueryParam Text
"all" = forall a b. b -> Either a b
Right ObjectType
TyAll
  parseQueryParam Text
"zone" = forall a b. b -> Either a b
Right ObjectType
TyZone
  parseQueryParam Text
"record" = forall a b. b -> Either a b
Right ObjectType
TyRecord
  parseQueryParam Text
"comment" = forall a b. b -> Either a b
Right ObjectType
TyComment
  parseQueryParam Text
x = forall a b. a -> Either a b
Left (Text
"Unknown ObjectType: " forall a. Semigroup a => a -> a -> a
<> Text
x)

instance ToHttpApiData ObjectType where
  toQueryParam :: ObjectType -> Text
toQueryParam ObjectType
TyAll = Text
"all"
  toQueryParam ObjectType
TyZone = Text
"zone"
  toQueryParam ObjectType
TyRecord = Text
"record"
  toQueryParam ObjectType
TyComment = Text
"comment"

----------------------------------------------------------------------------------------

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

$(deriveJSON defaultOptions { fieldLabelModifier = strip "sr_" } ''SearchResult)

----------------------------------------------------------------------------------------

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

$(deriveJSON defaultOptions { fieldLabelModifier = strip "cfr_" } ''CacheFlushResult)

----------------------------------------------------------------------------------------

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

$(deriveJSON defaultOptions { fieldLabelModifier = strip "ssi_" } ''SimpleStatisticItem)

----------------------------------------------------------------------------------------

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

instance ToJSON AnyStatisticItem where
  toJSON :: AnyStatisticItem -> Value
toJSON (AnyStatisticItem StatisticItem
si) = [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"StatisticItem"
                                        , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StatisticItem -> Text
si_name StatisticItem
si
                                        , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= StatisticItem -> Text
si_value StatisticItem
si ]
  toJSON (AnyMapStatisticItem MapStatisticItem
si) = [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"MapStatisticItem"
                                           , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MapStatisticItem -> Text
msi_name MapStatisticItem
si
                                           , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= MapStatisticItem -> [SimpleStatisticItem]
msi_value MapStatisticItem
si ]
  toJSON (AnyRingStatisticItem RingStatisticItem
si) = [Pair] -> Value
object [ Key
"type" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String Text
"RingStatisticItem"
                                            , Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RingStatisticItem -> Text
rsi_name RingStatisticItem
si
                                            , Key
"size" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= Text -> Value
String (forall a. Show a => a -> Text
showT (RingStatisticItem -> Integer
rsi_size RingStatisticItem
si))
                                            , Key
"value" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= RingStatisticItem -> [SimpleStatisticItem]
rsi_value RingStatisticItem
si ]

showT :: Show a => a -> T.Text
showT :: forall a. Show a => a -> Text
showT = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

thruRead :: Read a => T.Text -> Parser a
thruRead :: forall a. Read a => Text -> Parser a
thruRead = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse") forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Read a => String -> Maybe a
readMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack

instance FromJSON AnyStatisticItem where
  parseJSON :: Value -> Parser AnyStatisticItem
parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Any StatisticItem" forall a b. (a -> b) -> a -> b
$ \Object
o -> do
    Text
r <- Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"type"
    case Text
r of
      Text
"StatisticItem" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StatisticItem -> AnyStatisticItem
AnyStatisticItem forall a b. (a -> b) -> a -> b
$
                         Text -> Text -> StatisticItem
StatisticItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                       forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Text
"MapStatisticItem" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap MapStatisticItem -> AnyStatisticItem
AnyMapStatisticItem forall a b. (a -> b) -> a -> b
$
                            Text -> [SimpleStatisticItem] -> MapStatisticItem
MapStatisticItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                             forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Text
"RingStatisticItem" -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap RingStatisticItem -> AnyStatisticItem
AnyRingStatisticItem forall a b. (a -> b) -> a -> b
$
                             Text -> Integer -> [SimpleStatisticItem] -> RingStatisticItem
RingStatisticItem forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"name"
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"size" forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. Read a => Text -> Parser a
thruRead)
                                               forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"value"
      Text
_ -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unknown type: " forall a. Semigroup a => a -> a -> a
<> Text -> String
T.unpack Text
r)

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

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

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

----------------------------------------------------------------------------------------

type QueryParamReq = QueryParam' [Required, Strict]
data ServersAPI f = ServersAPI
  { forall f. ServersAPI f -> f :- ("servers" :> Get '[JSON] [Server])
apiListServers :: f :- "servers"
                        :> Get '[JSON] [Server]

  , forall f.
ServersAPI f
-> f
   :- ("servers" :> (Capture "server_id" Text :> Get '[JSON] Server))
apiGetServer   :: f :- "servers" :> Capture "server_id" T.Text
                        :> Get '[JSON] Server

  , forall f.
ServersAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("search-data"
               :> (QueryParamReq "q" Text
                   :> (QueryParamReq "max" Integer
                       :> (QueryParam "object_type" ObjectType
                           :> Get '[JSON] [SearchResult]))))))
apiSearch      :: f :- "servers" :> Capture "server_id" T.Text :> "search-data"
                        :> QueryParamReq "q" T.Text
                        :> QueryParamReq "max" Integer
                        :> QueryParam "object_type" ObjectType
                        :> Get '[JSON] [SearchResult]

  , forall f.
ServersAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> (QueryParamReq "domain" Text :> Put '[JSON] CacheFlushResult)))
apiFlushCache  :: f :- "servers" :> Capture "server_id" T.Text
                        :> QueryParamReq "domain" T.Text
                        :> Put '[JSON] CacheFlushResult

  , forall f.
ServersAPI f
-> f
   :- ("servers"
       :> (Capture "server_id" Text
           :> ("statistics"
               :> (QueryParam "statistic" Text
                   :> (QueryParam "includerings" Bool
                       :> Get '[JSON] [AnyStatisticItem])))))
apiStatistics  :: f :- "servers" :> Capture "server_id" T.Text :> "statistics"
                        :> QueryParam "statistic" T.Text
                        :> QueryParam "includerings" Bool
                        :> Get '[JSON] [AnyStatisticItem]
  } deriving forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall f x. Rep (ServersAPI f) x -> ServersAPI f
forall f x. ServersAPI f -> Rep (ServersAPI f) x
$cto :: forall f x. Rep (ServersAPI f) x -> ServersAPI f
$cfrom :: forall f x. ServersAPI f -> Rep (ServersAPI f) x
Generic