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

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

module Data.EBird.API.Checklists 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 (ToHttpApiData(..))

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

-------------------------------------------------------------------------------
-- * Checklist types
-------------------------------------------------------------------------------

-- | Values returned by the 'Data.EBird.API.ViewChecklistAPI'
data Checklist =
    Checklist
      { -- | Project ID, e.g. \"EBIRD\"
        Checklist -> Text
_checklistProjectId :: Text

        -- | Checklist submission ID, e.g. \"S144646447\"
      , Checklist -> Text
_checklistSubId :: Text

        -- | Checklist protocol ID, e.g. \"P21\"
      , Checklist -> Text
_checklistProtocolId :: Text

        -- | Checklist location ID
      , Checklist -> Text
_checklistLocationId :: Text

        -- | Checklist group ID
      , Checklist -> Text
_checklistGroupId :: Text

        -- | Checklist duration, only 'Just' for checklists of appropriate
        -- protocols (e.g. not incidentals)
      , Checklist -> Maybe Double
_checklistDurationHours :: Maybe Double

        -- | Was every bird observed reported?
      , Checklist -> Bool
_checklistAllObsReported :: Bool

        -- | What date and time was the checklist created (i.e. submitted)?
      , Checklist -> EBirdDateTime
_checklistCreationDateTime :: EBirdDateTime

        -- | What date and time what the checklist last edited?
      , Checklist -> EBirdDateTime
_checklistLastEditedDateTime :: EBirdDateTime

        -- | What date and time what the checklist started?
      , Checklist -> EBirdDateTime
_checklistObsDateTime :: EBirdDateTime

        -- | TODO: Not sure what this is for
      , Checklist -> Bool
_checklistObsTimeValid :: Bool

        -- | The ID of the checklist, e.g. \"CL24936\"
      , Checklist -> Text
_checklistChecklistId :: Text

        -- | The number of observers on this checklist
      , Checklist -> Integer
_checklistNumObservers :: Integer

        -- | Distance travelled during this checklist in kilometers, only 'Just'
        -- for checklists of appropriate protocols (e.g. not incidentals)
      , Checklist -> Maybe Double
_checklistEffortDistanceKm :: Maybe Double

        -- | The unit of distance used for the checklist submission (e.g. "mi"),
        -- only 'Just' for checklists of appropriate protocols (e.g. not
        -- incidentals)
      , Checklist -> Maybe Text
_checklistEffortDistanceEnteredUnit :: Maybe Text

        -- | The subnational1 region (state) that the checklist was submitted in
      , Checklist -> Region
_checklistSubnational1Code :: Region

        -- | Method of checklist submission
      , Checklist -> Text
_checklistSubmissionMethodCode :: Text

        -- | Version of the method of checklist submission, e.g. "2.13.2_SDK33"
      , Checklist -> Text
_checklistSubmissionMethodVersion :: Text

        -- | Display-ready version of the method of checklist submission, e.g.
        -- "2.13.2"
      , Checklist -> Text
_checklistSubmissionMethodVersionDisp :: Text

        -- | Display name of the user that submitted the checklist
      , Checklist -> Text
_checklistUserDisplayName :: Text

        -- | Number of species included in observations on this checklist
      , Checklist -> Integer
_checklistNumSpecies :: Integer

        -- | Submission auxiliary entry methods
        --
        -- TODO: Not sure what these are about
      , Checklist -> [SubAux]
_checklistSubAux :: [SubAux]

        -- | Submission auxiliary entry methods that use aritificial
        -- intelligence
        --
        -- TODO: Not sure what these are about
      , Checklist -> [SubAuxAI]
_checklistSubAuxAI :: [SubAuxAI]

        -- | Observations included in the checklist
      , Checklist -> [ChecklistObservation]
_checklistObs:: [ChecklistObservation]
      }
  deriving (Int -> Checklist -> ShowS
[Checklist] -> ShowS
Checklist -> String
(Int -> Checklist -> ShowS)
-> (Checklist -> String)
-> ([Checklist] -> ShowS)
-> Show Checklist
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Checklist -> ShowS
showsPrec :: Int -> Checklist -> ShowS
$cshow :: Checklist -> String
show :: Checklist -> String
$cshowList :: [Checklist] -> ShowS
showList :: [Checklist] -> ShowS
Show, ReadPrec [Checklist]
ReadPrec Checklist
Int -> ReadS Checklist
ReadS [Checklist]
(Int -> ReadS Checklist)
-> ReadS [Checklist]
-> ReadPrec Checklist
-> ReadPrec [Checklist]
-> Read Checklist
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Checklist
readsPrec :: Int -> ReadS Checklist
$creadList :: ReadS [Checklist]
readList :: ReadS [Checklist]
$creadPrec :: ReadPrec Checklist
readPrec :: ReadPrec Checklist
$creadListPrec :: ReadPrec [Checklist]
readListPrec :: ReadPrec [Checklist]
Read, Checklist -> Checklist -> Bool
(Checklist -> Checklist -> Bool)
-> (Checklist -> Checklist -> Bool) -> Eq Checklist
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Checklist -> Checklist -> Bool
== :: Checklist -> Checklist -> Bool
$c/= :: Checklist -> Checklist -> Bool
/= :: Checklist -> Checklist -> Bool
Eq)

