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


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

module Data.EBird.API.Observations where

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

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

-------------------------------------------------------------------------------
-- * Observation types
-------------------------------------------------------------------------------

-- | An observation of a species submitted to eBird within a checklist. The
-- 'DetailLevel' index indicates whether the observation data includes "full"
-- details.
data Observation (detail :: DetailLevel) =
    Observation
      { -- | Species code, e.g. "bohwax"
        forall (detail :: DetailLevel). Observation detail -> Text
_observationSpeciesCode :: Text

        -- | Common name, e.g. "Bohemian Waxwing"
      , forall (detail :: DetailLevel). Observation detail -> Text
_observationCommonName :: Text

        -- | Scientific name, e.g. "Bombycilla garrulus"
      , forall (detail :: DetailLevel). Observation detail -> Text
_observationScientificName :: Text

        -- | Location ID, e.g. \"L7884500\"
      , forall (detail :: DetailLevel). Observation detail -> Text
_observationLocationId :: Text

        -- | Location name, e.g. "Frog Pond"
      , forall (detail :: DetailLevel). Observation detail -> Text
_observationLocationName :: Text

        -- | Date and time of observation
      , forall (detail :: DetailLevel). Observation detail -> EBirdDateTime
_observationDateTime :: EBirdDateTime

        -- | How many were seen? Sometimes omitted.
      , forall (detail :: DetailLevel). Observation detail -> Maybe Integer
_observationHowMany :: Maybe Integer

        -- | Observation latitude
      , forall (detail :: DetailLevel). Observation detail -> Double
_observationLatitude :: Double

        -- | Observation longitude
      , forall (detail :: DetailLevel). Observation detail -> Double
_observationLongitude :: Double

        -- | Is this observation valid?
      , forall (detail :: DetailLevel). Observation detail -> Bool
_observationValid :: Bool

        -- | Has this observation been reviewed?
      , forall (detail :: DetailLevel). Observation detail -> Bool
_observationReviewed :: Bool

        -- | Is the location of this observation private?
      , forall (detail :: DetailLevel). Observation detail -> Bool
_observationLocationPrivate :: Bool

        -- | Submission ID
      , forall (detail :: DetailLevel). Observation detail -> Text
_observationSubId :: Text

      , forall (detail :: DetailLevel).
Observation detail -> ObservationDetails detail
_observationFullDetail :: ObservationDetails detail
      }

