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

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

module Data.EBird.API.Hotspots where

import Control.Arrow
import Data.Aeson
import Data.Attoparsec.Text
import Data.Function
import Data.Functor
import Data.String
import Data.Text (Text)
import Data.Text qualified as Text
import Optics
import Servant.API

import Data.EBird.API.EBirdString
import Data.EBird.API.Regions
import Data.EBird.API.Util.Time

-------------------------------------------------------------------------------
-- * Hotspot type
-------------------------------------------------------------------------------

-- | eBird hotspots, as returned by the 'Data.EBird.API.RegionHotspotsAPI'
data Hotspot =
    Hotspot
      { -- | Location ID of the hotspot
        Hotspot -> Text
_hotspotLocationId :: Text

        -- | Name of the hotspot
      , Hotspot -> Text
_hotspotLocationName :: Text

        -- | The country the hotspot is in
      , Hotspot -> Region
_hotspotCountryCode :: Region

        -- | The state the hotspot is in
      , Hotspot -> Region
_hotspotSubnational1Code :: Region

        -- | The county the hotspot is in
      , Hotspot -> Region
_hotspotSubnational2Code :: Region

        -- | The latitude of the hotspot
      , Hotspot -> Double
_hotspotLatitude :: Double

        -- | The longitude of the hotspot
      , Hotspot -> Double
_hotspotLongitude :: Double

        -- | The date and time of the latest observation at the hotspot. Could
        -- be 'Nothing' if the hotspot has never been birded
      , Hotspot -> Maybe EBirdDateTime
_hotspotLatestObsDateTime :: Maybe EBirdDateTime

        -- | The number of species ever seen at the hotspot. Could be 'Nothing'
        -- if the hotspot has never been birded
      , Hotspot -> Maybe Integer
_hotspotNumSpeciesAllTime :: Maybe Integer
      }
  deriving (Int -> Hotspot -> ShowS
[Hotspot] -> ShowS
Hotspot -> String
(Int -> Hotspot -> ShowS)
-> (Hotspot -> String) -> ([Hotspot] -> ShowS) -> Show Hotspot
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Hotspot -> ShowS
showsPrec :: Int -> Hotspot -> ShowS
$cshow :: Hotspot -> String
show :: Hotspot -> String
$cshowList :: [Hotspot] -> ShowS
showList :: [Hotspot] -> ShowS
Show, ReadPrec [Hotspot]
ReadPrec Hotspot
Int -> ReadS Hotspot
ReadS [Hotspot]
(Int -> ReadS Hotspot)
-> ReadS [Hotspot]
-> ReadPrec Hotspot
-> ReadPrec [Hotspot]
-> Read Hotspot
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Hotspot
readsPrec :: Int -> ReadS Hotspot
$creadList :: ReadS [Hotspot]
readList :: ReadS [Hotspot]
$creadPrec :: ReadPrec Hotspot
readPrec :: ReadPrec Hotspot
$creadListPrec :: ReadPrec [Hotspot]
readListPrec :: ReadPrec [Hotspot]
Read, Hotspot -> Hotspot -> Bool
(Hotspot -> Hotspot -> Bool)
-> (Hotspot -> Hotspot -> Bool) -> Eq Hotspot
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Hotspot -> Hotspot -> Bool
== :: Hotspot -> Hotspot -> Bool
$c/= :: Hotspot -> Hotspot -> Bool
/= :: Hotspot -> Hotspot -> Bool
Eq)

-- ** Optics for the Hotspot type

makeLenses ''Hotspot
makeFieldLabels ''Hotspot

-------------------------------------------------------------------------------
-- * Auxiliary eBird hotspot-related API types
-------------------------------------------------------------------------------

-- | Used to specify what format hotspot values should be returned in from the
-- hotspots APIs.
data CSVOrJSONFormat = CSVFormat | JSONFormat
  deriving (Int -> CSVOrJSONFormat -> ShowS
[CSVOrJSONFormat] -> ShowS
CSVOrJSONFormat -> String
(Int -> CSVOrJSONFormat -> ShowS)
-> (CSVOrJSONFormat -> String)
-> ([CSVOrJSONFormat] -> ShowS)
-> Show CSVOrJSONFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CSVOrJSONFormat -> ShowS
showsPrec :: Int -> CSVOrJSONFormat -> ShowS
$cshow :: CSVOrJSONFormat -> String
show :: CSVOrJSONFormat -> String
$cshowList :: [CSVOrJSONFormat] -> ShowS
showList :: [CSVOrJSONFormat] -> ShowS
Show, ReadPrec [CSVOrJSONFormat]
ReadPrec CSVOrJSONFormat
Int -> ReadS CSVOrJSONFormat
ReadS [CSVOrJSONFormat]
(Int -> ReadS CSVOrJSONFormat)
-> ReadS [CSVOrJSONFormat]
-> ReadPrec CSVOrJSONFormat
-> ReadPrec [CSVOrJSONFormat]
-> Read CSVOrJSONFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS CSVOrJSONFormat
readsPrec :: Int -> ReadS CSVOrJSONFormat
$creadList :: ReadS [CSVOrJSONFormat]
readList :: ReadS [CSVOrJSONFormat]
$creadPrec :: ReadPrec CSVOrJSONFormat
readPrec :: ReadPrec CSVOrJSONFormat
$creadListPrec :: ReadPrec [CSVOrJSONFormat]
readListPrec :: ReadPrec [CSVOrJSONFormat]
Read, CSVOrJSONFormat -> CSVOrJSONFormat -> Bool
(CSVOrJSONFormat -> CSVOrJSONFormat -> Bool)
-> (CSVOrJSONFormat -> CSVOrJSONFormat -> Bool)
-> Eq CSVOrJSONFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CSVOrJSONFormat -> CSVOrJSONFormat -> Bool
== :: CSVOrJSONFormat -> CSVOrJSONFormat -> Bool
$c/= :: CSVOrJSONFormat -> CSVOrJSONFormat -> Bool
/= :: CSVOrJSONFormat -> CSVOrJSONFormat -> Bool
Eq)

