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

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

module Data.EBird.API.Product where

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

import Data.EBird.API.EBirdString

-------------------------------------------------------------------------------
-- * Top 100 contributors API types
-------------------------------------------------------------------------------

-- | Values held in the top 100 contributors list returned by the eBird API.
data Top100ListEntry =
    Top100ListEntry
      { -- | The profile handle of the user, whocse profile may be seen at
        -- ebird.org/profile/{handle} if they have a profile
        Top100ListEntry -> Maybe Text
_top100ListEntryProfileHandle :: Maybe Text

        -- | The display name of the user (typically their full name)
      , Top100ListEntry -> Text
_top100ListEntryUserDisplayName :: Text

        -- | The number of species the user observed on the date
      , Top100ListEntry -> Integer
_top100ListEntryNumSpecies :: Integer

        -- | The number of complete checklists the user contributed on the date
      , Top100ListEntry -> Integer
_top100ListEntryNumCompleteChecklists :: Integer

        -- | The ranking of the user
      , Top100ListEntry -> Integer
_top100ListEntryRowNum :: Integer

        -- | The user ID od the user
      , Top100ListEntry -> Text
_top100ListEntryUserId :: Text
      }
  deriving (Int -> Top100ListEntry -> ShowS
[Top100ListEntry] -> ShowS
Top100ListEntry -> String
(Int -> Top100ListEntry -> ShowS)
-> (Top100ListEntry -> String)
-> ([Top100ListEntry] -> ShowS)
-> Show Top100ListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Top100ListEntry -> ShowS
showsPrec :: Int -> Top100ListEntry -> ShowS
$cshow :: Top100ListEntry -> String
show :: Top100ListEntry -> String
$cshowList :: [Top100ListEntry] -> ShowS
showList :: [Top100ListEntry] -> ShowS
Show, ReadPrec [Top100ListEntry]
ReadPrec Top100ListEntry
Int -> ReadS Top100ListEntry
ReadS [Top100ListEntry]
(Int -> ReadS Top100ListEntry)
-> ReadS [Top100ListEntry]
-> ReadPrec Top100ListEntry
-> ReadPrec [Top100ListEntry]
-> Read Top100ListEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Top100ListEntry
readsPrec :: Int -> ReadS Top100ListEntry
$creadList :: ReadS [Top100ListEntry]
readList :: ReadS [Top100ListEntry]
$creadPrec :: ReadPrec Top100ListEntry
readPrec :: ReadPrec Top100ListEntry
$creadListPrec :: ReadPrec [Top100ListEntry]
readListPrec :: ReadPrec [Top100ListEntry]
Read, Top100ListEntry -> Top100ListEntry -> Bool
(Top100ListEntry -> Top100ListEntry -> Bool)
-> (Top100ListEntry -> Top100ListEntry -> Bool)
-> Eq Top100ListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Top100ListEntry -> Top100ListEntry -> Bool
== :: Top100ListEntry -> Top100ListEntry -> Bool
$c/= :: Top100ListEntry -> Top100ListEntry -> Bool
/= :: Top100ListEntry -> Top100ListEntry -> Bool
Eq)

-- ** Optics for the Top100ListEntry type

makeLenses ''Top100ListEntry
makeFieldLabels ''Top100ListEntry

-- | How to rank the list returned by the 'Data.EBird.API.Top100API'.
data RankTop100By
      -- | Rank the list by the number of species seen
    = RankTop100BySpecies

      -- | Rank the list by number of contributed checklists
    | RankTop100ByChecklists
  deriving (Int -> RankTop100By -> ShowS
[RankTop100By] -> ShowS
RankTop100By -> String
(Int -> RankTop100By -> ShowS)
-> (RankTop100By -> String)
-> ([RankTop100By] -> ShowS)
-> Show RankTop100By
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RankTop100By -> ShowS
showsPrec :: Int -> RankTop100By -> ShowS
$cshow :: RankTop100By -> String
show :: RankTop100By -> String
$cshowList :: [RankTop100By] -> ShowS
showList :: [RankTop100By] -> ShowS
Show, ReadPrec [RankTop100By]
ReadPrec RankTop100By
Int -> ReadS RankTop100By
ReadS [RankTop100By]
(Int -> ReadS RankTop100By)
-> ReadS [RankTop100By]
-> ReadPrec RankTop100By
-> ReadPrec [RankTop100By]
-> Read RankTop100By
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RankTop100By
readsPrec :: Int -> ReadS RankTop100By
$creadList :: ReadS [RankTop100By]
readList :: ReadS [RankTop100By]
$creadPrec :: ReadPrec RankTop100By
readPrec :: ReadPrec RankTop100By
$creadListPrec :: ReadPrec [RankTop100By]
readListPrec :: ReadPrec [RankTop100By]
Read, RankTop100By -> RankTop100By -> Bool
(RankTop100By -> RankTop100By -> Bool)
-> (RankTop100By -> RankTop100By -> Bool) -> Eq RankTop100By
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RankTop100By -> RankTop100By -> Bool
== :: RankTop100By -> RankTop100By -> Bool
$c/= :: RankTop100By -> RankTop100By -> Bool
/= :: RankTop100By -> RankTop100By -> Bool
Eq)

