{-# LANGUAGE DataKinds             #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TemplateHaskell       #-}
{-# LANGUAGE TypeFamilies          #-}
{-# LANGUAGE TypeOperators         #-}
{-# LANGUAGE UndecidableInstances  #-}

-- |
-- Module      : Data.EBird.Client.Product
-- Copyright   : (c) 2023 Finley McIlwaine
-- License     : MIT (see LICENSE)
--
-- Maintainer  : Finley McIlwaine <finleymcilwaine@gmail.com>
--
-- Types and functions for product-related eBird API queries.

module Data.EBird.Client.Product where

import Data.Default
import Data.Text
import Optics.TH
import Servant.Client

import Data.EBird.API
import Data.EBird.Client.Generated

-------------------------------------------------------------------------------
-- * Recent checklists
-------------------------------------------------------------------------------

-- | Get a list recently submitted checklists within a region.
--
-- For example, get up to 3 recent checklists submitted in Park County, Wyoming
-- (using @-XOverloadedLabels@ and @-XOverloadedStrings@):
--
-- @
-- askEBird $
--   recentChecklists key
--     "US-WY-029"
--     (def & #maxResults ?~ 3)
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#95a206d1-a20d-44e0-8c27-acb09ccbea1a).
recentChecklists
  :: Text
  -- ^ eBird API key
  -> RegionCode
  -- ^ Region(s) to get Checklists from
  -> RecentChecklistsParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultRecentChecklistsParams'/
  -> ClientM [ChecklistFeedEntry]
recentChecklists :: Text
-> RegionCode
-> RecentChecklistsParams
-> ClientM [ChecklistFeedEntry]
recentChecklists Text
k RegionCode
r RecentChecklistsParams{Maybe Integer
_recentChecklistsParamsMaxResults :: Maybe Integer
_recentChecklistsParamsMaxResults :: RecentChecklistsParams -> Maybe Integer
..} =
    Text -> RegionCode -> Maybe Integer -> ClientM [ChecklistFeedEntry]
recentChecklists_ Text
k RegionCode
r Maybe Integer
_recentChecklistsParamsMaxResults

-- | Optional parameters accepted by the 'RecentChecklistsAPI'.
--
-- Note that 'defaultRecentChecklistsParams' (or the 'Default' instance's
-- 'def' value) may be used to accept the defaults of the eBird API.
--
-- Additionally, note that there are optics available for manipulating this
-- type. For example, if you would like to just set the
-- '_recentChecklistsParamsMaxResults' field to 3:
--
-- > def & recentChecklistsParamsMaxResults ?~ 3
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #maxResults ?~ 3
newtype RecentChecklistsParams =
    RecentChecklistsParams
      { -- | Maximum number of checklists to get
        --
        -- /1 - 200, default: 10/
        RecentChecklistsParams -> Maybe Integer
_recentChecklistsParamsMaxResults :: Maybe Integer
      }
  deriving (Int -> RecentChecklistsParams -> ShowS
[RecentChecklistsParams] -> ShowS
RecentChecklistsParams -> String
(Int -> RecentChecklistsParams -> ShowS)
-> (RecentChecklistsParams -> String)
-> ([RecentChecklistsParams] -> ShowS)
-> Show RecentChecklistsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RecentChecklistsParams -> ShowS
showsPrec :: Int -> RecentChecklistsParams -> ShowS
$cshow :: RecentChecklistsParams -> String
show :: RecentChecklistsParams -> String
$cshowList :: [RecentChecklistsParams] -> ShowS
showList :: [RecentChecklistsParams] -> ShowS
Show, ReadPrec [RecentChecklistsParams]
ReadPrec RecentChecklistsParams
Int -> ReadS RecentChecklistsParams
ReadS [RecentChecklistsParams]
(Int -> ReadS RecentChecklistsParams)
-> ReadS [RecentChecklistsParams]
-> ReadPrec RecentChecklistsParams
-> ReadPrec [RecentChecklistsParams]
-> Read RecentChecklistsParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RecentChecklistsParams
readsPrec :: Int -> ReadS RecentChecklistsParams
$creadList :: ReadS [RecentChecklistsParams]
readList :: ReadS [RecentChecklistsParams]
$creadPrec :: ReadPrec RecentChecklistsParams
readPrec :: ReadPrec RecentChecklistsParams
$creadListPrec :: ReadPrec [RecentChecklistsParams]
readListPrec :: ReadPrec [RecentChecklistsParams]
Read, RecentChecklistsParams -> RecentChecklistsParams -> Bool
(RecentChecklistsParams -> RecentChecklistsParams -> Bool)
-> (RecentChecklistsParams -> RecentChecklistsParams -> Bool)
-> Eq RecentChecklistsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RecentChecklistsParams -> RecentChecklistsParams -> Bool
== :: RecentChecklistsParams -> RecentChecklistsParams -> Bool
$c/= :: RecentChecklistsParams -> RecentChecklistsParams -> Bool
/= :: RecentChecklistsParams -> RecentChecklistsParams -> Bool
Eq)

-- | Note that this value does not actually use the eBird API default values.
-- It simply sets every option to 'Nothing', which means we just don't send any
-- of these parameters to the eBird API and they will use /their own/ defaults.
defaultRecentChecklistsParams :: RecentChecklistsParams
defaultRecentChecklistsParams :: RecentChecklistsParams
defaultRecentChecklistsParams =
    RecentChecklistsParams
      { _recentChecklistsParamsMaxResults :: Maybe Integer
_recentChecklistsParamsMaxResults = Maybe Integer
forall a. Maybe a
Nothing
      }

instance Default RecentChecklistsParams where
  def :: RecentChecklistsParams
def = RecentChecklistsParams
defaultRecentChecklistsParams

-- ** Optics for 'RecentChecklistsParams'
makeLenses ''RecentChecklistsParams
makeFieldLabels ''RecentChecklistsParams

-------------------------------------------------------------------------------
-- * Top 100
-------------------------------------------------------------------------------

-- | Get a list of top contributors for a region on a specific date, ranked by
-- number of species observed or number of checklists submitted.
--
-- For example, get the top 10 contributors by number of species observed on
-- July 11th, 2023 in Wyoming (using @-XOverloadedLabels@ and
-- @-XOverloadedStrings@):
--
-- @
-- askEBird $
--   top100 key
--     "US-WY"
--     "2023-07-11"
--     (def & #maxResults ?~ 10)
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#2d8d3f94-c4b0-42bd-9c8e-71edfa6347ba).
top100
  :: Text
  -- ^ eBird API key
  -> Region
  -- ^ Region to fetch the ranking for
  --
  -- __Note:__ Only country, subnational1, or location regions are supported for
  -- this endpoint of the eBird API.
  -> EBirdDate
  -- ^ Date to get the top 100 on
  -> Top100Params
  -- ^ Optional parameters
  --
  -- /default: 'defaultTop100Params'/
  -> ClientM [Top100ListEntry]
top100 :: Text
-> Region -> EBirdDate -> Top100Params -> ClientM [Top100ListEntry]
top100 Text
k Region
r EBirdDate
date Top100Params{Maybe Integer
Maybe RankTop100By
_top100ParamsRankBy :: Maybe RankTop100By
_top100ParamsMaxResults :: Maybe Integer
_top100ParamsRankBy :: Top100Params -> Maybe RankTop100By
_top100ParamsMaxResults :: Top100Params -> Maybe Integer
..} =
    Text
-> Region
-> Integer
-> Integer
-> Integer
-> Maybe RankTop100By
-> Maybe Integer
-> ClientM [Top100ListEntry]
top100_ Text
k Region
r Integer
y Integer
m Integer
d Maybe RankTop100By
_top100ParamsRankBy Maybe Integer
_top100ParamsMaxResults
  where
    (Integer
y,Integer
m,Integer
d) = EBirdDate -> (Integer, Integer, Integer)
eBirdDateToGregorian EBirdDate
date

-- | Optional parameters accepted by the 'Top100API'.
--
-- Note that 'defaultTop100Params' (or the 'Default' instance's 'def' value) may
-- be used to accept the defaults of the eBird API.
--
-- Additionally, note that there are optics available for manipulating this
-- type. For example, if you would like to just set the
-- '_top100ParamsMaxResults' field to 50:
--
-- > def & top100ParamsMaxResults ?~ 50
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #maxResults ?~ 50
data Top100Params =
    Top100Params
      { -- | Rank the resulting list by number of species observed or by number of
        -- checklists completed
        --
        -- /default: 'RankTop100BySpecies'/
        Top100Params -> Maybe RankTop100By
_top100ParamsRankBy :: Maybe RankTop100By

        -- | Maximum number of entries to fetch
        --
        -- /1 - 100, default: 100/
      , Top100Params -> Maybe Integer
_top100ParamsMaxResults :: Maybe Integer
      }
  deriving (Int -> Top100Params -> ShowS
[Top100Params] -> ShowS
Top100Params -> String
(Int -> Top100Params -> ShowS)
-> (Top100Params -> String)
-> ([Top100Params] -> ShowS)
-> Show Top100Params
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Top100Params -> ShowS
showsPrec :: Int -> Top100Params -> ShowS
$cshow :: Top100Params -> String
show :: Top100Params -> String
$cshowList :: [Top100Params] -> ShowS
showList :: [Top100Params] -> ShowS
Show, ReadPrec [Top100Params]
ReadPrec Top100Params
Int -> ReadS Top100Params
ReadS [Top100Params]
(Int -> ReadS Top100Params)
-> ReadS [Top100Params]
-> ReadPrec Top100Params
-> ReadPrec [Top100Params]
-> Read Top100Params
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Top100Params
readsPrec :: Int -> ReadS Top100Params
$creadList :: ReadS [Top100Params]
readList :: ReadS [Top100Params]
$creadPrec :: ReadPrec Top100Params
readPrec :: ReadPrec Top100Params
$creadListPrec :: ReadPrec [Top100Params]
readListPrec :: ReadPrec [Top100Params]
Read, Top100Params -> Top100Params -> Bool
(Top100Params -> Top100Params -> Bool)
-> (Top100Params -> Top100Params -> Bool) -> Eq Top100Params
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Top100Params -> Top100Params -> Bool
== :: Top100Params -> Top100Params -> Bool
$c/= :: Top100Params -> Top100Params -> Bool
/= :: Top100Params -> Top100Params -> Bool
Eq)

-- | Note that this value does not actually use the eBird API default values.
-- It simply sets every option to 'Nothing', which means we just don't send any
-- of these parameters to the eBird API and they will use /their own/ defaults.
defaultTop100Params :: Top100Params
defaultTop100Params :: Top100Params
defaultTop100Params =
    Top100Params
      { _top100ParamsRankBy :: Maybe RankTop100By
_top100ParamsRankBy = Maybe RankTop100By
forall a. Maybe a
Nothing
      , _top100ParamsMaxResults :: Maybe Integer
_top100ParamsMaxResults = Maybe Integer
forall a. Maybe a
Nothing
      }

instance Default Top100Params where
  def :: Top100Params
def = Top100Params
defaultTop100Params

-- ** Optics for 'Top100Params'
makeLenses ''Top100Params
makeFieldLabels ''Top100Params

-------------------------------------------------------------------------------
-- * Checklist feed
-------------------------------------------------------------------------------

-- | Get a list of checklists submitted within a region on a specific date.
--
-- For example, get a feed of 10 checklists submitted in Park County, Wyoming on
-- July 11th, 2023 (using @-XOverloadedLabels@ and @-XOverloadedStrings@):
--
-- @
-- askEBird $
--   checklistFeed key
--     "US-WY-029"
--     "2023-07-11"
--     (def & #maxResults ?~ 10)
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#4416a7cc-623b-4340-ab01-80c599ede73e).
checklistFeed
  :: Text
  -- ^ eBird API key
  -> Region
  -- ^ Region to fetch the checklist feed for
  -> EBirdDate
  -- ^ Date to get the checklist feed on
  -> ChecklistFeedParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultChecklistFeedParams'/
  -> ClientM [ChecklistFeedEntry]
checklistFeed :: Text
-> Region
-> EBirdDate
-> ChecklistFeedParams
-> ClientM [ChecklistFeedEntry]
checklistFeed Text
k Region
r EBirdDate
date ChecklistFeedParams{Maybe Integer
Maybe SortChecklistsBy
_checklistFeedParamsSortBy :: Maybe SortChecklistsBy
_checklistFeedParamsMaxResults :: Maybe Integer
_checklistFeedParamsSortBy :: ChecklistFeedParams -> Maybe SortChecklistsBy
_checklistFeedParamsMaxResults :: ChecklistFeedParams -> Maybe Integer
..} =
    Text
-> Region
-> Integer
-> Integer
-> Integer
-> Maybe SortChecklistsBy
-> Maybe Integer
-> ClientM [ChecklistFeedEntry]
checklistFeed_ Text
k Region
r Integer
y Integer
m Integer
d
      Maybe SortChecklistsBy
_checklistFeedParamsSortBy
      Maybe Integer
_checklistFeedParamsMaxResults
  where
    (Integer
y,Integer
m,Integer
d) = EBirdDate -> (Integer, Integer, Integer)
eBirdDateToGregorian EBirdDate
date

-- | Optional parameters accepted by the 'ChecklistFeedAPI'.
--
-- Note that 'defaultChecklistFeedParams' (or the 'Default' instance's 'def' value) may
-- be used to accept the defaults of the eBird API.
--
-- Additionally, note that there are optics available for manipulating this
-- type. For example, if you would like to just set the
-- '_checklistFeedParamsMaxResults' field to 50:
--
-- > def & checklistFeedParamsMaxResults ?~ 50
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #maxResults ?~ 50
data ChecklistFeedParams =
    ChecklistFeedParams
      { -- | Sort the resulting list by date of checklist submission or date of
        -- checklist creation
        --
        -- /default: 'SortChecklistsByDateCreated'/
        ChecklistFeedParams -> Maybe SortChecklistsBy
_checklistFeedParamsSortBy :: Maybe SortChecklistsBy

        -- | Maximum number of checklists to get
        --
        -- /1 - 200, default: 10/
      , ChecklistFeedParams -> Maybe Integer
_checklistFeedParamsMaxResults :: Maybe Integer
      }
  deriving (Int -> ChecklistFeedParams -> ShowS
[ChecklistFeedParams] -> ShowS
ChecklistFeedParams -> String
(Int -> ChecklistFeedParams -> ShowS)
-> (ChecklistFeedParams -> String)
-> ([ChecklistFeedParams] -> ShowS)
-> Show ChecklistFeedParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChecklistFeedParams -> ShowS
showsPrec :: Int -> ChecklistFeedParams -> ShowS
$cshow :: ChecklistFeedParams -> String
show :: ChecklistFeedParams -> String
$cshowList :: [ChecklistFeedParams] -> ShowS
showList :: [ChecklistFeedParams] -> ShowS
Show, ReadPrec [ChecklistFeedParams]
ReadPrec ChecklistFeedParams
Int -> ReadS ChecklistFeedParams
ReadS [ChecklistFeedParams]
(Int -> ReadS ChecklistFeedParams)
-> ReadS [ChecklistFeedParams]
-> ReadPrec ChecklistFeedParams
-> ReadPrec [ChecklistFeedParams]
-> Read ChecklistFeedParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChecklistFeedParams
readsPrec :: Int -> ReadS ChecklistFeedParams
$creadList :: ReadS [ChecklistFeedParams]
readList :: ReadS [ChecklistFeedParams]
$creadPrec :: ReadPrec ChecklistFeedParams
readPrec :: ReadPrec ChecklistFeedParams
$creadListPrec :: ReadPrec [ChecklistFeedParams]
readListPrec :: ReadPrec [ChecklistFeedParams]
Read, ChecklistFeedParams -> ChecklistFeedParams -> Bool
(ChecklistFeedParams -> ChecklistFeedParams -> Bool)
-> (ChecklistFeedParams -> ChecklistFeedParams -> Bool)
-> Eq ChecklistFeedParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChecklistFeedParams -> ChecklistFeedParams -> Bool
== :: ChecklistFeedParams -> ChecklistFeedParams -> Bool
$c/= :: ChecklistFeedParams -> ChecklistFeedParams -> Bool
/= :: ChecklistFeedParams -> ChecklistFeedParams -> Bool
Eq)

-- | Note that this value does not actually use the eBird API default values.
-- It simply sets every option to 'Nothing', which means we just don't send any
-- of these parameters to the eBird API and they will use /their own/ defaults.
defaultChecklistFeedParams :: ChecklistFeedParams
defaultChecklistFeedParams :: ChecklistFeedParams
defaultChecklistFeedParams =
    ChecklistFeedParams
      { _checklistFeedParamsSortBy :: Maybe SortChecklistsBy
_checklistFeedParamsSortBy = Maybe SortChecklistsBy
forall a. Maybe a
Nothing
      , _checklistFeedParamsMaxResults :: Maybe Integer
_checklistFeedParamsMaxResults = Maybe Integer
forall a. Maybe a
Nothing
      }

instance Default ChecklistFeedParams where
  def :: ChecklistFeedParams
def = ChecklistFeedParams
defaultChecklistFeedParams

-- ** Optics for 'ChecklistFeedParams'
makeLenses ''ChecklistFeedParams
makeFieldLabels ''ChecklistFeedParams

-------------------------------------------------------------------------------
-- * Regional statistics
-------------------------------------------------------------------------------

-- | Get the 'RegionalStatistics' for a region on a specific date.
--
-- For example, get the statistics for Wyoming on July 11th, 2023 (using
-- @-XOverloadedStrings@):
--
-- @
-- askEBird $
--   regionalStatistics key
--     "US-WY"
--     "2023-07-11"
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#506e63ab-abc0-4256-b74c-cd9e77968329).
regionalStatistics
  :: Text
  -- ^ eBird API key
  -> Region
  -- ^ Region to fetch the statistics for
  -> EBirdDate
  -- ^ Date to get the statistics on
  -> ClientM RegionalStatistics
regionalStatistics :: Text -> Region -> EBirdDate -> ClientM RegionalStatistics
regionalStatistics Text
k Region
r EBirdDate
date =
    Text
-> Region
-> Integer
-> Integer
-> Integer
-> ClientM RegionalStatistics
regionalStatistics_ Text
k Region
r Integer
y Integer
m Integer
d
  where
    (Integer
y,Integer
m,Integer
d) = EBirdDate -> (Integer, Integer, Integer)
eBirdDateToGregorian EBirdDate
date

-------------------------------------------------------------------------------
-- * Species list
-------------------------------------------------------------------------------

-- | Get a list of all species ever seen in a 'Region'.
--
-- For example, get all species ever seen in Park County, Wyoming (using
-- @-XOverloadedStrings@):
--
-- @
-- askEBird $ speciesList key "US-WY-029"
-- @
--
-- Note that the endpoint for this query is simple enough that 'speciesList' is
-- equivalent to the generated 'speciesList_'.
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#55bd1b26-6951-4a88-943a-d3a8aa1157dd).
speciesList
  :: Text
  -- ^ eBird API key
  -> Region
  -- ^ Region to fetch the species list for
  -> ClientM [SpeciesCode]
speciesList :: Text -> Region -> ClientM [SpeciesCode]
speciesList = Text -> Region -> ClientM [SpeciesCode]
speciesList_

-------------------------------------------------------------------------------
-- * View checklist
-------------------------------------------------------------------------------

-- | Get information about a checklist.
--
-- For example, get information for a checklist with submission ID
-- \"S144646447\" (using @-XOverloadedStrings@):
--
-- @
-- askEBird $ viewChecklist key "S144646447"
-- @
--
-- Note that the endpoint for this query is simple enough that 'viewChecklist'
-- is equivalent to the generated 'viewChecklist_'.
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#2ee89672-4211-4fc1-8493-5df884fbb386).
viewChecklist
  :: Text
  -- ^ eBird API key
  -> Text
  -- ^ Checklist submission ID, e.g. \"S144646447\"
  -> ClientM Checklist
viewChecklist :: Text -> Text -> ClientM Checklist
viewChecklist = Text -> Text -> ClientM Checklist
viewChecklist_