-------------------------------------------------------------------------------
-- aeson instances
-------------------------------------------------------------------------------

-- | Explicit instance for compatibility with their field names
instance FromJSON Hotspot where
  parseJSON :: Value -> Parser Hotspot
parseJSON = String -> (Object -> Parser Hotspot) -> Value -> Parser Hotspot
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Hotspot" ((Object -> Parser Hotspot) -> Value -> Parser Hotspot)
-> (Object -> Parser Hotspot) -> Value -> Parser Hotspot
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Region
-> Region
-> Region
-> Double
-> Double
-> Maybe EBirdDateTime
-> Maybe Integer
-> Hotspot
Hotspot
        (Text
 -> Text
 -> Region
 -> Region
 -> Region
 -> Double
 -> Double
 -> Maybe EBirdDateTime
 -> Maybe Integer
 -> Hotspot)
-> Parser Text
-> Parser
     (Text
      -> Region
      -> Region
      -> Region
      -> Double
      -> Double
      -> Maybe EBirdDateTime
      -> Maybe Integer
      -> Hotspot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locId"
        Parser
  (Text
   -> Region
   -> Region
   -> Region
   -> Double
   -> Double
   -> Maybe EBirdDateTime
   -> Maybe Integer
   -> Hotspot)
-> Parser Text
-> Parser
     (Region
      -> Region
      -> Region
      -> Double
      -> Double
      -> Maybe EBirdDateTime
      -> Maybe Integer
      -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locName"
        Parser
  (Region
   -> Region
   -> Region
   -> Double
   -> Double
   -> Maybe EBirdDateTime
   -> Maybe Integer
   -> Hotspot)
-> Parser Region
-> Parser
     (Region
      -> Region
      -> Double
      -> Double
      -> Maybe EBirdDateTime
      -> Maybe Integer
      -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Region
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"countryCode"
        Parser
  (Region
   -> Region
   -> Double
   -> Double
   -> Maybe EBirdDateTime
   -> Maybe Integer
   -> Hotspot)
-> Parser Region
-> Parser
     (Region
      -> Double
      -> Double
      -> Maybe EBirdDateTime
      -> Maybe Integer
      -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Region
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subnational1Code"
        Parser
  (Region
   -> Double
   -> Double
   -> Maybe EBirdDateTime
   -> Maybe Integer
   -> Hotspot)
-> Parser Region
-> Parser
     (Double
      -> Double -> Maybe EBirdDateTime -> Maybe Integer -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Region
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subnational2Code"
        Parser
  (Double
   -> Double -> Maybe EBirdDateTime -> Maybe Integer -> Hotspot)
-> Parser Double
-> Parser
     (Double -> Maybe EBirdDateTime -> Maybe Integer -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lat"
        Parser (Double -> Maybe EBirdDateTime -> Maybe Integer -> Hotspot)
-> Parser Double
-> Parser (Maybe EBirdDateTime -> Maybe Integer -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lng"
        Parser (Maybe EBirdDateTime -> Maybe Integer -> Hotspot)
-> Parser (Maybe EBirdDateTime)
-> Parser (Maybe Integer -> Hotspot)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe EBirdDateTime)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"latestObsDt"
        Parser (Maybe Integer -> Hotspot)
-> Parser (Maybe Integer) -> Parser Hotspot
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"numSpeciesAllTime"

-- | Explicit instance for compatibility with their field names
instance ToJSON Hotspot where
  toJSON :: Hotspot -> Value
toJSON Hotspot{Double
Maybe Integer
Maybe EBirdDateTime
Text
Region
_hotspotLocationId :: Hotspot -> Text
_hotspotLocationName :: Hotspot -> Text
_hotspotCountryCode :: Hotspot -> Region
_hotspotSubnational1Code :: Hotspot -> Region
_hotspotSubnational2Code :: Hotspot -> Region
_hotspotLatitude :: Hotspot -> Double
_hotspotLongitude :: Hotspot -> Double
_hotspotLatestObsDateTime :: Hotspot -> Maybe EBirdDateTime
_hotspotNumSpeciesAllTime :: Hotspot -> Maybe Integer
_hotspotLocationId :: Text
_hotspotLocationName :: Text
_hotspotCountryCode :: Region
_hotspotSubnational1Code :: Region
_hotspotSubnational2Code :: Region
_hotspotLatitude :: Double
_hotspotLongitude :: Double
_hotspotLatestObsDateTime :: Maybe EBirdDateTime
_hotspotNumSpeciesAllTime :: Maybe Integer
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"locId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_hotspotLocationId
        , Key
"locName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_hotspotLocationName
        , Key
"countryCode" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_hotspotCountryCode
        , Key
"subnational1Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_hotspotSubnational1Code
        , Key
"subnational2Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_hotspotSubnational2Code
        , Key
"lat" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_hotspotLatitude
        , Key
"lng" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_hotspotLongitude
        ]
        -- Fields that may or may not be present depending on the data
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"latestObsDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
latestObsDt
           | Just EBirdDateTime
latestObsDt <- [Maybe EBirdDateTime
_hotspotLatestObsDateTime]
           ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"numSpeciesAllTime" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
numSpecies
           | Just Integer
numSpecies <- [Maybe Integer
_hotspotNumSpeciesAllTime]
           ]

-------------------------------------------------------------------------------
-- EBirdString instances
-------------------------------------------------------------------------------

-- | The eBird string of a 'CSVOrJSONFormat' value is either "csv" or "json".
instance EBirdString CSVOrJSONFormat where
  toEBirdString :: CSVOrJSONFormat -> Text
toEBirdString =
      \case
        CSVOrJSONFormat
CSVFormat -> Text
"csv"
        CSVOrJSONFormat
JSONFormat -> Text
"json"

  fromEBirdString :: Text -> Either Text CSVOrJSONFormat
fromEBirdString Text
str =
        Parser CSVOrJSONFormat -> Text -> Either String CSVOrJSONFormat
forall a. Parser a -> Text -> Either String a
parseOnly Parser CSVOrJSONFormat
parseCSVOrJSONFormat Text
str
      Either String CSVOrJSONFormat
-> (Either String CSVOrJSONFormat -> Either Text CSVOrJSONFormat)
-> Either Text CSVOrJSONFormat
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String CSVOrJSONFormat -> Either Text CSVOrJSONFormat
forall b c d. (b -> c) -> Either b d -> Either c d
forall (a :: * -> * -> *) b c d.
ArrowChoice a =>
a b c -> a (Either b d) (Either c d)
left ((Text
"Failed to parse CSVOrJSONFormat: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>) (Text -> Text) -> (String -> Text) -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack)

-------------------------------------------------------------------------------
-- IsString instances
-------------------------------------------------------------------------------

-- | Use this instance carefully! It throws runtime exceptions if the string is
-- malformatted.
instance IsString CSVOrJSONFormat where
  fromString :: String -> CSVOrJSONFormat
fromString = Text -> CSVOrJSONFormat
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> CSVOrJSONFormat)
-> (String -> Text) -> String -> CSVOrJSONFormat
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-------------------------------------------------------------------------------
-- * attoparsec parsers
-------------------------------------------------------------------------------

-- | Parse a list of eBird API taxononomy categories. To avoid the partial
-- behavior of converting a 'sepBy1' result into a 'Data.List.NonEmpty', we
-- manually parse the first category followed by an optional tail.
parseCSVOrJSONFormat :: Parser CSVOrJSONFormat
parseCSVOrJSONFormat :: Parser CSVOrJSONFormat
parseCSVOrJSONFormat =
    [Parser CSVOrJSONFormat] -> Parser CSVOrJSONFormat
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"csv" Parser Text Text -> CSVOrJSONFormat -> Parser CSVOrJSONFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CSVOrJSONFormat
CSVFormat
      , Parser Text Text
"json" Parser Text Text -> CSVOrJSONFormat -> Parser CSVOrJSONFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> CSVOrJSONFormat
JSONFormat
      ]
  where
    _casesCovered :: CSVOrJSONFormat -> ()
    _casesCovered :: CSVOrJSONFormat -> ()
_casesCovered =
      \case
        CSVOrJSONFormat
CSVFormat -> ()
        CSVOrJSONFormat
JSONFormat -> ()

-------------------------------------------------------------------------------
-- 'ToHttpApiData' instances
-------------------------------------------------------------------------------

instance ToHttpApiData CSVOrJSONFormat where
  toUrlPiece :: CSVOrJSONFormat -> Text
toUrlPiece = CSVOrJSONFormat -> Text
forall a. EBirdString a => a -> Text
toEBirdString