deriving instance Show (Observation 'Simple)
deriving instance Show (Observation 'Full)
deriving instance Eq (Observation 'Simple)
deriving instance Eq (Observation 'Full)

-- | Extra details that may be attached to an observation. At the moment, it
-- only seems possible to get 'Full' detailed observations from the notable
-- observation endpoints (e.g. 'Data.EBird.API.RecentNotableObservationsAPI').
data ObservationDetails (detail :: DetailLevel) where
    NoDetails :: ObservationDetails 'Simple
    FullDetails ::
      { -- | The subnational2 region that this observation took place in
        ObservationDetails 'Full -> Region
_observationDetailsSubnational2Code :: Region

        -- | The name of the subnational2 region that this observation took
        -- place in
      , ObservationDetails 'Full -> Text
_observationDetailsSubnational2Name :: Text

        -- | The subnational1 region that this observation took place in
      , ObservationDetails 'Full -> Region
_observationDetailsSubnational1Code :: Region

        -- | The name of the subnational1 region that this observation took
        -- place in
      , ObservationDetails 'Full -> Text
_observationDetailsSubnational1Name :: Text

        -- | The country region that this observation took place in
      , ObservationDetails 'Full -> Region
_observationDetailsCountryCode :: Region

        -- | The name of the country region that this observation took place in
      , ObservationDetails 'Full -> Text
_observationDetailsCountryName :: Text

        -- | The display name of the user that submitted this observation
      , ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: Text

        -- | The unique ID of this observation
      , ObservationDetails 'Full -> Text
_observationDetailsObsId :: Text

        -- | The ID of the checklist that this observation was submitted with,
        -- e.g. \"CL24936\"
      , ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: Text

        -- | Whether the count for the observation was provided as just \"X\"
      , ObservationDetails 'Full -> Bool
_observationDetailsPresenceNoted :: Bool

        -- | Whether this observation was submitted with comments
      , ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: Bool

        -- | The last name of the user that submitted this observation
      , ObservationDetails 'Full -> Text
_observationDetailsLastName :: Text

        -- | The first name of the user that submitted this observation
      , ObservationDetails 'Full -> Text
_observationDetailsFirstName :: Text

        -- | Whether this observation has media such as photos, videos, or
        -- audio attached
      , ObservationDetails 'Full -> Bool
_observationDetailsHasRichMedia :: Bool
      } -> ObservationDetails 'Full

deriving instance Show (ObservationDetails 'Simple)
deriving instance Show (ObservationDetails 'Full)
deriving instance Eq (ObservationDetails 'Simple)
deriving instance Eq (ObservationDetails 'Full)

-- | 'Observation' values of existentially quantified detail.
data SomeObservation where
    SomeObservation :: Observation detail -> SomeObservation

instance Show SomeObservation where
  show :: SomeObservation -> String
show (SomeObservation Observation detail
o) =
      case Observation detail -> ObservationDetails detail
forall (detail :: DetailLevel).
Observation detail -> ObservationDetails detail
_observationFullDetail Observation detail
o of
        ObservationDetails detail
NoDetails -> Observation detail -> String
forall a. Show a => a -> String
show Observation detail
o
        FullDetails{} -> Observation detail -> String
forall a. Show a => a -> String
show Observation detail
o

-------------------------------------------------------------------------------
-- * Auxiliary eBird observation API types
-------------------------------------------------------------------------------

-- | The promoted constructors of this type are used as type-level indices on
-- the 'Observation' type to determine whether an observation is 'Simple' detail
-- or 'Full' detail.
data DetailLevel = Simple | Full
  deriving (Int -> DetailLevel -> ShowS
[DetailLevel] -> ShowS
DetailLevel -> String
(Int -> DetailLevel -> ShowS)
-> (DetailLevel -> String)
-> ([DetailLevel] -> ShowS)
-> Show DetailLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> DetailLevel -> ShowS
showsPrec :: Int -> DetailLevel -> ShowS
$cshow :: DetailLevel -> String
show :: DetailLevel -> String
$cshowList :: [DetailLevel] -> ShowS
showList :: [DetailLevel] -> ShowS
Show, ReadPrec [DetailLevel]
ReadPrec DetailLevel
Int -> ReadS DetailLevel
ReadS [DetailLevel]
(Int -> ReadS DetailLevel)
-> ReadS [DetailLevel]
-> ReadPrec DetailLevel
-> ReadPrec [DetailLevel]
-> Read DetailLevel
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS DetailLevel
readsPrec :: Int -> ReadS DetailLevel
$creadList :: ReadS [DetailLevel]
readList :: ReadS [DetailLevel]
$creadPrec :: ReadPrec DetailLevel
readPrec :: ReadPrec DetailLevel
$creadListPrec :: ReadPrec [DetailLevel]
readListPrec :: ReadPrec [DetailLevel]
Read, DetailLevel -> DetailLevel -> Bool
(DetailLevel -> DetailLevel -> Bool)
-> (DetailLevel -> DetailLevel -> Bool) -> Eq DetailLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: DetailLevel -> DetailLevel -> Bool
== :: DetailLevel -> DetailLevel -> Bool
$c/= :: DetailLevel -> DetailLevel -> Bool
/= :: DetailLevel -> DetailLevel -> Bool
Eq)

-- | Values representing the ways that observations may be sorted in responses
-- from the API.
data SortObservationsBy
    = SortObservationsByDate
    | SortObservationsBySpecies
  deriving (Int -> SortObservationsBy -> ShowS
[SortObservationsBy] -> ShowS
SortObservationsBy -> String
(Int -> SortObservationsBy -> ShowS)
-> (SortObservationsBy -> String)
-> ([SortObservationsBy] -> ShowS)
-> Show SortObservationsBy
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SortObservationsBy -> ShowS
showsPrec :: Int -> SortObservationsBy -> ShowS
$cshow :: SortObservationsBy -> String
show :: SortObservationsBy -> String
$cshowList :: [SortObservationsBy] -> ShowS
showList :: [SortObservationsBy] -> ShowS
Show, ReadPrec [SortObservationsBy]
ReadPrec SortObservationsBy
Int -> ReadS SortObservationsBy
ReadS [SortObservationsBy]
(Int -> ReadS SortObservationsBy)
-> ReadS [SortObservationsBy]
-> ReadPrec SortObservationsBy
-> ReadPrec [SortObservationsBy]
-> Read SortObservationsBy
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SortObservationsBy
readsPrec :: Int -> ReadS SortObservationsBy
$creadList :: ReadS [SortObservationsBy]
readList :: ReadS [SortObservationsBy]
$creadPrec :: ReadPrec SortObservationsBy
readPrec :: ReadPrec SortObservationsBy
$creadListPrec :: ReadPrec [SortObservationsBy]
readListPrec :: ReadPrec [SortObservationsBy]
Read, SortObservationsBy -> SortObservationsBy -> Bool
(SortObservationsBy -> SortObservationsBy -> Bool)
-> (SortObservationsBy -> SortObservationsBy -> Bool)
-> Eq SortObservationsBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SortObservationsBy -> SortObservationsBy -> Bool
== :: SortObservationsBy -> SortObservationsBy -> Bool
$c/= :: SortObservationsBy -> SortObservationsBy -> Bool
/= :: SortObservationsBy -> SortObservationsBy -> Bool
Eq)

-- | Values representing how to pick which 'Observation's are returned from the
-- 'Data.EBird.API.HistoricalObservationsAPI' in the case that there are several
-- observations of the same species on the date.
data SelectObservation
    = SelectFirstObservation
    | SelectLastObservation
  deriving (Int -> SelectObservation -> ShowS
[SelectObservation] -> ShowS
SelectObservation -> String
(Int -> SelectObservation -> ShowS)
-> (SelectObservation -> String)
-> ([SelectObservation] -> ShowS)
-> Show SelectObservation
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SelectObservation -> ShowS
showsPrec :: Int -> SelectObservation -> ShowS
$cshow :: SelectObservation -> String
show :: SelectObservation -> String
$cshowList :: [SelectObservation] -> ShowS
showList :: [SelectObservation] -> ShowS
Show, ReadPrec [SelectObservation]
ReadPrec SelectObservation
Int -> ReadS SelectObservation
ReadS [SelectObservation]
(Int -> ReadS SelectObservation)
-> ReadS [SelectObservation]
-> ReadPrec SelectObservation
-> ReadPrec [SelectObservation]
-> Read SelectObservation
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SelectObservation
readsPrec :: Int -> ReadS SelectObservation
$creadList :: ReadS [SelectObservation]
readList :: ReadS [SelectObservation]
$creadPrec :: ReadPrec SelectObservation
readPrec :: ReadPrec SelectObservation
$creadListPrec :: ReadPrec [SelectObservation]
readListPrec :: ReadPrec [SelectObservation]
Read, SelectObservation -> SelectObservation -> Bool
(SelectObservation -> SelectObservation -> Bool)
-> (SelectObservation -> SelectObservation -> Bool)
-> Eq SelectObservation
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SelectObservation -> SelectObservation -> Bool
== :: SelectObservation -> SelectObservation -> Bool
$c/= :: SelectObservation -> SelectObservation -> Bool
/= :: SelectObservation -> SelectObservation -> Bool
Eq)

-------------------------------------------------------------------------------
-- * Optics for observation types
-------------------------------------------------------------------------------

makeLenses ''Observation
makeFieldLabels ''Observation

observationDetailsSubnational2Code :: Lens' (ObservationDetails 'Full) Region
observationDetailsSubnational2Code :: Lens' (ObservationDetails 'Full) Region
observationDetailsSubnational2Code =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
-> Lens' (ObservationDetails 'Full) Region
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
 -> Lens' (ObservationDetails 'Full) Region)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
-> Lens' (ObservationDetails 'Full) Region
forall a b. (a -> b) -> a -> b
$ \Region -> f Region
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Region
c -> ObservationDetails 'Full
d { _observationDetailsSubnational2Code = c })
      (Region -> ObservationDetails 'Full)
-> f Region -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> f Region
f Region
_observationDetailsSubnational2Code

observationDetailsSubnational2Name :: Lens' (ObservationDetails 'Full) Text
observationDetailsSubnational2Name :: Lens' (ObservationDetails 'Full) Text
observationDetailsSubnational2Name =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsSubnational2Name = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsSubnational2Name

