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

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

module Data.EBird.Client.Taxonomy where

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

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

-------------------------------------------------------------------------------
-- Taxonomy
-------------------------------------------------------------------------------

-- | Get any version of the eBird taxonomy, with optional filtering based on
-- taxonomy categories and species.
--
-- For example, get the taxa for species in the "hybrid" category:
--
-- @
-- askEBird $ taxonomy (def & #categories ?~ "hybrid")
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#952a4310-536d-4ad1-8f3e-77cfb624d1bc).
taxonomy
  :: TaxonomyParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultTaxonomyParams'/
  -> ClientM [Taxon]
taxonomy :: TaxonomyParams -> ClientM [Taxon]
taxonomy TaxonomyParams{Maybe Text
Maybe SPPLocale
Maybe SpeciesCodes
Maybe TaxonomyCategories
_taxonomyParamsCategories :: Maybe TaxonomyCategories
_taxonomyParamsLocale :: Maybe SPPLocale
_taxonomyParamsSpecies :: Maybe SpeciesCodes
_taxonomyParamsVersion :: Maybe Text
_taxonomyParamsCategories :: TaxonomyParams -> Maybe TaxonomyCategories
_taxonomyParamsLocale :: TaxonomyParams -> Maybe SPPLocale
_taxonomyParamsSpecies :: TaxonomyParams -> Maybe SpeciesCodes
_taxonomyParamsVersion :: TaxonomyParams -> Maybe Text
..} =
    Maybe TaxonomyCategories
-> Maybe CSVOrJSONFormat
-> Maybe SPPLocale
-> Maybe SpeciesCodes
-> Maybe Text
-> ClientM [Taxon]
taxonomy_
      Maybe TaxonomyCategories
_taxonomyParamsCategories
      -- Hard coded to JSONFormat because it makes no difference and CSVFormat
      -- does not work like it should. See the note on the generated function's
      -- parameter documentation.
      (CSVOrJSONFormat -> Maybe CSVOrJSONFormat
forall a. a -> Maybe a
Just CSVOrJSONFormat
JSONFormat)
      Maybe SPPLocale
_taxonomyParamsLocale
      Maybe SpeciesCodes
_taxonomyParamsSpecies
      Maybe Text
_taxonomyParamsVersion

-- | Optional parameters accepted by the 'TaxonomyAPI'.
--
-- Note that 'defaultTaxonomyParams' (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
-- '_taxonomyParamsSpecies' field to "bohwax":
--
-- > def & taxonomyParamsSpecies ?~ "bohwax"
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #species ?~ "bohwax"
data TaxonomyParams =
    TaxonomyParams
      { -- | Only include species of these 'TaxonomyCategory's in the taxonomy
        --
        -- /default: all categories/
        TaxonomyParams -> Maybe TaxonomyCategories
_taxonomyParamsCategories :: Maybe TaxonomyCategories

        -- | Use this locale for common names
        --
        -- /default: 'En'/
      , TaxonomyParams -> Maybe SPPLocale
_taxonomyParamsLocale :: Maybe SPPLocale

        -- | Only fetch records for these species
        --
        -- /default: all/
      , TaxonomyParams -> Maybe SpeciesCodes
_taxonomyParamsSpecies :: Maybe SpeciesCodes

        -- | Fetch this version of the eBird taxonomy
        --
        -- /default: latest/
      , TaxonomyParams -> Maybe Text
_taxonomyParamsVersion :: Maybe Text
      }
  deriving (Int -> TaxonomyParams -> ShowS
[TaxonomyParams] -> ShowS
TaxonomyParams -> String
(Int -> TaxonomyParams -> ShowS)
-> (TaxonomyParams -> String)
-> ([TaxonomyParams] -> ShowS)
-> Show TaxonomyParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxonomyParams -> ShowS
showsPrec :: Int -> TaxonomyParams -> ShowS
$cshow :: TaxonomyParams -> String
show :: TaxonomyParams -> String
$cshowList :: [TaxonomyParams] -> ShowS
showList :: [TaxonomyParams] -> ShowS
Show, ReadPrec [TaxonomyParams]
ReadPrec TaxonomyParams
Int -> ReadS TaxonomyParams
ReadS [TaxonomyParams]
(Int -> ReadS TaxonomyParams)
-> ReadS [TaxonomyParams]
-> ReadPrec TaxonomyParams
-> ReadPrec [TaxonomyParams]
-> Read TaxonomyParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxonomyParams
readsPrec :: Int -> ReadS TaxonomyParams
$creadList :: ReadS [TaxonomyParams]
readList :: ReadS [TaxonomyParams]
$creadPrec :: ReadPrec TaxonomyParams
readPrec :: ReadPrec TaxonomyParams
$creadListPrec :: ReadPrec [TaxonomyParams]
readListPrec :: ReadPrec [TaxonomyParams]
Read, TaxonomyParams -> TaxonomyParams -> Bool
(TaxonomyParams -> TaxonomyParams -> Bool)
-> (TaxonomyParams -> TaxonomyParams -> Bool) -> Eq TaxonomyParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxonomyParams -> TaxonomyParams -> Bool
== :: TaxonomyParams -> TaxonomyParams -> Bool
$c/= :: TaxonomyParams -> TaxonomyParams -> Bool
/= :: TaxonomyParams -> TaxonomyParams -> 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.
defaultTaxonomyParams :: TaxonomyParams
defaultTaxonomyParams :: TaxonomyParams
defaultTaxonomyParams =
    TaxonomyParams
      { _taxonomyParamsCategories :: Maybe TaxonomyCategories
_taxonomyParamsCategories = Maybe TaxonomyCategories
forall a. Maybe a
Nothing
      , _taxonomyParamsLocale :: Maybe SPPLocale
_taxonomyParamsLocale = Maybe SPPLocale
forall a. Maybe a
Nothing
      , _taxonomyParamsSpecies :: Maybe SpeciesCodes
_taxonomyParamsSpecies = Maybe SpeciesCodes
forall a. Maybe a
Nothing
      , _taxonomyParamsVersion :: Maybe Text
_taxonomyParamsVersion = Maybe Text
forall a. Maybe a
Nothing
      }

instance Default TaxonomyParams where
  def :: TaxonomyParams
def = TaxonomyParams
defaultTaxonomyParams

-- ** Optics for 'TaxonomyParams'
makeLenses ''TaxonomyParams
makeFieldLabels ''TaxonomyParams

-------------------------------------------------------------------------------
-- Taxonomic forms
-------------------------------------------------------------------------------

-- | Get the list of subspecies of a given species recognized in the eBird
-- taxonomy.
--
-- For example, get subspecies of Canada Goose (using
-- @-XOverloadedStrings@):
--
-- @
-- askEBird $ taxonomicForms key "cangoo"
-- @
--
-- Note that the endpoint for this query is simple enough that 'taxonomicForms'
-- is equivalent to the generated 'taxonomicForms_'.
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#e338e5a6-919d-4603-a7db-6c690fa62371).
taxonomicForms
  :: Text
  -- ^ eBird API key
  -> SpeciesCode
  -- ^ The species to get subspecies of
  -> ClientM SpeciesCodes
taxonomicForms :: Text -> SpeciesCode -> ClientM SpeciesCodes
taxonomicForms = Text -> SpeciesCode -> ClientM SpeciesCodes
taxonomicForms_

-------------------------------------------------------------------------------
-- Taxa locale codes
-------------------------------------------------------------------------------

-- | Get the supported locale codes and names for species common names, with the
-- last time they were updated.
--
-- For example:
--
-- @
-- askEBird $ taxaLocaleCodes key def
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#3ea8ff71-c254-4811-9e80-b445a39302a6).
taxaLocaleCodes
  :: Text
  -- ^ eBird API key
  -> TaxaLocaleCodesParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultTaxaLocaleCodesParams'/
  -> ClientM [SPPLocaleListEntry]
taxaLocaleCodes :: Text -> TaxaLocaleCodesParams -> ClientM [SPPLocaleListEntry]
taxaLocaleCodes Text
k TaxaLocaleCodesParams{Maybe SPPLocale
_taxaLocaleCodesParamsLocale :: Maybe SPPLocale
_taxaLocaleCodesParamsLocale :: TaxaLocaleCodesParams -> Maybe SPPLocale
..} =
    Text -> Maybe SPPLocale -> ClientM [SPPLocaleListEntry]
taxaLocaleCodes_ Text
k Maybe SPPLocale
_taxaLocaleCodesParamsLocale

-- | Optional parameters accepted by the 'TaxaLocaleCodesAPI'.
--
-- Note that 'defaultTaxaLocaleCodesParams' (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
-- '_taxaLocaleCodesParamsLocale' field to 'Es':
--
-- > def & taxaLocaleCodesParamsLocale ?~ Es
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #locale ?~ Es
newtype TaxaLocaleCodesParams =
    TaxaLocaleCodesParams
      { -- | Value for the "Accept-Language" header, for translated language
        -- names, when available
        --
        -- /default: 'En'/
        TaxaLocaleCodesParams -> Maybe SPPLocale
_taxaLocaleCodesParamsLocale :: Maybe SPPLocale
      }
  deriving (Int -> TaxaLocaleCodesParams -> ShowS
[TaxaLocaleCodesParams] -> ShowS
TaxaLocaleCodesParams -> String
(Int -> TaxaLocaleCodesParams -> ShowS)
-> (TaxaLocaleCodesParams -> String)
-> ([TaxaLocaleCodesParams] -> ShowS)
-> Show TaxaLocaleCodesParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxaLocaleCodesParams -> ShowS
showsPrec :: Int -> TaxaLocaleCodesParams -> ShowS
$cshow :: TaxaLocaleCodesParams -> String
show :: TaxaLocaleCodesParams -> String
$cshowList :: [TaxaLocaleCodesParams] -> ShowS
showList :: [TaxaLocaleCodesParams] -> ShowS
Show, ReadPrec [TaxaLocaleCodesParams]
ReadPrec TaxaLocaleCodesParams
Int -> ReadS TaxaLocaleCodesParams
ReadS [TaxaLocaleCodesParams]
(Int -> ReadS TaxaLocaleCodesParams)
-> ReadS [TaxaLocaleCodesParams]
-> ReadPrec TaxaLocaleCodesParams
-> ReadPrec [TaxaLocaleCodesParams]
-> Read TaxaLocaleCodesParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxaLocaleCodesParams
readsPrec :: Int -> ReadS TaxaLocaleCodesParams
$creadList :: ReadS [TaxaLocaleCodesParams]
readList :: ReadS [TaxaLocaleCodesParams]
$creadPrec :: ReadPrec TaxaLocaleCodesParams
readPrec :: ReadPrec TaxaLocaleCodesParams
$creadListPrec :: ReadPrec [TaxaLocaleCodesParams]
readListPrec :: ReadPrec [TaxaLocaleCodesParams]
Read, TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> Bool
(TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> Bool)
-> (TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> Bool)
-> Eq TaxaLocaleCodesParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> Bool
== :: TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> Bool
$c/= :: TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> Bool
/= :: TaxaLocaleCodesParams -> TaxaLocaleCodesParams -> 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.
defaultTaxaLocaleCodesParams :: TaxaLocaleCodesParams
defaultTaxaLocaleCodesParams :: TaxaLocaleCodesParams
defaultTaxaLocaleCodesParams =
    TaxaLocaleCodesParams
      { _taxaLocaleCodesParamsLocale :: Maybe SPPLocale
_taxaLocaleCodesParamsLocale = Maybe SPPLocale
forall a. Maybe a
Nothing
      }

instance Default TaxaLocaleCodesParams where
  def :: TaxaLocaleCodesParams
def = TaxaLocaleCodesParams
defaultTaxaLocaleCodesParams

-- ** Optics for 'TaxaLocaleCodesParams'
makeLenses ''TaxaLocaleCodesParams
makeFieldLabels ''TaxaLocaleCodesParams

-------------------------------------------------------------------------------
-- * Taxonomy versions
-------------------------------------------------------------------------------

-- | Get all versions of the taxonomy, with a flag indicating which is latest.
--
-- For example:
--
-- @
-- askEBird taxonomyVersions
-- @
--
-- Note that the endpoint for this query is simple enough that 'taxonomyVersions'
-- is equivalent to the generated 'taxonomyVersions_'.
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#9bba1ff5-6eb2-4f9a-91fd-e5ed34e51500).
taxonomyVersions :: ClientM [TaxonomyVersionListEntry]
taxonomyVersions :: ClientM [TaxonomyVersionListEntry]
taxonomyVersions = ClientM [TaxonomyVersionListEntry]
taxonomyVersions_

-------------------------------------------------------------------------------
-- * Taxonomic groups
-------------------------------------------------------------------------------

-- | Get the list of species groups, in either Merlin or eBird grouping.
--
-- For example, get the taxonomic groups using eBird grouping order (using
-- @-XOverloadedStrings@):
--
-- @
-- askEBird $ taxonomicGroups "ebird" def
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#aa9804aa-dbf9-4a53-bbf4-48e214e4677a).
taxonomicGroups
  :: SPPGrouping
  -- ^ 'MerlinGrouping' groups like birds together, with falcons next to hawks,
  -- while 'EBirdGrouping' groups in taxonomy order
  -> TaxonomicGroupsParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultTaxonomicGroupsParams'/
  -> ClientM [TaxonomicGroupListEntry]
taxonomicGroups :: SPPGrouping
-> TaxonomicGroupsParams -> ClientM [TaxonomicGroupListEntry]
taxonomicGroups SPPGrouping
r TaxonomicGroupsParams{Maybe SPPLocale
_taxonomicGroupsParamsLocale :: Maybe SPPLocale
_taxonomicGroupsParamsLocale :: TaxonomicGroupsParams -> Maybe SPPLocale
..} =
    SPPGrouping -> Maybe SPPLocale -> ClientM [TaxonomicGroupListEntry]
taxonomicGroups_ SPPGrouping
r Maybe SPPLocale
_taxonomicGroupsParamsLocale

-- | Optional parameters accepted by the 'TaxonomicGroupsAPI'.
--
-- Note that 'defaultTaxonomicGroupsParams' (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
-- '_taxonomicGroupsParamsLocale' field to 'Es':
--
-- > def & taxonomicGroupsParamsLocale ?~ Es
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #locale ?~ Es
newtype TaxonomicGroupsParams =
    TaxonomicGroupsParams
      { -- | Locale to use for species group names. 'En' is used for any locale
        -- whose translations are unavailable at this endpoint
        --
        -- /default: 'En'/
        TaxonomicGroupsParams -> Maybe SPPLocale
_taxonomicGroupsParamsLocale :: Maybe SPPLocale
      }
  deriving (Int -> TaxonomicGroupsParams -> ShowS
[TaxonomicGroupsParams] -> ShowS
TaxonomicGroupsParams -> String
(Int -> TaxonomicGroupsParams -> ShowS)
-> (TaxonomicGroupsParams -> String)
-> ([TaxonomicGroupsParams] -> ShowS)
-> Show TaxonomicGroupsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxonomicGroupsParams -> ShowS
showsPrec :: Int -> TaxonomicGroupsParams -> ShowS
$cshow :: TaxonomicGroupsParams -> String
show :: TaxonomicGroupsParams -> String
$cshowList :: [TaxonomicGroupsParams] -> ShowS
showList :: [TaxonomicGroupsParams] -> ShowS
Show, ReadPrec [TaxonomicGroupsParams]
ReadPrec TaxonomicGroupsParams
Int -> ReadS TaxonomicGroupsParams
ReadS [TaxonomicGroupsParams]
(Int -> ReadS TaxonomicGroupsParams)
-> ReadS [TaxonomicGroupsParams]
-> ReadPrec TaxonomicGroupsParams
-> ReadPrec [TaxonomicGroupsParams]
-> Read TaxonomicGroupsParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxonomicGroupsParams
readsPrec :: Int -> ReadS TaxonomicGroupsParams
$creadList :: ReadS [TaxonomicGroupsParams]
readList :: ReadS [TaxonomicGroupsParams]
$creadPrec :: ReadPrec TaxonomicGroupsParams
readPrec :: ReadPrec TaxonomicGroupsParams
$creadListPrec :: ReadPrec [TaxonomicGroupsParams]
readListPrec :: ReadPrec [TaxonomicGroupsParams]
Read, TaxonomicGroupsParams -> TaxonomicGroupsParams -> Bool
(TaxonomicGroupsParams -> TaxonomicGroupsParams -> Bool)
-> (TaxonomicGroupsParams -> TaxonomicGroupsParams -> Bool)
-> Eq TaxonomicGroupsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxonomicGroupsParams -> TaxonomicGroupsParams -> Bool
== :: TaxonomicGroupsParams -> TaxonomicGroupsParams -> Bool
$c/= :: TaxonomicGroupsParams -> TaxonomicGroupsParams -> Bool
/= :: TaxonomicGroupsParams -> TaxonomicGroupsParams -> 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.
defaultTaxonomicGroupsParams :: TaxonomicGroupsParams
defaultTaxonomicGroupsParams :: TaxonomicGroupsParams
defaultTaxonomicGroupsParams =
    TaxonomicGroupsParams
      { _taxonomicGroupsParamsLocale :: Maybe SPPLocale
_taxonomicGroupsParamsLocale = Maybe SPPLocale
forall a. Maybe a
Nothing
      }

instance Default TaxonomicGroupsParams where
  def :: TaxonomicGroupsParams
def = TaxonomicGroupsParams
defaultTaxonomicGroupsParams

-- ** Optics for 'TaxonomicGroupsParams'
makeLenses ''TaxonomicGroupsParams
makeFieldLabels ''TaxonomicGroupsParams