{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -fno-warn-duplicate-exports #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
module Network.Google.Resource.Books.Dictionary.ListOfflineMetadata
(
DictionaryListOfflineMetadataResource
, dictionaryListOfflineMetadata
, DictionaryListOfflineMetadata
, dlomCpksver
) where
import Network.Google.Books.Types
import Network.Google.Prelude
type DictionaryListOfflineMetadataResource =
"books" :>
"v1" :>
"dictionary" :>
"listOfflineMetadata" :>
QueryParam "cpksver" Text :>
QueryParam "alt" AltJSON :> Get '[JSON] Metadata
newtype DictionaryListOfflineMetadata = DictionaryListOfflineMetadata'
{ _dlomCpksver :: Text
} deriving (Eq,Show,Data,Typeable,Generic)
dictionaryListOfflineMetadata
:: Text
-> DictionaryListOfflineMetadata
dictionaryListOfflineMetadata pDlomCpksver_ =
DictionaryListOfflineMetadata'
{ _dlomCpksver = pDlomCpksver_
}
dlomCpksver :: Lens' DictionaryListOfflineMetadata Text
dlomCpksver
= lens _dlomCpksver (\ s a -> s{_dlomCpksver = a})
instance GoogleRequest DictionaryListOfflineMetadata
where
type Rs DictionaryListOfflineMetadata = Metadata
type Scopes DictionaryListOfflineMetadata =
'["https://www.googleapis.com/auth/books"]
requestClient DictionaryListOfflineMetadata'{..}
= go (Just _dlomCpksver) (Just AltJSON) booksService
where go
= buildClient
(Proxy ::
Proxy DictionaryListOfflineMetadataResource)
mempty