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

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

module Data.EBird.Client.Hotspots where

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

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

-------------------------------------------------------------------------------
-- * Region hotspots
-------------------------------------------------------------------------------

-- | Get all hotspots in a list of one or more regions ('RegionCode').
--
-- For example, get the hotspots in Albany County, Wyoming and Park County,
-- Wyoming that have been visited in the last 5 days (using @-XOverloadedLabels@
-- and @-XOverloadedStrings@):
--
-- @
-- askEBird $ regionHotspots "US-WY-001,US-WY-029" (def & #back ?~ 5)
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#f4f59f90-854e-4ba6-8207-323a8cf0bfe0).
regionHotspots
  :: RegionCode
  -- ^ Region(s) to get hotspots in
  -> RegionHotspotsParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultRegionHotspotsParams'/
  -> ClientM [Hotspot]
regionHotspots :: RegionCode -> RegionHotspotsParams -> ClientM [Hotspot]
regionHotspots RegionCode
r RegionHotspotsParams{Maybe Integer
_regionHotspotsParamsBack :: Maybe Integer
_regionHotspotsParamsBack :: RegionHotspotsParams -> Maybe Integer
..} =
    RegionCode
-> Maybe Integer -> Maybe CSVOrJSONFormat -> ClientM [Hotspot]
regionHotspots_ RegionCode
r Maybe Integer
_regionHotspotsParamsBack
      -- 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)