-- | Observation values included in checklists.
data ChecklistObservation =
    ChecklistObservation
      { -- | Species code of the species, e.g. "norfli"
        ChecklistObservation -> SpeciesCode
_checklistObservationSpeciesCode :: SpeciesCode

        -- | The date and time of the observation. It is not clear when this
        -- would not be equal to the 'checklistObsDateTime' field of the enclosing
        -- checklist.
      , ChecklistObservation -> EBirdDateTime
_checklistObservationObsDateTime :: EBirdDateTime

        -- | ID of the observation
      , ChecklistObservation -> Text
_checklistObservationObsId :: Text

        -- | A string representation of the quantity of the observation. If just
        -- the presence is noted, the string will be \"X\"
      , ChecklistObservation -> Text
_checklistObservationHowManyStr :: Text
      }
  deriving (Int -> ChecklistObservation -> ShowS
[ChecklistObservation] -> ShowS
ChecklistObservation -> String
(Int -> ChecklistObservation -> ShowS)
-> (ChecklistObservation -> String)
-> ([ChecklistObservation] -> ShowS)
-> Show ChecklistObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChecklistObservation -> ShowS
showsPrec :: Int -> ChecklistObservation -> ShowS
$cshow :: ChecklistObservation -> String
show :: ChecklistObservation -> String
$cshowList :: [ChecklistObservation] -> ShowS
showList :: [ChecklistObservation] -> ShowS
Show, ReadPrec [ChecklistObservation]
ReadPrec ChecklistObservation
Int -> ReadS ChecklistObservation
ReadS [ChecklistObservation]
(Int -> ReadS ChecklistObservation)
-> ReadS [ChecklistObservation]
-> ReadPrec ChecklistObservation
-> ReadPrec [ChecklistObservation]
-> Read ChecklistObservation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChecklistObservation
readsPrec :: Int -> ReadS ChecklistObservation
$creadList :: ReadS [ChecklistObservation]
readList :: ReadS [ChecklistObservation]
$creadPrec :: ReadPrec ChecklistObservation
readPrec :: ReadPrec ChecklistObservation
$creadListPrec :: ReadPrec [ChecklistObservation]
readListPrec :: ReadPrec [ChecklistObservation]
Read, ChecklistObservation -> ChecklistObservation -> Bool
(ChecklistObservation -> ChecklistObservation -> Bool)
-> (ChecklistObservation -> ChecklistObservation -> Bool)
-> Eq ChecklistObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChecklistObservation -> ChecklistObservation -> Bool
== :: ChecklistObservation -> ChecklistObservation -> Bool
$c/= :: ChecklistObservation -> ChecklistObservation -> Bool
/= :: ChecklistObservation -> ChecklistObservation -> Bool
Eq)

-- | Values included in the 'checklistSubAux' field of 'Checklist's.
data SubAux =
    SubAux
      { -- | Submission ID
        SubAux -> Text
_subAuxSubId :: Text

        -- | E.g. "nocturnal"
      , SubAux -> Text
_subAuxFieldName :: Text

        -- | E.g. "ebird_nocturnal"
      , SubAux -> Text
_subAuxEntryMethodCode :: Text

        -- | E.g. "0"
      , SubAux -> Text
_subAuxAuxCode :: Text
      }
  deriving (Int -> SubAux -> ShowS
[SubAux] -> ShowS
SubAux -> String
(Int -> SubAux -> ShowS)
-> (SubAux -> String) -> ([SubAux] -> ShowS) -> Show SubAux
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubAux -> ShowS
showsPrec :: Int -> SubAux -> ShowS
$cshow :: SubAux -> String
show :: SubAux -> String
$cshowList :: [SubAux] -> ShowS
showList :: [SubAux] -> ShowS
Show, ReadPrec [SubAux]
ReadPrec SubAux
Int -> ReadS SubAux
ReadS [SubAux]
(Int -> ReadS SubAux)
-> ReadS [SubAux]
-> ReadPrec SubAux
-> ReadPrec [SubAux]
-> Read SubAux
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SubAux
readsPrec :: Int -> ReadS SubAux
$creadList :: ReadS [SubAux]
readList :: ReadS [SubAux]
$creadPrec :: ReadPrec SubAux
readPrec :: ReadPrec SubAux
$creadListPrec :: ReadPrec [SubAux]
readListPrec :: ReadPrec [SubAux]
Read, SubAux -> SubAux -> Bool
(SubAux -> SubAux -> Bool)
-> (SubAux -> SubAux -> Bool) -> Eq SubAux
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubAux -> SubAux -> Bool
== :: SubAux -> SubAux -> Bool
$c/= :: SubAux -> SubAux -> Bool
/= :: SubAux -> SubAux -> Bool
Eq)

-- | Values included in the 'checklistSubAuxAI' field of 'Checklist's.
data SubAuxAI =
    SubAuxAI
      { -- | Submission ID
        SubAuxAI -> Text
_subAuxAISubId :: Text

        -- | E.g. "concurrent"
      , SubAuxAI -> Text
_subAuxAIMethod :: Text

        -- | E.g. "sound"
      , SubAuxAI -> Text
_subAuxAIType :: Text

        -- | E.g. "merlin"
      , SubAuxAI -> Text
_subAuxAISource :: Text

        -- | E.g. 0
      , SubAuxAI -> Integer
_subAuxEventId :: Integer
      }
  deriving (Int -> SubAuxAI -> ShowS
[SubAuxAI] -> ShowS
SubAuxAI -> String
(Int -> SubAuxAI -> ShowS)
-> (SubAuxAI -> String) -> ([SubAuxAI] -> ShowS) -> Show SubAuxAI
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SubAuxAI -> ShowS
showsPrec :: Int -> SubAuxAI -> ShowS
$cshow :: SubAuxAI -> String
show :: SubAuxAI -> String
$cshowList :: [SubAuxAI] -> ShowS
showList :: [SubAuxAI] -> ShowS
Show, ReadPrec [SubAuxAI]
ReadPrec SubAuxAI
Int -> ReadS SubAuxAI
ReadS [SubAuxAI]
(Int -> ReadS SubAuxAI)
-> ReadS [SubAuxAI]
-> ReadPrec SubAuxAI
-> ReadPrec [SubAuxAI]
-> Read SubAuxAI
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SubAuxAI
readsPrec :: Int -> ReadS SubAuxAI
$creadList :: ReadS [SubAuxAI]
readList :: ReadS [SubAuxAI]
$creadPrec :: ReadPrec SubAuxAI
readPrec :: ReadPrec SubAuxAI
$creadListPrec :: ReadPrec [SubAuxAI]
readListPrec :: ReadPrec [SubAuxAI]
Read, SubAuxAI -> SubAuxAI -> Bool
(SubAuxAI -> SubAuxAI -> Bool)
-> (SubAuxAI -> SubAuxAI -> Bool) -> Eq SubAuxAI
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SubAuxAI -> SubAuxAI -> Bool
== :: SubAuxAI -> SubAuxAI -> Bool
$c/= :: SubAuxAI -> SubAuxAI -> Bool
/= :: SubAuxAI -> SubAuxAI -> Bool
Eq)