observationDetailsSubnational1Code :: Lens' (ObservationDetails 'Full) Region
observationDetailsSubnational1Code :: Lens' (ObservationDetails 'Full) Region
observationDetailsSubnational1Code =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
-> Lens' (ObservationDetails 'Full) Region
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
 -> Lens' (ObservationDetails 'Full) Region)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
-> Lens' (ObservationDetails 'Full) Region
forall a b. (a -> b) -> a -> b
$ \Region -> f Region
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Region
c -> ObservationDetails 'Full
d { _observationDetailsSubnational1Code = c })
      (Region -> ObservationDetails 'Full)
-> f Region -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> f Region
f Region
_observationDetailsSubnational1Code

observationDetailsSubnational1Name :: Lens' (ObservationDetails 'Full) Text
observationDetailsSubnational1Name :: Lens' (ObservationDetails 'Full) Text
observationDetailsSubnational1Name =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsSubnational1Name = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsSubnational1Name

observationDetailsCountryCode :: Lens' (ObservationDetails 'Full) Region
observationDetailsCountryCode :: Lens' (ObservationDetails 'Full) Region
observationDetailsCountryCode =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
-> Lens' (ObservationDetails 'Full) Region
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
 -> Lens' (ObservationDetails 'Full) Region)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Region Region
-> Lens' (ObservationDetails 'Full) Region
forall a b. (a -> b) -> a -> b
$ \Region -> f Region
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Region
c -> ObservationDetails 'Full
d { _observationDetailsCountryCode = c })
      (Region -> ObservationDetails 'Full)
-> f Region -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Region -> f Region
f Region
_observationDetailsCountryCode

observationDetailsCountryName :: Lens' (ObservationDetails 'Full) Text
observationDetailsCountryName :: Lens' (ObservationDetails 'Full) Text
observationDetailsCountryName =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsCountryName = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsCountryName

observationDetailsUserDisplayName :: Lens' (ObservationDetails 'Full) Text
observationDetailsUserDisplayName :: Lens' (ObservationDetails 'Full) Text
observationDetailsUserDisplayName =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsUserDisplayName = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsUserDisplayName

observationDetailsObsId :: Lens' (ObservationDetails 'Full) Text
observationDetailsObsId :: Lens' (ObservationDetails 'Full) Text
observationDetailsObsId =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsObsId = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsObsId

observationDetailsChecklistId :: Lens' (ObservationDetails 'Full) Text
observationDetailsChecklistId :: Lens' (ObservationDetails 'Full) Text
observationDetailsChecklistId =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsChecklistId = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsChecklistId

observationDetailsPresenceNoted :: Lens' (ObservationDetails 'Full) Bool
observationDetailsPresenceNoted :: Lens' (ObservationDetails 'Full) Bool
observationDetailsPresenceNoted =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
-> Lens' (ObservationDetails 'Full) Bool
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
 -> Lens' (ObservationDetails 'Full) Bool)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
-> Lens' (ObservationDetails 'Full) Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> f Bool
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Bool
c -> ObservationDetails 'Full
d { _observationDetailsPresenceNoted = c })
      (Bool -> ObservationDetails 'Full)
-> f Bool -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
_observationDetailsPresenceNoted

observationDetailsHasComments :: Lens' (ObservationDetails 'Full) Bool
observationDetailsHasComments :: Lens' (ObservationDetails 'Full) Bool
observationDetailsHasComments =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
-> Lens' (ObservationDetails 'Full) Bool
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
 -> Lens' (ObservationDetails 'Full) Bool)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