-- | Optional parameters accepted by the 'RegionHotspotsAPI'.
--
-- Note that 'defaultRegionHotspotsParams' (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
-- '_regionHotspotsParamsBack' field to 10:
--
-- > def & regionHotspotsParamsBack ?~ 10
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #back ?~ 10
newtype RegionHotspotsParams =
    RegionHotspotsParams
      { -- | Only fetch hotspots that have been visited within this many days
        -- ago
        --
        -- /1 - 30, default: no limit/
        RegionHotspotsParams -> Maybe Integer
_regionHotspotsParamsBack :: Maybe Integer
      }
  deriving (Int -> RegionHotspotsParams -> ShowS
[RegionHotspotsParams] -> ShowS
RegionHotspotsParams -> String
(Int -> RegionHotspotsParams -> ShowS)
-> (RegionHotspotsParams -> String)
-> ([RegionHotspotsParams] -> ShowS)
-> Show RegionHotspotsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionHotspotsParams -> ShowS
showsPrec :: Int -> RegionHotspotsParams -> ShowS
$cshow :: RegionHotspotsParams -> String
show :: RegionHotspotsParams -> String
$cshowList :: [RegionHotspotsParams] -> ShowS
showList :: [RegionHotspotsParams] -> ShowS
Show, ReadPrec [RegionHotspotsParams]
ReadPrec RegionHotspotsParams
Int -> ReadS RegionHotspotsParams
ReadS [RegionHotspotsParams]
(Int -> ReadS RegionHotspotsParams)
-> ReadS [RegionHotspotsParams]
-> ReadPrec RegionHotspotsParams
-> ReadPrec [RegionHotspotsParams]
-> Read RegionHotspotsParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionHotspotsParams
readsPrec :: Int -> ReadS RegionHotspotsParams
$creadList :: ReadS [RegionHotspotsParams]
readList :: ReadS [RegionHotspotsParams]
$creadPrec :: ReadPrec RegionHotspotsParams
readPrec :: ReadPrec RegionHotspotsParams
$creadListPrec :: ReadPrec [RegionHotspotsParams]
readListPrec :: ReadPrec [RegionHotspotsParams]
Read, RegionHotspotsParams -> RegionHotspotsParams -> Bool
(RegionHotspotsParams -> RegionHotspotsParams -> Bool)
-> (RegionHotspotsParams -> RegionHotspotsParams -> Bool)
-> Eq RegionHotspotsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionHotspotsParams -> RegionHotspotsParams -> Bool
== :: RegionHotspotsParams -> RegionHotspotsParams -> Bool
$c/= :: RegionHotspotsParams -> RegionHotspotsParams -> Bool
/= :: RegionHotspotsParams -> RegionHotspotsParams -> 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.
defaultRegionHotspotsParams :: RegionHotspotsParams
defaultRegionHotspotsParams :: RegionHotspotsParams
defaultRegionHotspotsParams =
    RegionHotspotsParams
      { _regionHotspotsParamsBack :: Maybe Integer
_regionHotspotsParamsBack = Maybe Integer
forall a. Maybe a
Nothing
      }

instance Default RegionHotspotsParams where
  def :: RegionHotspotsParams
def = RegionHotspotsParams
defaultRegionHotspotsParams

-- ** Optics for 'RegionHotspotsParams'
makeLenses ''RegionHotspotsParams
makeFieldLabels ''RegionHotspotsParams

-------------------------------------------------------------------------------
-- * Nearby hotspots
-------------------------------------------------------------------------------

-- | Get all hotspots within a radius of some latitude/longitude.
--
-- For example, get the hotspots within 30km of Cody, Wyoming that have been
-- visited in the last 5 days (using @-XOverloadedLabels@
-- and @-XOverloadedStrings@):
--
-- @
-- askEBird $
--   nearbyHotspots
--     44.526340 (-109.056534)
--     (def & #radius ?~ 30 & #back ?~ 5)
-- @
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#674e81c1-6a0c-4836-8a7e-6ea1fe8e6677).
nearbyHotspots
  :: Double
  -- ^ Latitude of the location to get hotspots near
  -> Double
  -- ^ Longitude of the location to get hotspots near
  -> NearbyHotspotsParams
  -- ^ Optional parameters
  --
  -- /default: 'defaultNearbyHotspotsParams'/
  -> ClientM [Hotspot]
nearbyHotspots :: Double -> Double -> NearbyHotspotsParams -> ClientM [Hotspot]
nearbyHotspots Double
lat Double
lng NearbyHotspotsParams{Maybe Integer
_nearbyHotspotsParamsBack :: Maybe Integer
_nearbyHotspotsParamsRadius :: Maybe Integer
_nearbyHotspotsParamsBack :: NearbyHotspotsParams -> Maybe Integer
_nearbyHotspotsParamsRadius :: NearbyHotspotsParams -> Maybe Integer
..} =
    Double
-> Double
-> Maybe Integer
-> Maybe Integer
-> Maybe CSVOrJSONFormat
-> ClientM [Hotspot]
nearbyHotspots_ Double
lat Double
lng
      Maybe Integer
_nearbyHotspotsParamsBack
      Maybe Integer
_nearbyHotspotsParamsRadius
      -- 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)

-- | Optional parameters accepted by the 'NearbyHotspotsAPI'.
--
-- Note that 'defaultNearbyHotspotsParams' (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
-- '_nearbyHotspotsParamsBack' field to 10:
--
-- > def & nearbyHotspotsParamsBack ?~ 10
--
-- Or, using @-XOverloadedLabels@:
--
-- > def & #back ?~ 10
data NearbyHotspotsParams =
    NearbyHotspotsParams
      { -- | Only fetch hotspots that have been visited within this many days
        -- ago
        --
        -- /1 - 30, default: no limit/
        NearbyHotspotsParams -> Maybe Integer
_nearbyHotspotsParamsBack :: Maybe Integer

        -- ^ Search radius in kilometers
        --
        -- /0 - 50, default: 25/
      , NearbyHotspotsParams -> Maybe Integer
_nearbyHotspotsParamsRadius :: Maybe Integer
      }
  deriving (Int -> NearbyHotspotsParams -> ShowS
[NearbyHotspotsParams] -> ShowS
NearbyHotspotsParams -> String
(Int -> NearbyHotspotsParams -> ShowS)
-> (NearbyHotspotsParams -> String)
-> ([NearbyHotspotsParams] -> ShowS)
-> Show NearbyHotspotsParams
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> NearbyHotspotsParams -> ShowS
showsPrec :: Int -> NearbyHotspotsParams -> ShowS
$cshow :: NearbyHotspotsParams -> String
show :: NearbyHotspotsParams -> String
$cshowList :: [NearbyHotspotsParams] -> ShowS
showList :: [NearbyHotspotsParams] -> ShowS
Show, ReadPrec [NearbyHotspotsParams]
ReadPrec NearbyHotspotsParams
Int -> ReadS NearbyHotspotsParams
ReadS [NearbyHotspotsParams]
(Int -> ReadS NearbyHotspotsParams)
-> ReadS [NearbyHotspotsParams]
-> ReadPrec NearbyHotspotsParams
-> ReadPrec [NearbyHotspotsParams]
-> Read NearbyHotspotsParams
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS NearbyHotspotsParams
readsPrec :: Int -> ReadS NearbyHotspotsParams
$creadList :: ReadS [NearbyHotspotsParams]
readList :: ReadS [NearbyHotspotsParams]
$creadPrec :: ReadPrec NearbyHotspotsParams
readPrec :: ReadPrec NearbyHotspotsParams
$creadListPrec :: ReadPrec [NearbyHotspotsParams]
readListPrec :: ReadPrec [NearbyHotspotsParams]
Read, NearbyHotspotsParams -> NearbyHotspotsParams -> Bool
(NearbyHotspotsParams -> NearbyHotspotsParams -> Bool)
-> (NearbyHotspotsParams -> NearbyHotspotsParams -> Bool)
-> Eq NearbyHotspotsParams
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: NearbyHotspotsParams -> NearbyHotspotsParams -> Bool
== :: NearbyHotspotsParams -> NearbyHotspotsParams -> Bool
$c/= :: NearbyHotspotsParams -> NearbyHotspotsParams -> Bool
/= :: NearbyHotspotsParams -> NearbyHotspotsParams -> 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.
defaultNearbyHotspotsParams :: NearbyHotspotsParams
defaultNearbyHotspotsParams :: NearbyHotspotsParams
defaultNearbyHotspotsParams =
    NearbyHotspotsParams
      { _nearbyHotspotsParamsBack :: Maybe Integer
_nearbyHotspotsParamsBack = Maybe Integer
forall a. Maybe a
Nothing
      , _nearbyHotspotsParamsRadius :: Maybe Integer
_nearbyHotspotsParamsRadius = Maybe Integer
forall a. Maybe a
Nothing
      }

instance Default NearbyHotspotsParams where
  def :: NearbyHotspotsParams
def = NearbyHotspotsParams
defaultNearbyHotspotsParams

-- ** Optics for 'NearbyHotspotsParams'
makeLenses ''NearbyHotspotsParams
makeFieldLabels ''NearbyHotspotsParams

-------------------------------------------------------------------------------
-- * Hotspot info
-------------------------------------------------------------------------------

-- | Get information about a hotspot.
--
-- For example, get information for a hotspot with location ID
-- \"L2373040\" (using @-XOverloadedStrings@):
--
-- @
-- askEBird $ hotspotInfo "L2373040"
-- @
--
-- Note that the endpoint for this query is simple enough that 'hotspotInfo'
-- is equivalent to the generated 'hotspotInfo_'.
--
-- See the [eBird API documentation for the corresponding
-- endpoint](https://documenter.getpostman.com/view/664302/S1ENwy59#e25218db-566b-4d8b-81ca-e79a8f68c599).
hotspotInfo
  :: Text
  -- ^ Hotspot location ID, e.g. \"L2373040\"
  -> ClientM LocationData
hotspotInfo :: Text -> ClientM LocationData
hotspotInfo = Text -> ClientM LocationData
hotspotInfo_