-- | eBird checklists. Note that we do not include some redundant fields of
-- checklist values returned by the API (e.g. @subID@, which is always the same
-- value as @subId@).
data ChecklistFeedEntry =
    ChecklistFeedEntry
      { -- | The location ID of the checklist
        ChecklistFeedEntry -> Text
_checklistFeedEntryLocationId :: Text

        -- | Checklist submission ID
      , ChecklistFeedEntry -> Text
_checklistFeedEntrySubId :: Text

        -- | The display name of the user that submitted this checklist
      , ChecklistFeedEntry -> Text
_checklistFeedEntryUserDisplayName :: Text

        -- | Number of species included on this checklist
      , ChecklistFeedEntry -> Integer
_checklistFeedEntryNumSpecies :: Integer

        -- | Date that this checklist was started
      , ChecklistFeedEntry -> EBirdDate
_checklistFeedEntryDate :: EBirdDate

        -- | Time that this checklist was started
      , ChecklistFeedEntry -> EBirdTime
_checklistFeedEntryTime :: EBirdTime

        -- | Location data for the checklist
      , ChecklistFeedEntry -> LocationData
_checklistFeedEntryLocationData :: LocationData
      }
  deriving (Int -> ChecklistFeedEntry -> ShowS
[ChecklistFeedEntry] -> ShowS
ChecklistFeedEntry -> String
(Int -> ChecklistFeedEntry -> ShowS)
-> (ChecklistFeedEntry -> String)
-> ([ChecklistFeedEntry] -> ShowS)
-> Show ChecklistFeedEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ChecklistFeedEntry -> ShowS
showsPrec :: Int -> ChecklistFeedEntry -> ShowS
$cshow :: ChecklistFeedEntry -> String
show :: ChecklistFeedEntry -> String
$cshowList :: [ChecklistFeedEntry] -> ShowS
showList :: [ChecklistFeedEntry] -> ShowS
Show, ReadPrec [ChecklistFeedEntry]
ReadPrec ChecklistFeedEntry
Int -> ReadS ChecklistFeedEntry
ReadS [ChecklistFeedEntry]
(Int -> ReadS ChecklistFeedEntry)
-> ReadS [ChecklistFeedEntry]
-> ReadPrec ChecklistFeedEntry
-> ReadPrec [ChecklistFeedEntry]
-> Read ChecklistFeedEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS ChecklistFeedEntry
readsPrec :: Int -> ReadS ChecklistFeedEntry
$creadList :: ReadS [ChecklistFeedEntry]
readList :: ReadS [ChecklistFeedEntry]
$creadPrec :: ReadPrec ChecklistFeedEntry
readPrec :: ReadPrec ChecklistFeedEntry
$creadListPrec :: ReadPrec [ChecklistFeedEntry]
readListPrec :: ReadPrec [ChecklistFeedEntry]
Read, ChecklistFeedEntry -> ChecklistFeedEntry -> Bool
(ChecklistFeedEntry -> ChecklistFeedEntry -> Bool)
-> (ChecklistFeedEntry -> ChecklistFeedEntry -> Bool)
-> Eq ChecklistFeedEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ChecklistFeedEntry -> ChecklistFeedEntry -> Bool
== :: ChecklistFeedEntry -> ChecklistFeedEntry -> Bool
$c/= :: ChecklistFeedEntry -> ChecklistFeedEntry -> Bool
/= :: ChecklistFeedEntry -> ChecklistFeedEntry -> Bool
Eq)


-- | eBird checklist or hotspot location data. Note that we do not include some
-- redundant fields of location data values returned by the API (e.g. @locName@,
-- which is always the same value as @name@).
data LocationData =
    LocationData
      { -- | Name of the location
        LocationData -> Text
_locationDataName :: Text

        -- | Latitude of the location
      , LocationData -> Double
_locationDataLatitude :: Double

        -- | Longitude of the location
      , LocationData -> Double
_locationDataLongitude :: Double

        -- | Country code of the location
      , LocationData -> Region
_locationDataCountryCode :: Region

        -- | Country name of the location
      , LocationData -> Text
_locationDataCountryName :: Text

        -- | Subnational1 region that this location is in
      , LocationData -> Region
_locationDataSubnational1Code :: Region

        -- | Name of the subnational1 region that this location is in
      , LocationData -> Text
_locationDataSubnational1Name :: Text

        -- | Subnational2 region that this location is in
      , LocationData -> Region
_locationDataSubnational2Code :: Region

        -- | Name of the subnational2 region that this location is in
      , LocationData -> Text
_locationDataSubnational2Name :: Text

        -- | Is this location an eBird hotspot?
      , LocationData -> Bool
_locationDataIsHotspot:: Bool

        -- | A compound name for the location consisting of the location name,
        -- county name, state name, and country name.
      , LocationData -> Text
_locationDataHeirarchicalName:: Text
      }
  deriving (Int -> LocationData -> ShowS
[LocationData] -> ShowS
LocationData -> String
(Int -> LocationData -> ShowS)
-> (LocationData -> String)
-> ([LocationData] -> ShowS)
-> Show LocationData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LocationData -> ShowS
showsPrec :: Int -> LocationData -> ShowS
$cshow :: LocationData -> String
show :: LocationData -> String
$cshowList :: [LocationData] -> ShowS
showList :: [LocationData] -> ShowS
Show, ReadPrec [LocationData]
ReadPrec LocationData
Int -> ReadS LocationData
ReadS [LocationData]
(Int -> ReadS LocationData)
-> ReadS [LocationData]
-> ReadPrec LocationData
-> ReadPrec [LocationData]
-> Read LocationData
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS LocationData
readsPrec :: Int -> ReadS LocationData
$creadList :: ReadS [LocationData]
readList :: ReadS [LocationData]
$creadPrec :: ReadPrec LocationData
readPrec :: ReadPrec LocationData
$creadListPrec :: ReadPrec [LocationData]
readListPrec :: ReadPrec [LocationData]
Read, LocationData -> LocationData -> Bool
(LocationData -> LocationData -> Bool)
-> (LocationData -> LocationData -> Bool) -> Eq LocationData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LocationData -> LocationData -> Bool
== :: LocationData -> LocationData -> Bool
$c/= :: LocationData -> LocationData -> Bool
/= :: LocationData -> LocationData -> Bool
Eq)