-> Lens' (ObservationDetails 'Full) Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> f Bool
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Bool
c -> ObservationDetails 'Full
d { _observationDetailsHasComments = c })
      (Bool -> ObservationDetails 'Full)
-> f Bool -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
_observationDetailsHasComments

observationDetailsLastName :: Lens' (ObservationDetails 'Full) Text
observationDetailsLastName :: Lens' (ObservationDetails 'Full) Text
observationDetailsLastName =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsLastName = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsLastName

observationDetailsFirstName :: Lens' (ObservationDetails 'Full) Text
observationDetailsFirstName :: Lens' (ObservationDetails 'Full) Text
observationDetailsFirstName =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
 -> Lens' (ObservationDetails 'Full) Text)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Text Text
-> Lens' (ObservationDetails 'Full) Text
forall a b. (a -> b) -> a -> b
$ \Text -> f Text
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Text
c -> ObservationDetails 'Full
d { _observationDetailsFirstName = c })
      (Text -> ObservationDetails 'Full)
-> f Text -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> f Text
f Text
_observationDetailsFirstName

observationDetailsHasRichMedia :: Lens' (ObservationDetails 'Full) Bool
observationDetailsHasRichMedia :: Lens' (ObservationDetails 'Full) Bool
observationDetailsHasRichMedia =
    LensVL
  (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
-> Lens' (ObservationDetails 'Full) Bool
forall s t a b. LensVL s t a b -> Lens s t a b
lensVL (LensVL
   (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
 -> Lens' (ObservationDetails 'Full) Bool)
-> LensVL
     (ObservationDetails 'Full) (ObservationDetails 'Full) Bool Bool
-> Lens' (ObservationDetails 'Full) Bool
forall a b. (a -> b) -> a -> b
$ \Bool -> f Bool
f d :: ObservationDetails 'Full
d@FullDetails{Bool
Text
Region
_observationDetailsSubnational2Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational2Name :: ObservationDetails 'Full -> Text
_observationDetailsSubnational1Code :: ObservationDetails 'Full -> Region
_observationDetailsSubnational1Name :: ObservationDetails 'Full -> Text
_observationDetailsCountryCode :: ObservationDetails 'Full -> Region
_observationDetailsCountryName :: ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName :: ObservationDetails 'Full -> Text
_observationDetailsObsId :: ObservationDetails 'Full -> Text
_observationDetailsChecklistId :: ObservationDetails 'Full -> Text
_observationDetailsPresenceNoted :: ObservationDetails 'Full -> Bool
_observationDetailsHasComments :: ObservationDetails 'Full -> Bool
_observationDetailsLastName :: ObservationDetails 'Full -> Text
_observationDetailsFirstName :: ObservationDetails 'Full -> Text
_observationDetailsHasRichMedia :: ObservationDetails 'Full -> Bool
_observationDetailsSubnational2Code :: Region
_observationDetailsSubnational2Name :: Text
_observationDetailsSubnational1Code :: Region
_observationDetailsSubnational1Name :: Text
_observationDetailsCountryCode :: Region
_observationDetailsCountryName :: Text
_observationDetailsUserDisplayName :: Text
_observationDetailsObsId :: Text
_observationDetailsChecklistId :: Text
_observationDetailsPresenceNoted :: Bool
_observationDetailsHasComments :: Bool
_observationDetailsLastName :: Text
_observationDetailsFirstName :: Text
_observationDetailsHasRichMedia :: Bool
..} ->
          (\Bool
c -> ObservationDetails 'Full
d { _observationDetailsHasRichMedia = c })
      (Bool -> ObservationDetails 'Full)
-> f Bool -> f (ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> f Bool
f Bool
_observationDetailsHasRichMedia

instance
     k ~ A_Lens
  => LabelOptic
       "subnational2Code" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Region
       Region
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Region
  Region
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Region
  Region
Lens' (ObservationDetails 'Full) Region
observationDetailsSubnational2Code

instance
     k ~ A_Lens
  => LabelOptic
       "subnational2Name" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsSubnational2Name

instance
     k ~ A_Lens
  => LabelOptic
       "subnational1Code" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Region
       Region
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Region
  Region
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Region
  Region
Lens' (ObservationDetails 'Full) Region
observationDetailsSubnational1Code

instance
     k ~ A_Lens
  => LabelOptic
       "subnational1Name" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsSubnational1Name

instance
     k ~ A_Lens
  => LabelOptic
       "countryCode" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Region
       Region
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Region
  Region
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Region
  Region
Lens' (ObservationDetails 'Full) Region
observationDetailsCountryCode

instance
     k ~ A_Lens
  => LabelOptic
       "countryName" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsCountryName

instance
     k ~ A_Lens
  => LabelOptic
       "userDisplayName" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsUserDisplayName

instance
     k ~ A_Lens
  => LabelOptic
       "obsId" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsObsId

instance
     k ~ A_Lens
  => LabelOptic
       "checklistId" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsChecklistId

instance
     k ~ A_Lens
  => LabelOptic
       "presenceNoted" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Bool
       Bool
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Bool
  Bool
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Bool
  Bool