-------------------------------------------------------------------------------
-- * Regional statistics API types
-------------------------------------------------------------------------------

-- | Values returned by the 'Data.EBird.API.RegionalStatisticsAPI'.
data RegionalStatistics =
    RegionalStatistics
      { -- | Number of checklists submitted in the region
        RegionalStatistics -> Integer
_regionalStatisticsNumChecklists :: Integer

        -- | Number of contributors who have submitted checklists in the region
      , RegionalStatistics -> Integer
_regionalStatisticsNumContributors :: Integer

        -- | Number of species included in checklists in the region
      , RegionalStatistics -> Integer
_regionalStatisticsNumSpecies :: Integer
      }
  deriving (Int -> RegionalStatistics -> ShowS
[RegionalStatistics] -> ShowS
RegionalStatistics -> String
(Int -> RegionalStatistics -> ShowS)
-> (RegionalStatistics -> String)
-> ([RegionalStatistics] -> ShowS)
-> Show RegionalStatistics
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionalStatistics -> ShowS
showsPrec :: Int -> RegionalStatistics -> ShowS
$cshow :: RegionalStatistics -> String
show :: RegionalStatistics -> String
$cshowList :: [RegionalStatistics] -> ShowS
showList :: [RegionalStatistics] -> ShowS
Show, ReadPrec [RegionalStatistics]
ReadPrec RegionalStatistics
Int -> ReadS RegionalStatistics
ReadS [RegionalStatistics]
(Int -> ReadS RegionalStatistics)
-> ReadS [RegionalStatistics]
-> ReadPrec RegionalStatistics
-> ReadPrec [RegionalStatistics]
-> Read RegionalStatistics
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionalStatistics
readsPrec :: Int -> ReadS RegionalStatistics
$creadList :: ReadS [RegionalStatistics]
readList :: ReadS [RegionalStatistics]
$creadPrec :: ReadPrec RegionalStatistics
readPrec :: ReadPrec RegionalStatistics
$creadListPrec :: ReadPrec [RegionalStatistics]
readListPrec :: ReadPrec [RegionalStatistics]
Read, RegionalStatistics -> RegionalStatistics -> Bool
(RegionalStatistics -> RegionalStatistics -> Bool)
-> (RegionalStatistics -> RegionalStatistics -> Bool)
-> Eq RegionalStatistics
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionalStatistics -> RegionalStatistics -> Bool
== :: RegionalStatistics -> RegionalStatistics -> Bool
$c/= :: RegionalStatistics -> RegionalStatistics -> Bool
/= :: RegionalStatistics -> RegionalStatistics -> Bool
Eq)

-- ** Optics for the RegionalStatistics type

makeLenses ''RegionalStatistics
makeFieldLabels ''RegionalStatistics

-------------------------------------------------------------------------------
-- Aeson instances
-------------------------------------------------------------------------------

-- | Explicit instance for compatibility with their field names
instance FromJSON Top100ListEntry where
  parseJSON :: Value -> Parser Top100ListEntry
parseJSON = String
-> (Object -> Parser Top100ListEntry)
-> Value
-> Parser Top100ListEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Top100ListEntry" ((Object -> Parser Top100ListEntry)
 -> Value -> Parser Top100ListEntry)
-> (Object -> Parser Top100ListEntry)
-> Value
-> Parser Top100ListEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Maybe Text
-> Text -> Integer -> Integer -> Integer -> Text -> Top100ListEntry
Top100ListEntry
        (Maybe Text
 -> Text
 -> Integer
 -> Integer
 -> Integer
 -> Text
 -> Top100ListEntry)
-> Parser (Maybe Text)
-> Parser
     (Text -> Integer -> Integer -> Integer -> Text -> Top100ListEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"profileHandle"
        Parser
  (Text -> Integer -> Integer -> Integer -> Text -> Top100ListEntry)
-> Parser Text
-> Parser
     (Integer -> Integer -> Integer -> Text -> Top100ListEntry)
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
"userDisplayName"
        Parser (Integer -> Integer -> Integer -> Text -> Top100ListEntry)
-> Parser Integer
-> Parser (Integer -> Integer -> Text -> Top100ListEntry)
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 Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numSpecies"
        Parser (Integer -> Integer -> Text -> Top100ListEntry)
-> Parser Integer -> Parser (Integer -> Text -> Top100ListEntry)
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 Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numCompleteChecklists"
        Parser (Integer -> Text -> Top100ListEntry)
-> Parser Integer -> Parser (Text -> Top100ListEntry)
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 Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"rowNum"
        Parser (Text -> Top100ListEntry)
-> Parser Text -> Parser Top100ListEntry
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
"userId"

-- | Explicit instance for compatibility with their field names
instance ToJSON Top100ListEntry where
  toJSON :: Top100ListEntry -> Value
toJSON Top100ListEntry{Integer
Maybe Text
Text
_top100ListEntryProfileHandle :: Top100ListEntry -> Maybe Text
_top100ListEntryUserDisplayName :: Top100ListEntry -> Text
_top100ListEntryNumSpecies :: Top100ListEntry -> Integer
_top100ListEntryNumCompleteChecklists :: Top100ListEntry -> Integer
_top100ListEntryRowNum :: Top100ListEntry -> Integer
_top100ListEntryUserId :: Top100ListEntry -> Text
_top100ListEntryProfileHandle :: Maybe Text
_top100ListEntryUserDisplayName :: Text
_top100ListEntryNumSpecies :: Integer
_top100ListEntryNumCompleteChecklists :: Integer
_top100ListEntryRowNum :: Integer
_top100ListEntryUserId :: Text
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"userDisplayname" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_top100ListEntryUserDisplayName
        , Key
"numSpecies" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_top100ListEntryNumSpecies
        , Key
"numCompleteChecklists" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_top100ListEntryNumCompleteChecklists
        , Key
"rowNum" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_top100ListEntryRowNum
        , Key
"userId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_top100ListEntryUserId
        ]
        -- Fields that may or may not be included, depending on the contributor
        -- data
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"profileHandle" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
profileHandle
           | Just Text
profileHandle <- [Maybe Text
_top100ListEntryProfileHandle]
           ]