-------------------------------------------------------------------------------
-- * Auxiliary eBird checklist-related API types
-------------------------------------------------------------------------------

-- | How to rank the list returned by the 'Data.EBird.API.Top100API'.
data SortChecklistsBy
      -- | Sort checklists by the date of the observations they contain
    = SortChecklistsByDateCreated

      -- | Sort checklists by the date they were submitted
    | SortChecklistsByDateSubmitted
  deriving (Int -> SortChecklistsBy -> ShowS
[SortChecklistsBy] -> ShowS
SortChecklistsBy -> String
(Int -> SortChecklistsBy -> ShowS)
-> (SortChecklistsBy -> String)
-> ([SortChecklistsBy] -> ShowS)
-> Show SortChecklistsBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortChecklistsBy -> ShowS
showsPrec :: Int -> SortChecklistsBy -> ShowS
$cshow :: SortChecklistsBy -> String
show :: SortChecklistsBy -> String
$cshowList :: [SortChecklistsBy] -> ShowS
showList :: [SortChecklistsBy] -> ShowS
Show, ReadPrec [SortChecklistsBy]
ReadPrec SortChecklistsBy
Int -> ReadS SortChecklistsBy
ReadS [SortChecklistsBy]
(Int -> ReadS SortChecklistsBy)
-> ReadS [SortChecklistsBy]
-> ReadPrec SortChecklistsBy
-> ReadPrec [SortChecklistsBy]
-> Read SortChecklistsBy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SortChecklistsBy
readsPrec :: Int -> ReadS SortChecklistsBy
$creadList :: ReadS [SortChecklistsBy]
readList :: ReadS [SortChecklistsBy]
$creadPrec :: ReadPrec SortChecklistsBy
readPrec :: ReadPrec SortChecklistsBy
$creadListPrec :: ReadPrec [SortChecklistsBy]
readListPrec :: ReadPrec [SortChecklistsBy]
Read, SortChecklistsBy -> SortChecklistsBy -> Bool
(SortChecklistsBy -> SortChecklistsBy -> Bool)
-> (SortChecklistsBy -> SortChecklistsBy -> Bool)
-> Eq SortChecklistsBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortChecklistsBy -> SortChecklistsBy -> Bool
== :: SortChecklistsBy -> SortChecklistsBy -> Bool
$c/= :: SortChecklistsBy -> SortChecklistsBy -> Bool
/= :: SortChecklistsBy -> SortChecklistsBy -> Bool
Eq)

-------------------------------------------------------------------------------
-- * Optics for checklist types
-------------------------------------------------------------------------------

makeLenses ''Checklist
makeFieldLabels ''Checklist
makeLenses ''ChecklistObservation
makeFieldLabels ''ChecklistObservation
makeLenses ''SubAux
makeFieldLabels ''SubAux
makeLenses ''SubAuxAI
makeFieldLabels ''SubAuxAI
makeLenses ''ChecklistFeedEntry
makeFieldLabels ''ChecklistFeedEntry
makeLenses ''LocationData
makeFieldLabels ''LocationData

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

-- | Explicit instance for compatibility with their field names
instance FromJSON Checklist where
  parseJSON :: Value -> Parser Checklist