Lens' (ObservationDetails 'Full) Bool
observationDetailsPresenceNoted

instance
     k ~ A_Lens
  => LabelOptic
       "hasComments" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Bool
       Bool
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Bool
  Bool
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Bool
  Bool
Lens' (ObservationDetails 'Full) Bool
observationDetailsHasComments

instance
     k ~ A_Lens
  => LabelOptic
       "lastName" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsLastName

instance
     k ~ A_Lens
  => LabelOptic
       "firstName" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Text
       Text
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Text
  Text
Lens' (ObservationDetails 'Full) Text
observationDetailsFirstName

instance
     k ~ A_Lens
  => LabelOptic
       "hasRichMedia" k
       (ObservationDetails 'Full)
       (ObservationDetails 'Full)
       Bool
       Bool
  where
    labelOptic :: Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Bool
  Bool
labelOptic = Optic
  k
  NoIx
  (ObservationDetails 'Full)
  (ObservationDetails 'Full)
  Bool
  Bool
Lens' (ObservationDetails 'Full) Bool
observationDetailsHasRichMedia

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

-- | Explicit instance for compatibility with their field names
instance FromJSON (Observation 'Simple) where
  parseJSON :: Value -> Parser (Observation 'Simple)
parseJSON = String
-> (Object -> Parser (Observation 'Simple))
-> Value
-> Parser (Observation 'Simple)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Observation 'Simple" ((Object -> Parser (Observation 'Simple))
 -> Value -> Parser (Observation 'Simple))
-> (Object -> Parser (Observation 'Simple))
-> Value
-> Parser (Observation 'Simple)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Text
-> Text
-> Text
-> EBirdDateTime
-> Maybe Integer
-> Double
-> Double
-> Bool
-> Bool
-> Bool
-> Text
-> ObservationDetails 'Simple
-> Observation 'Simple
forall (detail :: DetailLevel).
Text
-> Text
-> Text
-> Text
-> Text
-> EBirdDateTime
-> Maybe Integer
-> Double
-> Double
-> Bool
-> Bool
-> Bool
-> Text
-> ObservationDetails detail
-> Observation detail
Observation
        (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> EBirdDateTime
 -> Maybe Integer
 -> Double
 -> Double
 -> Bool
 -> Bool
 -> Bool
 -> Text
 -> ObservationDetails 'Simple
 -> Observation 'Simple)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
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
"speciesCode"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
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
"comName"
        Parser
  (Text
   -> Text
   -> Text
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
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
"sciName"
        Parser
  (Text
   -> Text
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Text
-> Parser
     (Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
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
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Text
-> Parser
     (EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locName"
        Parser
  (EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser EBirdDateTime
-> Parser
     (Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
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
  (Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser (Maybe Integer)
-> Parser
     (Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"howMany"
        Parser
  (Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Double
-> Parser
     (Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lat"
        Parser
  (Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Double
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lng"
        Parser
  (Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Bool
-> Parser
     (Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Simple
      -> Observation 'Simple)
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
"obsValid"
        Parser
  (Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Simple
   -> Observation 'Simple)
-> Parser Bool
-> Parser
     (Bool -> Text -> ObservationDetails 'Simple -> Observation 'Simple)
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
"obsReviewed"
        Parser
  (Bool -> Text -> ObservationDetails 'Simple -> Observation 'Simple)
-> Parser Bool
-> Parser
     (Text -> ObservationDetails 'Simple -> Observation 'Simple)
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
"locationPrivate"
        Parser (Text -> ObservationDetails 'Simple -> Observation 'Simple)
-> Parser Text
-> Parser (ObservationDetails 'Simple -> Observation 'Simple)
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 (ObservationDetails 'Simple -> Observation 'Simple)
-> Parser (ObservationDetails 'Simple)
-> Parser (Observation 'Simple)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ObservationDetails 'Simple -> Parser (ObservationDetails 'Simple)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ObservationDetails 'Simple
NoDetails

-- | Explicit instance for compatibility with their field names
instance ToJSON (Observation 'Simple) where
  toJSON :: Observation 'Simple -> Value
toJSON Observation{Bool
Double
Maybe Integer
Text
EBirdDateTime
ObservationDetails 'Simple
_observationSpeciesCode :: forall (detail :: DetailLevel). Observation detail -> Text
_observationCommonName :: forall (detail :: DetailLevel). Observation detail -> Text
_observationScientificName :: forall (detail :: DetailLevel). Observation detail -> Text
_observationLocationId :: forall (detail :: DetailLevel). Observation detail -> Text
_observationLocationName :: forall (detail :: DetailLevel). Observation detail -> Text
_observationDateTime :: forall (detail :: DetailLevel). Observation detail -> EBirdDateTime
_observationHowMany :: forall (detail :: DetailLevel). Observation detail -> Maybe Integer
_observationLatitude :: forall (detail :: DetailLevel). Observation detail -> Double
_observationLongitude :: forall (detail :: DetailLevel). Observation detail -> Double
_observationValid :: forall (detail :: DetailLevel). Observation detail -> Bool
_observationReviewed :: forall (detail :: DetailLevel). Observation detail -> Bool
_observationLocationPrivate :: forall (detail :: DetailLevel). Observation detail -> Bool
_observationSubId :: forall (detail :: DetailLevel). Observation detail -> Text
_observationFullDetail :: forall (detail :: DetailLevel).
Observation detail -> ObservationDetails detail
_observationSpeciesCode :: Text
_observationCommonName :: Text
_observationScientificName :: Text
_observationLocationId :: Text
_observationLocationName :: Text
_observationDateTime :: EBirdDateTime
_observationHowMany :: Maybe Integer
_observationLatitude :: Double
_observationLongitude :: Double
_observationValid :: Bool
_observationReviewed :: Bool
_observationLocationPrivate :: Bool
_observationSubId :: Text
_observationFullDetail :: ObservationDetails 'Simple
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"speciesCode" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationSpeciesCode
        , Key
"comName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationCommonName
        , Key
"sciName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationScientificName
        , Key
"locId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationLocationId
        , Key
"locName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationLocationName
        , Key
"obsDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
_observationDateTime
        , Key
"lat" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_observationLatitude
        , Key
"lng" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_observationLongitude
        , Key
"obsValid" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_observationValid
        , Key
"obsReviewed" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_observationReviewed
        , Key
"locationPrivate" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_observationLocationPrivate
        , Key
"subId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationSubId
        ]
        -- Fields that may or may not be included, depending on the observation
        -- data
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"howMany" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
howMany | Just Integer
howMany <- [Maybe Integer
_observationHowMany]]

-- | Explicit instance for compatibility with their field names
instance FromJSON (Observation 'Full) where
  parseJSON :: Value -> Parser (Observation 'Full)
parseJSON = String
-> (Object -> Parser (Observation 'Full))
-> Value
-> Parser (Observation 'Full)
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Observation 'Full" ((Object -> Parser (Observation 'Full))
 -> Value -> Parser (Observation 'Full))
-> (Object -> Parser (Observation 'Full))
-> Value
-> Parser (Observation 'Full)
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text
-> Text
-> Text
-> Text
-> Text
-> EBirdDateTime
-> Maybe Integer
-> Double
-> Double
-> Bool
-> Bool
-> Bool
-> Text
-> ObservationDetails 'Full
-> Observation 'Full
forall (detail :: DetailLevel).
Text
-> Text
-> Text
-> Text
-> Text
-> EBirdDateTime
-> Maybe Integer
-> Double
-> Double
-> Bool
-> Bool
-> Bool
-> Text
-> ObservationDetails detail
-> Observation detail
Observation
        (Text
 -> Text
 -> Text
 -> Text
 -> Text
 -> EBirdDateTime
 -> Maybe Integer
 -> Double
 -> Double
 -> Bool
 -> Bool
 -> Bool
 -> Text
 -> ObservationDetails 'Full
 -> Observation 'Full)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
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
"speciesCode"
        Parser
  (Text
   -> Text
   -> Text
   -> Text
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
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
"comName"
        Parser
  (Text
   -> Text
   -> Text
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
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
"sciName"
        Parser
  (Text
   -> Text
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Text
-> Parser
     (Text
      -> EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
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
   -> EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Text
-> Parser
     (EBirdDateTime
      -> Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"locName"
        Parser
  (EBirdDateTime
   -> Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser EBirdDateTime
-> Parser
     (Maybe Integer
      -> Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
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
  (Maybe Integer
   -> Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser (Maybe Integer)
-> Parser
     (Double
      -> Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Integer)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"howMany"
        Parser
  (Double
   -> Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Double
-> Parser
     (Double
      -> Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lat"
        Parser
  (Double
   -> Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Double
-> Parser
     (Bool
      -> Bool
      -> Bool
      -> Text
      -> ObservationDetails 'Full
      -> Observation 'Full)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Double
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"lng"
        Parser
  (Bool
   -> Bool
   -> Bool
   -> Text
   -> ObservationDetails 'Full
   -> Observation 'Full)
-> Parser Bool
-> Parser
     (Bool
      -> Bool -> Text -> ObservationDetails 'Full -> Observation 'Full)
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
"obsValid"
        Parser
  (Bool
   -> Bool -> Text -> ObservationDetails 'Full -> Observation 'Full)
-> Parser Bool
-> Parser
     (Bool -> Text -> ObservationDetails 'Full -> Observation 'Full)
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
"obsReviewed"
        Parser
  (Bool -> Text -> ObservationDetails 'Full -> Observation 'Full)
-> Parser Bool
-> Parser (Text -> ObservationDetails 'Full -> Observation 'Full)
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
"locationPrivate"
        Parser (Text -> ObservationDetails 'Full -> Observation 'Full)
-> Parser Text
-> Parser (ObservationDetails 'Full -> Observation 'Full)
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 (ObservationDetails 'Full -> Observation 'Full)
-> Parser (ObservationDetails 'Full) -> Parser (Observation 'Full)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( Region
-> Text
-> Region
-> Text
-> Region
-> Text
-> Text
-> Text
-> Text
-> Bool
-> Bool
-> Text
-> Text
-> Bool
-> ObservationDetails 'Full
FullDetails
                (Region
 -> Text
 -> Region
 -> Text
 -> Region
 -> Text
 -> Text
 -> Text
 -> Text
 -> Bool
 -> Bool
 -> Text
 -> Text
 -> Bool
 -> ObservationDetails 'Full)
-> Parser Region
-> Parser
     (Text
      -> Region
      -> Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
forall (f :: * -> *) a b. Functor 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
   -> Region
   -> Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Text
-> Parser
     (Region
      -> Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
  (Region
   -> Text
   -> Region
   -> Text
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Region
-> Parser
     (Text
      -> Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Text
-> Parser
     (Region
      -> Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Region
-> Parser
     (Text
      -> Text
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
   -> Text
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
  (Text
   -> Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Text
-> Parser
     (Text
      -> Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
  (Text
   -> Text
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Text
-> Parser
     (Text
      -> Bool
      -> Bool
      -> Text
      -> Text
      -> Bool
      -> ObservationDetails 'Full)
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
   -> Bool
   -> Bool
   -> Text
   -> Text
   -> Bool
   -> ObservationDetails 'Full)
-> Parser Text
-> Parser
     (Bool -> Bool -> Text -> Text -> Bool -> ObservationDetails 'Full)
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
  (Bool -> Bool -> Text -> Text -> Bool -> ObservationDetails 'Full)
-> Parser Bool
-> Parser
     (Bool -> Text -> Text -> Bool -> ObservationDetails 'Full)
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
"presenceNoted"
                Parser (Bool -> Text -> Text -> Bool -> ObservationDetails 'Full)
-> Parser Bool
-> Parser (Text -> Text -> Bool -> ObservationDetails 'Full)
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
"hasComments"
                Parser (Text -> Text -> Bool -> ObservationDetails 'Full)
-> Parser Text -> Parser (Text -> Bool -> ObservationDetails 'Full)
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
"lastName"
                Parser (Text -> Bool -> ObservationDetails 'Full)
-> Parser Text -> Parser (Bool -> ObservationDetails 'Full)
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
"firstName"
                Parser (Bool -> ObservationDetails 'Full)
-> Parser Bool -> Parser (ObservationDetails 'Full)
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
"hasRichMedia"
            )

-- | Explicit instance for compatibility with their field names
instance ToJSON (Observation 'Full) where
  toJSON :: Observation 'Full -> Value
toJSON Observation{Bool
Double
Maybe Integer
Text
EBirdDateTime
ObservationDetails 'Full
_observationSpeciesCode :: forall (detail :: DetailLevel). Observation detail -> Text
_observationCommonName :: forall (detail :: DetailLevel). Observation detail -> Text
_observationScientificName :: forall (detail :: DetailLevel). Observation detail -> Text
_observationLocationId :: forall (detail :: DetailLevel). Observation detail -> Text
_observationLocationName :: forall (detail :: DetailLevel). Observation detail -> Text
_observationDateTime :: forall (detail :: DetailLevel). Observation detail -> EBirdDateTime
_observationHowMany :: forall (detail :: DetailLevel). Observation detail -> Maybe Integer
_observationLatitude :: forall (detail :: DetailLevel). Observation detail -> Double
_observationLongitude :: forall (detail :: DetailLevel). Observation detail -> Double
_observationValid :: forall (detail :: DetailLevel). Observation detail -> Bool
_observationReviewed :: forall (detail :: DetailLevel). Observation detail -> Bool
_observationLocationPrivate :: forall (detail :: DetailLevel). Observation detail -> Bool
_observationSubId :: forall (detail :: DetailLevel). Observation detail -> Text
_observationFullDetail :: forall (detail :: DetailLevel).
Observation detail -> ObservationDetails detail
_observationSpeciesCode :: Text
_observationCommonName :: Text
_observationScientificName :: Text
_observationLocationId :: Text
_observationLocationName :: Text
_observationDateTime :: EBirdDateTime
_observationHowMany :: Maybe Integer
_observationLatitude :: Double
_observationLongitude :: Double
_observationValid :: Bool
_observationReviewed :: Bool
_observationLocationPrivate :: Bool
_observationSubId :: Text
_observationFullDetail :: ObservationDetails 'Full
..} =
      [Pair] -> Value
object
        [ Key
"speciesCode" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationSpeciesCode
        , Key
"comName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationCommonName
        , Key
"sciName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationScientificName
        , Key
"locId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationLocationId
        , Key
"locName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationLocationName
        , Key
"obsDt" Key -> EBirdDateTime -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= EBirdDateTime
_observationDateTime
        , Key
"howMany" Key -> Maybe Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Integer
_observationHowMany
        , Key
"lat" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_observationLatitude
        , Key
"lng" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_observationLongitude
        , Key
"obsValid" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_observationValid
        , Key
"obsReviewed" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_observationReviewed
        , Key
"locationPrivate" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_observationLocationPrivate
        , Key
"subId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_observationSubId
        , Key
"subnational2Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Region
_observationDetailsSubnational2Code ObservationDetails 'Full
_observationFullDetail
        , Key
"subnational2Name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsSubnational2Name ObservationDetails 'Full
_observationFullDetail
        , Key
"subnational1Code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Region
_observationDetailsSubnational1Code ObservationDetails 'Full
_observationFullDetail
        , Key
"subnational1Name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsSubnational1Name ObservationDetails 'Full
_observationFullDetail
        , Key
"countryCode" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Region
_observationDetailsCountryCode ObservationDetails 'Full
_observationFullDetail
        , Key
"countryName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsCountryName ObservationDetails 'Full
_observationFullDetail
        , Key
"userDisplayName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsUserDisplayName ObservationDetails 'Full
_observationFullDetail
        , Key
"obsId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsObsId ObservationDetails 'Full
_observationFullDetail
        , Key
"checklistId" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsChecklistId ObservationDetails 'Full
_observationFullDetail
        , Key
"presenceNoted" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Bool
_observationDetailsPresenceNoted ObservationDetails 'Full
_observationFullDetail
        , Key
"hasComments" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Bool
_observationDetailsHasComments ObservationDetails 'Full
_observationFullDetail
        , Key
"lastName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsLastName ObservationDetails 'Full
_observationFullDetail
        , Key
"firstName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Text
_observationDetailsFirstName ObservationDetails 'Full
_observationFullDetail
        , Key
"hasRichMedia" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.=
            ObservationDetails 'Full -> Bool
_observationDetailsHasRichMedia ObservationDetails 'Full
_observationFullDetail
        ]

-- | Switches between parsing a 'Simple' detail 'Observation' and a 'Full'
-- detail 'Observation' depending on whether the "firstName" key is present.
instance FromJSON SomeObservation where
  parseJSON :: Value -> Parser SomeObservation
parseJSON Value
obj = String
-> (Object -> Parser SomeObservation)
-> Value
-> Parser SomeObservation
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SomeObservation"
      ( \Object
v ->
          if Maybe Value -> Bool
forall a. Maybe a -> Bool
isJust (Object
v Object -> Key -> Maybe Value
forall v. KeyMap v -> Key -> Maybe v
!? Key
"firstName") then
            Observation 'Full -> SomeObservation
forall (detail :: DetailLevel).
Observation detail -> SomeObservation
SomeObservation (Observation 'Full -> SomeObservation)
-> Parser (Observation 'Full) -> Parser SomeObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(Observation 'Full) Value
obj
          else
            Observation 'Simple -> SomeObservation
forall (detail :: DetailLevel).
Observation detail -> SomeObservation
SomeObservation (Observation 'Simple -> SomeObservation)
-> Parser (Observation 'Simple) -> Parser SomeObservation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. FromJSON a => Value -> Parser a
parseJSON @(Observation 'Simple) Value
obj
      ) Value
obj

-- | Switches between encoding a 'Simple' 'Observation' and a 'Full'
-- 'Observation' depending on the evidence introduced by pattern-matching on the
-- 'observationFullDetail' field.
instance ToJSON SomeObservation where
  toJSON :: SomeObservation -> Value
toJSON (SomeObservation Observation detail
obs) =
      case Observation detail -> ObservationDetails detail
forall (detail :: DetailLevel).
Observation detail -> ObservationDetails detail
_observationFullDetail Observation detail
obs of
        ObservationDetails detail
NoDetails -> forall a. ToJSON a => a -> Value
toJSON @(Observation 'Simple) Observation detail
Observation 'Simple
obs
        FullDetails {} -> forall a. ToJSON a => a -> Value
toJSON @(Observation 'Full) Observation detail
Observation 'Full
obs

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

-- | The eBird string for a 'DetailLevel' value is simply the lowercase
-- constructor name.
instance EBirdString DetailLevel where
  toEBirdString :: DetailLevel -> Text
toEBirdString =
      \case
        DetailLevel
Simple -> Text
"simple"
        DetailLevel
Full -> Text
"full"

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

-- | The eBird string for a 'SortObservationsBy' value is either "date" or
-- "species".
instance EBirdString SortObservationsBy where
  toEBirdString :: SortObservationsBy -> Text
toEBirdString =
      \case
        SortObservationsBy
SortObservationsByDate -> Text
"date"
        SortObservationsBy
SortObservationsBySpecies -> Text
"species"

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

-- | The eBird string for a 'SelectObservation' value is either "create" or
-- "mrec".
instance EBirdString SelectObservation where
  toEBirdString :: SelectObservation -> Text
toEBirdString =
      \case
        SelectObservation
SelectFirstObservation -> Text
"create"
        SelectObservation
SelectLastObservation -> Text
"mrec"

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

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

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

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

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

-- | Parse a 'SortObservationsBy' value
parseSortObservationsBy :: Parser SortObservationsBy
parseSortObservationsBy :: Parser SortObservationsBy
parseSortObservationsBy =
    [Parser SortObservationsBy] -> Parser SortObservationsBy
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"date" Parser Text Text -> SortObservationsBy -> Parser SortObservationsBy
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SortObservationsBy
SortObservationsByDate
      , Parser Text Text
"species" Parser Text Text -> SortObservationsBy -> Parser SortObservationsBy
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SortObservationsBy
SortObservationsBySpecies
      ]
  where
    _casesCovered :: SortObservationsBy -> ()
    _casesCovered :: SortObservationsBy -> ()
_casesCovered =
      \case
        SortObservationsBy
SortObservationsByDate -> ()
        SortObservationsBy
SortObservationsBySpecies -> ()

-- | Parse a 'SelectObservation' value
parseSelectObservation :: Parser SelectObservation
parseSelectObservation :: Parser SelectObservation
parseSelectObservation =
    [Parser SelectObservation] -> Parser SelectObservation
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"first" Parser Text Text -> SelectObservation -> Parser SelectObservation
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SelectObservation
SelectFirstObservation
      , Parser Text Text
"last" Parser Text Text -> SelectObservation -> Parser SelectObservation
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SelectObservation
SelectLastObservation
      ]
  where
    _casesCovered :: SelectObservation -> ()
    _casesCovered :: SelectObservation -> ()
_casesCovered =
      \case
        SelectObservation
SelectFirstObservation -> ()
        SelectObservation
SelectLastObservation -> ()

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

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

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

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