-- | Explicit instance for compatibility with their field names
instance FromJSON RegionalStatistics where
  parseJSON :: Value -> Parser RegionalStatistics
parseJSON = String
-> (Object -> Parser RegionalStatistics)
-> Value
-> Parser RegionalStatistics
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RegionalStatistics" ((Object -> Parser RegionalStatistics)
 -> Value -> Parser RegionalStatistics)
-> (Object -> Parser RegionalStatistics)
-> Value
-> Parser RegionalStatistics
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Integer -> Integer -> Integer -> RegionalStatistics
RegionalStatistics
        (Integer -> Integer -> Integer -> RegionalStatistics)
-> Parser Integer
-> Parser (Integer -> Integer -> RegionalStatistics)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numChecklists"
        Parser (Integer -> Integer -> RegionalStatistics)
-> Parser Integer -> Parser (Integer -> RegionalStatistics)
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 Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numContributors"
        Parser (Integer -> RegionalStatistics)
-> Parser Integer -> Parser RegionalStatistics
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 Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"numSpecies"

-- | Explicit instance for compatibility with their field names
instance ToJSON RegionalStatistics where
  toJSON :: RegionalStatistics -> Value
toJSON RegionalStatistics{Integer
_regionalStatisticsNumChecklists :: RegionalStatistics -> Integer
_regionalStatisticsNumContributors :: RegionalStatistics -> Integer
_regionalStatisticsNumSpecies :: RegionalStatistics -> Integer
_regionalStatisticsNumChecklists :: Integer
_regionalStatisticsNumContributors :: Integer
_regionalStatisticsNumSpecies :: Integer
..} =
      [Pair] -> Value
object
        [ Key
"numChecklists" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_regionalStatisticsNumChecklists
        , Key
"numContributors" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_regionalStatisticsNumContributors
        , Key
"numSpecies" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_regionalStatisticsNumSpecies
        ]

-------------------------------------------------------------------------------
-- 'EBirdString' instances
-------------------------------------------------------------------------------

-- | The eBird string for a 'RankTop100By' value is either "spp" or "cl".
instance EBirdString RankTop100By where
  toEBirdString :: RankTop100By -> Text
toEBirdString =
      \case
        RankTop100By
RankTop100BySpecies -> Text
"spp"
        RankTop100By
RankTop100ByChecklists -> Text
"cl"

  fromEBirdString :: Text -> Either Text RankTop100By
fromEBirdString Text
str =
      Parser RankTop100By -> Text -> Either String RankTop100By
forall a. Parser a -> Text -> Either String a
parseOnly Parser RankTop100By
parseRankTop100By Text
str
    Either String RankTop100By
-> (Either String RankTop100By -> Either Text RankTop100By)
-> Either Text RankTop100By
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String RankTop100By -> Either Text RankTop100By
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 RankTop100By: " 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 RankTop100By where
  fromString :: String -> RankTop100By
fromString = Text -> RankTop100By
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> RankTop100By)
-> (String -> Text) -> String -> RankTop100By
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

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

-- | Parse a 'RankTop100By' value
parseRankTop100By :: Parser RankTop100By
parseRankTop100By :: Parser RankTop100By
parseRankTop100By =
    [Parser RankTop100By] -> Parser RankTop100By
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"spp" Parser Text Text -> RankTop100By -> Parser RankTop100By
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RankTop100By
RankTop100BySpecies
      , Parser Text Text
"cl" Parser Text Text -> RankTop100By -> Parser RankTop100By
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RankTop100By
RankTop100ByChecklists
      ]
  where
    _casesCovered :: RankTop100By -> ()
    _casesCovered :: RankTop100By -> ()
_casesCovered =
      \case
        RankTop100By
RankTop100BySpecies -> ()
        RankTop100By
RankTop100ByChecklists -> ()

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

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