parseJSON = String -> (Object -> Parser Checklist) -> Value -> Parser Checklist
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Checklist" ((Object -> Parser Checklist) -> Value -> Parser Checklist)
-> (Object -> Parser Checklist) -> Value -> Parser Checklist
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Text
-> Text
-> Text
-> Maybe Double
-> Bool
-> EBirdDateTime
-> EBirdDateTime
-> EBirdDateTime
-> Bool
-> Text
-> Integer
-> Maybe Double
-> Maybe Text
-> Region
-> Text
-> Text
-> Text
-> Text
-> Integer
-> [SubAux]
-> [SubAuxAI]
-> [ChecklistObservation]
-> Checklist
Checklist
        (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> Maybe Double
 -> Bool
 -> EBirdDateTime
 -> EBirdDateTime
 -> EBirdDateTime
 -> Bool
 -> Text
 -> Integer
 -> Maybe Double
 -> Maybe Text
 -> Region
 -> Text
 -> Text
 -> Text
 -> Text
 -> Integer
 -> [SubAux]
 -> [SubAuxAI]
 -> [ChecklistObservation]
 -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Maybe Double
      -> Bool
      -> EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"projId"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> Maybe Double
   -> Bool
   -> EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Maybe Double
      -> Bool
      -> EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"subId"
        Parser
  (Text
   -> Text
   -> Text
   -> Maybe Double
   -> Bool
   -> EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Maybe Double
      -> Bool
      -> EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"protocolId"
        Parser
  (Text
   -> Text
   -> Maybe Double
   -> Bool
   -> EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Maybe Double
      -> Bool
      -> EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"locId"
        Parser
  (Text
   -> Maybe Double
   -> Bool
   -> EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Maybe Double
      -> Bool
      -> EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"groupId"
        Parser
  (Maybe Double
   -> Bool
   -> EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser (Maybe Double)
-> Parser
     (Bool
      -> EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"durationHrs"
        Parser
  (Bool
   -> EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Bool
-> Parser
     (EBirdDateTime
      -> EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"allObsReported"
        Parser
  (EBirdDateTime
   -> EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser EBirdDateTime
-> Parser
     (EBirdDateTime
      -> EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 EBirdDateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"creationDt"
        Parser
  (EBirdDateTime
   -> EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser EBirdDateTime
-> Parser
     (EBirdDateTime
      -> Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 EBirdDateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lastEditedDt"
        Parser
  (EBirdDateTime
   -> Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser EBirdDateTime
-> Parser
     (Bool
      -> Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 EBirdDateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obsDt"
        Parser
  (Bool
   -> Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Bool
-> Parser
     (Text
      -> Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obsTimeValid"
        Parser
  (Text
   -> Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Integer
      -> Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"checklistId"
        Parser
  (Integer
   -> Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Integer
-> Parser
     (Maybe Double
      -> Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"numObservers"
        Parser
  (Maybe Double
   -> Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser (Maybe Double)
-> Parser
     (Maybe Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 Double)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"effortDistanceKm"
        Parser
  (Maybe Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser (Maybe Text)
-> Parser
     (Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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 Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"effortDistanceEnteredUnit"
        Parser
  (Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Region
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
  (Text
   -> Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"submissionMethodCode"
        Parser
  (Text
   -> Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"submissionMethodVersion"
        Parser
  (Text
   -> Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Text
      -> Integer
      -> [SubAux]
      -> [SubAuxAI]
      -> [ChecklistObservation]
      -> Checklist)
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
"submissionMethodVersionDisp"
        Parser
  (Text
   -> Integer
   -> [SubAux]
   -> [SubAuxAI]
   -> [ChecklistObservation]
   -> Checklist)
-> Parser Text
-> Parser
     (Integer
      -> [SubAux] -> [SubAuxAI] -> [ChecklistObservation] -> Checklist)
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
   -> [SubAux] -> [SubAuxAI] -> [ChecklistObservation] -> Checklist)
-> Parser Integer
-> Parser
     ([SubAux] -> [SubAuxAI] -> [ChecklistObservation] -> Checklist)
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
  ([SubAux] -> [SubAuxAI] -> [ChecklistObservation] -> Checklist)
-> Parser [SubAux]
-> Parser ([SubAuxAI] -> [ChecklistObservation] -> Checklist)
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 [SubAux]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subAux"
        Parser ([SubAuxAI] -> [ChecklistObservation] -> Checklist)
-> Parser [SubAuxAI]
-> Parser ([ChecklistObservation] -> Checklist)
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 [SubAuxAI]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"subAuxAi"
        Parser ([ChecklistObservation] -> Checklist)
-> Parser [ChecklistObservation] -> Parser Checklist
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 [ChecklistObservation]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obs"

-- | Explicit instance for compatibility with their field names
instance ToJSON Checklist where
  toJSON :: Checklist -> Value
toJSON Checklist{Bool
Integer
[SubAuxAI]
[SubAux]
[ChecklistObservation]
Maybe Double
Maybe Text
Text
Region
EBirdDateTime
_checklistProjectId :: Checklist -> Text
_checklistSubId :: Checklist -> Text
_checklistProtocolId :: Checklist -> Text
_checklistLocationId :: Checklist -> Text
_checklistGroupId :: Checklist -> Text
_checklistDurationHours :: Checklist -> Maybe Double
_checklistAllObsReported :: Checklist -> Bool
_checklistCreationDateTime :: Checklist -> EBirdDateTime
_checklistLastEditedDateTime :: Checklist -> EBirdDateTime
_checklistObsDateTime :: Checklist -> EBirdDateTime
_checklistObsTimeValid :: Checklist -> Bool
_checklistChecklistId :: Checklist -> Text
_checklistNumObservers :: Checklist -> Integer
_checklistEffortDistanceKm :: Checklist -> Maybe Double
_checklistEffortDistanceEnteredUnit :: Checklist -> Maybe Text
_checklistSubnational1Code :: Checklist -> Region
_checklistSubmissionMethodCode :: Checklist -> Text
_checklistSubmissionMethodVersion :: Checklist -> Text
_checklistSubmissionMethodVersionDisp :: Checklist -> Text
_checklistUserDisplayName :: Checklist -> Text
_checklistNumSpecies :: Checklist -> Integer
_checklistSubAux :: Checklist -> [SubAux]
_checklistSubAuxAI :: Checklist -> [SubAuxAI]
_checklistObs :: Checklist -> [ChecklistObservation]
_checklistProjectId :: Text
_checklistSubId :: Text
_checklistProtocolId :: Text
_checklistLocationId :: Text
_checklistGroupId :: Text
_checklistDurationHours :: Maybe Double
_checklistAllObsReported :: Bool
_checklistCreationDateTime :: EBirdDateTime
_checklistLastEditedDateTime :: EBirdDateTime
_checklistObsDateTime :: EBirdDateTime
_checklistObsTimeValid :: Bool
_checklistChecklistId :: Text
_checklistNumObservers :: Integer
_checklistEffortDistanceKm :: Maybe Double
_checklistEffortDistanceEnteredUnit :: Maybe Text
_checklistSubnational1Code :: Region
_checklistSubmissionMethodCode :: Text
_checklistSubmissionMethodVersion :: Text
_checklistSubmissionMethodVersionDisp :: Text
_checklistUserDisplayName :: Text
_checklistNumSpecies :: Integer
_checklistSubAux :: [SubAux]
_checklistSubAuxAI :: [SubAuxAI]
_checklistObs :: [ChecklistObservation]
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"projId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistProjectId
        , Key
"subId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistSubId
        , Key
"protocolId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistProtocolId
        , Key
"locId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistLocationId
        , Key
"groupId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistGroupId
        , Key
"allObsReported" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_checklistAllObsReported
        , Key
"creationDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
_checklistCreationDateTime
        , Key
"lastEditedDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
_checklistLastEditedDateTime
        , Key
"obsDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
_checklistObsDateTime
        , Key
"obsTimeValid" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_checklistObsTimeValid
        , Key
"checklistId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistChecklistId
        , Key
"numObservers" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_checklistNumObservers
        , Key
"subnational1Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_checklistSubnational1Code
        , Key
"submissionMethodCode" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistSubmissionMethodCode
        , Key
"submissionMethodVersion" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistSubmissionMethodVersion
        , Key
"submissionMethodVersionDisp" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistSubmissionMethodVersionDisp
        , Key
"userDisplayName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistUserDisplayName
        , Key
"numSpecies" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_checklistNumSpecies
        , Key
"subAux" Key -> [SubAux] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [SubAux]
_checklistSubAux
        , Key
"subAuxAi" Key -> [SubAuxAI] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [SubAuxAI]
_checklistSubAuxAI
        , Key
"obs" Key -> [ChecklistObservation] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [ChecklistObservation]
_checklistObs
        ]
        -- Fields that may or may not be included, depending on the observation
        -- data
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"durationHrs" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
duration
           | Just Double
duration <- [Maybe Double
_checklistDurationHours]
           ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"effortDistanceKm" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
distance
           | Just Double
distance <- [Maybe Double
_checklistEffortDistanceKm]
           ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"effortDistanceEnteredUnit" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
unit
           | Just Text
unit <- [Maybe Text
_checklistEffortDistanceEnteredUnit]
           ]

-- | Explicit instance for compatibility with their field names
instance FromJSON ChecklistObservation where
  parseJSON :: Value -> Parser ChecklistObservation
parseJSON = String
-> (Object -> Parser ChecklistObservation)
-> Value
-> Parser ChecklistObservation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ChecklistObservation" ((Object -> Parser ChecklistObservation)
 -> Value -> Parser ChecklistObservation)
-> (Object -> Parser ChecklistObservation)
-> Value
-> Parser ChecklistObservation
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      SpeciesCode
-> EBirdDateTime -> Text -> Text -> ChecklistObservation
ChecklistObservation
        (SpeciesCode
 -> EBirdDateTime -> Text -> Text -> ChecklistObservation)
-> Parser SpeciesCode
-> Parser (EBirdDateTime -> Text -> Text -> ChecklistObservation)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser SpeciesCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"speciesCode"
        Parser (EBirdDateTime -> Text -> Text -> ChecklistObservation)
-> Parser EBirdDateTime
-> Parser (Text -> Text -> ChecklistObservation)
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 EBirdDateTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obsDt"
        Parser (Text -> Text -> ChecklistObservation)
-> Parser Text -> Parser (Text -> ChecklistObservation)
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
"obsId"
        Parser (Text -> ChecklistObservation)
-> Parser Text -> Parser ChecklistObservation
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
"howManyStr"

-- | Explicit instance for compatibility with their field names
instance ToJSON ChecklistObservation where
  toJSON :: ChecklistObservation -> Value
toJSON ChecklistObservation{Text
SpeciesCode
EBirdDateTime
_checklistObservationSpeciesCode :: ChecklistObservation -> SpeciesCode
_checklistObservationObsDateTime :: ChecklistObservation -> EBirdDateTime
_checklistObservationObsId :: ChecklistObservation -> Text
_checklistObservationHowManyStr :: ChecklistObservation -> Text
_checklistObservationSpeciesCode :: SpeciesCode
_checklistObservationObsDateTime :: EBirdDateTime
_checklistObservationObsId :: Text
_checklistObservationHowManyStr :: Text
..} =
      [Pair] -> Value
object
        [ Key
"speciesCode" Key -> SpeciesCode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SpeciesCode
_checklistObservationSpeciesCode
        , Key
"obsDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
_checklistObservationObsDateTime
        , Key
"obsId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistObservationObsId
        , Key
"howManyStr" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistObservationHowManyStr
        ]

-- | Explicit instance for compatibility with their field names
instance FromJSON SubAux where
  parseJSON :: Value -> Parser SubAux
parseJSON = String -> (Object -> Parser SubAux) -> Value -> Parser SubAux
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SubAux" ((Object -> Parser SubAux) -> Value -> Parser SubAux)
-> (Object -> Parser SubAux) -> Value -> Parser SubAux
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text -> Text -> Text -> Text -> SubAux
SubAux
        (Text -> Text -> Text -> Text -> SubAux)
-> Parser Text -> Parser (Text -> Text -> Text -> SubAux)
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
"subId"
        Parser (Text -> Text -> Text -> SubAux)
-> Parser Text -> Parser (Text -> Text -> SubAux)
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
"fieldName"
        Parser (Text -> Text -> SubAux)
-> Parser Text -> Parser (Text -> SubAux)
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
"entryMethodCode"
        Parser (Text -> SubAux) -> Parser Text -> Parser SubAux
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
"auxCode"

-- | Explicit instance for compatibility with their field names
instance ToJSON SubAux where
  toJSON :: SubAux -> Value
toJSON SubAux{Text
_subAuxSubId :: SubAux -> Text
_subAuxFieldName :: SubAux -> Text
_subAuxEntryMethodCode :: SubAux -> Text
_subAuxAuxCode :: SubAux -> Text
_subAuxSubId :: Text
_subAuxFieldName :: Text
_subAuxEntryMethodCode :: Text
_subAuxAuxCode :: Text
..} =
      [Pair] -> Value
object
        [ Key
"subId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxSubId
        , Key
"fieldName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxFieldName
        , Key
"entryMethodCode" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxEntryMethodCode
        , Key
"auxCode" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxAuxCode
        ]

-- | Explicit instance for compatibility with their field names
instance FromJSON SubAuxAI where
  parseJSON :: Value -> Parser SubAuxAI
parseJSON = String -> (Object -> Parser SubAuxAI) -> Value -> Parser SubAuxAI
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SubAuxAI" ((Object -> Parser SubAuxAI) -> Value -> Parser SubAuxAI)
-> (Object -> Parser SubAuxAI) -> Value -> Parser SubAuxAI
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text -> Text -> Text -> Text -> Integer -> SubAuxAI
SubAuxAI
        (Text -> Text -> Text -> Text -> Integer -> SubAuxAI)
-> Parser Text
-> Parser (Text -> Text -> Text -> Integer -> SubAuxAI)
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
"subId"
        Parser (Text -> Text -> Text -> Integer -> SubAuxAI)
-> Parser Text -> Parser (Text -> Text -> Integer -> SubAuxAI)
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
"method"
        Parser (Text -> Text -> Integer -> SubAuxAI)
-> Parser Text -> Parser (Text -> Integer -> SubAuxAI)
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
"aiType"
        Parser (Text -> Integer -> SubAuxAI)
-> Parser Text -> Parser (Integer -> SubAuxAI)
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
"source"
        Parser (Integer -> SubAuxAI) -> Parser Integer -> Parser SubAuxAI
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
"eventId"

-- | Explicit instance for compatibility with their field names
instance ToJSON SubAuxAI where
  toJSON :: SubAuxAI -> Value
toJSON SubAuxAI{Integer
Text
_subAuxAISubId :: SubAuxAI -> Text
_subAuxAIMethod :: SubAuxAI -> Text
_subAuxAIType :: SubAuxAI -> Text
_subAuxAISource :: SubAuxAI -> Text
_subAuxEventId :: SubAuxAI -> Integer
_subAuxAISubId :: Text
_subAuxAIMethod :: Text
_subAuxAIType :: Text
_subAuxAISource :: Text
_subAuxEventId :: Integer
..} =
      [Pair] -> Value
object
        [ Key
"subId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxAISubId
        , Key
"method" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxAIMethod
        , Key
"aiType" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_subAuxAIType
        , Key
"eventId" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_subAuxEventId
        ]

-- | Explicit instance for compatibility with their field names
instance FromJSON ChecklistFeedEntry where
  parseJSON :: Value -> Parser ChecklistFeedEntry
parseJSON = String
-> (Object -> Parser ChecklistFeedEntry)
-> Value
-> Parser ChecklistFeedEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"ChecklistFeedEntry" ((Object -> Parser ChecklistFeedEntry)
 -> Value -> Parser ChecklistFeedEntry)
-> (Object -> Parser ChecklistFeedEntry)
-> Value
-> Parser ChecklistFeedEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Text
-> Integer
-> EBirdDate
-> EBirdTime
-> LocationData
-> ChecklistFeedEntry
ChecklistFeedEntry
        (Text
 -> Text
 -> Text
 -> Integer
 -> EBirdDate
 -> EBirdTime
 -> LocationData
 -> ChecklistFeedEntry)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Integer
      -> EBirdDate
      -> EBirdTime
      -> LocationData
      -> ChecklistFeedEntry)
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
   -> Text
   -> Integer
   -> EBirdDate
   -> EBirdTime
   -> LocationData
   -> ChecklistFeedEntry)
-> Parser Text
-> Parser
     (Text
      -> Integer
      -> EBirdDate
      -> EBirdTime
      -> LocationData
      -> ChecklistFeedEntry)
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
"subId"
        Parser
  (Text
   -> Integer
   -> EBirdDate
   -> EBirdTime
   -> LocationData
   -> ChecklistFeedEntry)
-> Parser Text
-> Parser
     (Integer
      -> EBirdDate -> EBirdTime -> LocationData -> ChecklistFeedEntry)
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
   -> EBirdDate -> EBirdTime -> LocationData -> ChecklistFeedEntry)
-> Parser Integer
-> Parser
     (EBirdDate -> EBirdTime -> LocationData -> ChecklistFeedEntry)
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
  (EBirdDate -> EBirdTime -> LocationData -> ChecklistFeedEntry)
-> Parser EBirdDate
-> Parser (EBirdTime -> LocationData -> ChecklistFeedEntry)
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 EBirdDate
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obsDt"
        Parser (EBirdTime -> LocationData -> ChecklistFeedEntry)
-> Parser EBirdTime -> Parser (LocationData -> ChecklistFeedEntry)
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 EBirdTime
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"obsTime"
        Parser (LocationData -> ChecklistFeedEntry)
-> Parser LocationData -> Parser ChecklistFeedEntry
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 LocationData
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"loc"

-- | Explicit instance for compatibility with their field names
instance ToJSON ChecklistFeedEntry where
  toJSON :: ChecklistFeedEntry -> Value
toJSON ChecklistFeedEntry{Integer
Text
EBirdTime
EBirdDate
LocationData
_checklistFeedEntryLocationId :: ChecklistFeedEntry -> Text
_checklistFeedEntrySubId :: ChecklistFeedEntry -> Text
_checklistFeedEntryUserDisplayName :: ChecklistFeedEntry -> Text
_checklistFeedEntryNumSpecies :: ChecklistFeedEntry -> Integer
_checklistFeedEntryDate :: ChecklistFeedEntry -> EBirdDate
_checklistFeedEntryTime :: ChecklistFeedEntry -> EBirdTime
_checklistFeedEntryLocationData :: ChecklistFeedEntry -> LocationData
_checklistFeedEntryLocationId :: Text
_checklistFeedEntrySubId :: Text
_checklistFeedEntryUserDisplayName :: Text
_checklistFeedEntryNumSpecies :: Integer
_checklistFeedEntryDate :: EBirdDate
_checklistFeedEntryTime :: EBirdTime
_checklistFeedEntryLocationData :: LocationData
..} =
      [Pair] -> Value
object
        [ Key
"locId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistFeedEntryLocationId
        , Key
"subId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistFeedEntrySubId
        , Key
"userDisplayName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_checklistFeedEntryUserDisplayName
        , Key
"numSpecies" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_checklistFeedEntryNumSpecies
        , Key
"obsDt" Key -> EBirdDate -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDate
_checklistFeedEntryDate
        , Key
"obsTime" Key -> EBirdTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdTime
_checklistFeedEntryTime
        , Key
"loc" Key -> LocationData -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= LocationData
_checklistFeedEntryLocationData
        ]

-- | Explicit instance for compatibility with their field names
instance FromJSON LocationData where
  parseJSON :: Value -> Parser LocationData
parseJSON = String
-> (Object -> Parser LocationData) -> Value -> Parser LocationData
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"LocationData" ((Object -> Parser LocationData) -> Value -> Parser LocationData)
-> (Object -> Parser LocationData) -> Value -> Parser LocationData
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Double
-> Double
-> Region
-> Text
-> Region
-> Text
-> Region
-> Text
-> Bool
-> Text
-> LocationData
LocationData
        (Text
 -> Double
 -> Double
 -> Region
 -> Text
 -> Region
 -> Text
 -> Region
 -> Text
 -> Bool
 -> Text
 -> LocationData)
-> Parser Text
-> Parser
     (Double
      -> Double
      -> Region
      -> Text
      -> Region
      -> Text
      -> Region
      -> Text
      -> Bool
      -> Text
      -> LocationData)
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
"name"
        Parser
  (Double
   -> Double
   -> Region
   -> Text
   -> Region
   -> Text
   -> Region
   -> Text
   -> Bool
   -> Text
   -> LocationData)
-> Parser Double
-> Parser
     (Double
      -> Region
      -> Text
      -> Region
      -> Text
      -> Region
      -> Text
      -> Bool
      -> Text
      -> LocationData)
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
"latitude"
        Parser
  (Double
   -> Region
   -> Text
   -> Region
   -> Text
   -> Region
   -> Text
   -> Bool
   -> Text
   -> LocationData)
-> Parser Double
-> Parser
     (Region
      -> Text
      -> Region
      -> Text
      -> Region
      -> Text
      -> Bool
      -> Text
      -> LocationData)
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
"longitude"
        Parser
  (Region
   -> Text
   -> Region
   -> Text
   -> Region
   -> Text
   -> Bool
   -> Text
   -> LocationData)
-> Parser Region
-> Parser
     (Text
      -> Region
      -> Text
      -> Region
      -> Text
      -> Bool
      -> Text
      -> LocationData)
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
  (Text
   -> Region
   -> Text
   -> Region
   -> Text
   -> Bool
   -> Text
   -> LocationData)
-> Parser Text
-> Parser
     (Region -> Text -> Region -> Text -> Bool -> Text -> LocationData)
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
"countryName"
        Parser
  (Region -> Text -> Region -> Text -> Bool -> Text -> LocationData)
-> Parser Region
-> Parser (Text -> Region -> Text -> Bool -> Text -> LocationData)
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 (Text -> Region -> Text -> Bool -> Text -> LocationData)
-> Parser Text
-> Parser (Region -> Text -> Bool -> Text -> LocationData)
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
"subnational1Name"
        Parser (Region -> Text -> Bool -> Text -> LocationData)
-> Parser Region -> Parser (Text -> Bool -> Text -> LocationData)
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 (Text -> Bool -> Text -> LocationData)
-> Parser Text -> Parser (Bool -> Text -> LocationData)
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
"subnational2Name"
        Parser (Bool -> Text -> LocationData)
-> Parser Bool -> Parser (Text -> LocationData)
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 Bool
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"isHotspot"
        Parser (Text -> LocationData) -> Parser Text -> Parser LocationData
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
"hierarchicalName"

-- | Explicit instance for compatibility with their field names
instance ToJSON LocationData where
  toJSON :: LocationData -> Value
toJSON LocationData{Bool
Double
Text
Region
_locationDataName :: LocationData -> Text
_locationDataLatitude :: LocationData -> Double
_locationDataLongitude :: LocationData -> Double
_locationDataCountryCode :: LocationData -> Region
_locationDataCountryName :: LocationData -> Text
_locationDataSubnational1Code :: LocationData -> Region
_locationDataSubnational1Name :: LocationData -> Text
_locationDataSubnational2Code :: LocationData -> Region
_locationDataSubnational2Name :: LocationData -> Text
_locationDataIsHotspot :: LocationData -> Bool
_locationDataHeirarchicalName :: LocationData -> Text
_locationDataName :: Text
_locationDataLatitude :: Double
_locationDataLongitude :: Double
_locationDataCountryCode :: Region
_locationDataCountryName :: Text
_locationDataSubnational1Code :: Region
_locationDataSubnational1Name :: Text
_locationDataSubnational2Code :: Region
_locationDataSubnational2Name :: Text
_locationDataIsHotspot :: Bool
_locationDataHeirarchicalName :: Text
..} =
      [Pair] -> Value
object
        [ Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_locationDataName
        , Key
"latitude" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_locationDataLatitude
        , Key
"longitude" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_locationDataLongitude
        , Key
"countryCode" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_locationDataCountryCode
        , Key
"countryName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_locationDataCountryName
        , Key
"subnational1Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_locationDataSubnational1Code
        , Key
"subnational1Name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_locationDataSubnational1Name
        , Key
"subnational2Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_locationDataSubnational2Code
        , Key
"subnational2Name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_locationDataSubnational2Name
        , Key
"isHotspot" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_locationDataIsHotspot
        , Key
"hierarchicalName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_locationDataHeirarchicalName
        ]

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

-- | The eBird string for a 'SortChecklistsBy' value is either "obs_dt" or
-- "creation_dt".
instance EBirdString SortChecklistsBy where
  toEBirdString :: SortChecklistsBy -> Text
toEBirdString =
      \case
        SortChecklistsBy
SortChecklistsByDateCreated -> Text
"obs_dt"
        SortChecklistsBy
SortChecklistsByDateSubmitted -> Text
"creation_dt"

  fromEBirdString :: Text -> Either Text SortChecklistsBy
fromEBirdString Text
str =
        Parser SortChecklistsBy -> Text -> Either String SortChecklistsBy
forall a. Parser a -> Text -> Either String a
parseOnly Parser SortChecklistsBy
parseSortChecklistsBy Text
str
      Either String SortChecklistsBy
-> (Either String SortChecklistsBy -> Either Text SortChecklistsBy)
-> Either Text SortChecklistsBy
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String SortChecklistsBy -> Either Text SortChecklistsBy
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 SortChecklistsBy: " 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 isntances
-------------------------------------------------------------------------------

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

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

-- | Parse a 'SortChecklistsBy' value
parseSortChecklistsBy :: Parser SortChecklistsBy
parseSortChecklistsBy :: Parser SortChecklistsBy
parseSortChecklistsBy =
    [Parser SortChecklistsBy] -> Parser SortChecklistsBy
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"obs_dt" Parser Text Text -> SortChecklistsBy -> Parser SortChecklistsBy
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SortChecklistsBy
SortChecklistsByDateCreated
      , Parser Text Text
"creation_dt" Parser Text Text -> SortChecklistsBy -> Parser SortChecklistsBy
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SortChecklistsBy
SortChecklistsByDateSubmitted
      ]
  where
    _casesCovered :: SortChecklistsBy -> ()
    _casesCovered :: SortChecklistsBy -> ()
_casesCovered =
      \case
        SortChecklistsBy
SortChecklistsByDateCreated -> ()
        SortChecklistsBy
SortChecklistsByDateSubmitted -> ()

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

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