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

{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# HLINT ignore "Use camelCase" #-}

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

module Data.EBird.API.Taxonomy where

import Control.Arrow
import Data.Aeson
import Data.Attoparsec.Text
import Data.Char
import Data.Function
import Data.Functor
import Data.List.NonEmpty (NonEmpty(..))
import Data.String
import Data.Text (Text)
import Data.Text qualified as Text
import Optics
import GHC.Exts
import Servant.API (ToHttpApiData(..))

import Data.EBird.API.EBirdString

-------------------------------------------------------------------------------
-- * Taxonomy types
-------------------------------------------------------------------------------

-- | Taxa in the eBird taxonomy.
data Taxon =
    Taxon
      { -- | Scientific name, e.g. "Bombycilla garrulus/cedrorum"
        Taxon -> Text
_taxonScientificName :: Text

        -- | Common name, e.g. "Bohemian/Cedar Waxwing"
      , Taxon -> Text
_taxonCommonName :: Text

        -- | eBird species code, e.g. "waxwin"
      , Taxon -> SpeciesCode
_taxonSpeciesCode :: SpeciesCode

        -- | eBird species category, e.g. "slash"
        --
        -- See the [eBird
        -- documentation](https://science.ebird.org/en/use-ebird-data/the-ebird-taxonomy)
        -- for more information on species categories
      , Taxon -> TaxonomyCategory
_taxonCategory :: TaxonomyCategory

        -- | A numeric value that determines the location of this taxon in the
        -- taxonomy list, e.g. 29257.0
      , Taxon -> Double
_taxonTaxonOrder :: Double

        -- | Banding codes, e.g. [\"BOWA\"] for Bohemian Waxwing.
      , Taxon -> [Text]
_taxonBandingCodes :: [Text]

        -- | Common name codes, e.g. [\"BOWA\",\"CEDW\",\"CEWA\"]
      , Taxon -> [Text]
_taxonCommonNameCodes :: [Text]

        -- | Scientific name codes, e.g. [\"BOCE\",\"BOGA\"]
      , Taxon -> [Text]
_taxonScientificNameCodes :: [Text]

        -- | Order, e.g. \"Passeriformes\"
      , Taxon -> Text
_taxonOrder :: Text

        -- | Family code, e.g. "bombyc1"
      , Taxon -> Maybe Text
_taxonFamilyCode :: Maybe Text

        -- | Family common name, e.g. \"Waxwings\"
      , Taxon -> Maybe Text
_taxonFamilyCommonName :: Maybe Text

        -- | Family scientific name, e.g. \"Bombycillidae\"
      , Taxon -> Maybe Text
_taxonFamilyScientificName :: Maybe Text
      }
  deriving (Int -> Taxon -> ShowS
[Taxon] -> ShowS
Taxon -> String
(Int -> Taxon -> ShowS)
-> (Taxon -> String) -> ([Taxon] -> ShowS) -> Show Taxon
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Taxon -> ShowS
showsPrec :: Int -> Taxon -> ShowS
$cshow :: Taxon -> String
show :: Taxon -> String
$cshowList :: [Taxon] -> ShowS
showList :: [Taxon] -> ShowS
Show, ReadPrec [Taxon]
ReadPrec Taxon
Int -> ReadS Taxon
ReadS [Taxon]
(Int -> ReadS Taxon)
-> ReadS [Taxon]
-> ReadPrec Taxon
-> ReadPrec [Taxon]
-> Read Taxon
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Taxon
readsPrec :: Int -> ReadS Taxon
$creadList :: ReadS [Taxon]
readList :: ReadS [Taxon]
$creadPrec :: ReadPrec Taxon
readPrec :: ReadPrec Taxon
$creadListPrec :: ReadPrec [Taxon]
readListPrec :: ReadPrec [Taxon]
Read, Taxon -> Taxon -> Bool
(Taxon -> Taxon -> Bool) -> (Taxon -> Taxon -> Bool) -> Eq Taxon
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Taxon -> Taxon -> Bool
== :: Taxon -> Taxon -> Bool
$c/= :: Taxon -> Taxon -> Bool
/= :: Taxon -> Taxon -> Bool
Eq)

-- | eBird species codes, simply 'Text'; e.g. Gray Vireo is "gryvir", Field
-- Sparrow is "fiespa".
newtype SpeciesCode = SpeciesCode { SpeciesCode -> Text
speciesCode :: Text }
  deriving (SpeciesCode -> SpeciesCode -> Bool
(SpeciesCode -> SpeciesCode -> Bool)
-> (SpeciesCode -> SpeciesCode -> Bool) -> Eq SpeciesCode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpeciesCode -> SpeciesCode -> Bool
== :: SpeciesCode -> SpeciesCode -> Bool
$c/= :: SpeciesCode -> SpeciesCode -> Bool
/= :: SpeciesCode -> SpeciesCode -> Bool
Eq, Int -> SpeciesCode -> ShowS
[SpeciesCode] -> ShowS
SpeciesCode -> String
(Int -> SpeciesCode -> ShowS)
-> (SpeciesCode -> String)
-> ([SpeciesCode] -> ShowS)
-> Show SpeciesCode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpeciesCode -> ShowS
showsPrec :: Int -> SpeciesCode -> ShowS
$cshow :: SpeciesCode -> String
show :: SpeciesCode -> String
$cshowList :: [SpeciesCode] -> ShowS
showList :: [SpeciesCode] -> ShowS
Show, ReadPrec [SpeciesCode]
ReadPrec SpeciesCode
Int -> ReadS SpeciesCode
ReadS [SpeciesCode]
(Int -> ReadS SpeciesCode)
-> ReadS [SpeciesCode]
-> ReadPrec SpeciesCode
-> ReadPrec [SpeciesCode]
-> Read SpeciesCode
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SpeciesCode
readsPrec :: Int -> ReadS SpeciesCode
$creadList :: ReadS [SpeciesCode]
readList :: ReadS [SpeciesCode]
$creadPrec :: ReadPrec SpeciesCode
readPrec :: ReadPrec SpeciesCode
$creadListPrec :: ReadPrec [SpeciesCode]
readListPrec :: ReadPrec [SpeciesCode]
Read)

-- | A list of eBird 'SpeciesCode's.
newtype SpeciesCodes = SpeciesCodes { SpeciesCodes -> [SpeciesCode]
speciesCodes :: [SpeciesCode] }
  deriving (SpeciesCodes -> SpeciesCodes -> Bool
(SpeciesCodes -> SpeciesCodes -> Bool)
-> (SpeciesCodes -> SpeciesCodes -> Bool) -> Eq SpeciesCodes
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SpeciesCodes -> SpeciesCodes -> Bool
== :: SpeciesCodes -> SpeciesCodes -> Bool
$c/= :: SpeciesCodes -> SpeciesCodes -> Bool
/= :: SpeciesCodes -> SpeciesCodes -> Bool
Eq, Int -> SpeciesCodes -> ShowS
[SpeciesCodes] -> ShowS
SpeciesCodes -> String
(Int -> SpeciesCodes -> ShowS)
-> (SpeciesCodes -> String)
-> ([SpeciesCodes] -> ShowS)
-> Show SpeciesCodes
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SpeciesCodes -> ShowS
showsPrec :: Int -> SpeciesCodes -> ShowS
$cshow :: SpeciesCodes -> String
show :: SpeciesCodes -> String
$cshowList :: [SpeciesCodes] -> ShowS
showList :: [SpeciesCodes] -> ShowS
Show, ReadPrec [SpeciesCodes]
ReadPrec SpeciesCodes
Int -> ReadS SpeciesCodes
ReadS [SpeciesCodes]
(Int -> ReadS SpeciesCodes)
-> ReadS [SpeciesCodes]
-> ReadPrec SpeciesCodes
-> ReadPrec [SpeciesCodes]
-> Read SpeciesCodes
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SpeciesCodes
readsPrec :: Int -> ReadS SpeciesCodes
$creadList :: ReadS [SpeciesCodes]
readList :: ReadS [SpeciesCodes]
$creadPrec :: ReadPrec SpeciesCodes
readPrec :: ReadPrec SpeciesCodes
$creadListPrec :: ReadPrec [SpeciesCodes]
readListPrec :: ReadPrec [SpeciesCodes]
Read)

-- | The taxonomy categories are explained in the
-- [eBird documentation](https://science.ebird.org/en/use-ebird-data/the-ebird-taxonomy).
-- Their examples are echoed in the documentation of the constructors of this
-- type.
data TaxonomyCategory =
      -- | The 'Species' category simply identifies species, e.g. "Tundra Swan
      -- /Cygnus columbianus/"
      Species

      -- | Genus or broad identification, e.g. "swan sp. /Cygnus sp./"
    | Spuh

      -- | Identifiable subspecies or group of subspecies, e.g. "Tundra Swan
      -- (Bewick’s) /Cygnus columbianus bewickii/" or "Tundra Swan (Whistling)
      -- /Cygnus columbianus columbianus/"
    | ISSF

      -- | Identification to species pair, e.g. "Tundra/Trumpeter Swan
      -- /Cygnus columbianus\/buccinator/"
    | Slash

      -- | Hybrid between two species, e.g. "Tundra x Trumpeter Swan (hybrid)"
    | Hybrid

      -- | Hybrid between two ISSF (subspecies or subspecies groups), e.g.
      -- "Tundra Swan (Whistling x Bewick’s)
      -- /Cygnus columbianus columbianus x bewickii/"
    | Intergrade

      -- | Distinctly-plumaged domesticated varieties that may be free-flying
      -- (these do not count on personal lists), e.g. "Mallard (Domestic type)"
    | Domestic

      -- | Miscellaneous other taxa, including recently-described species yet to
      -- be accepted or distinctive forms that are not universally accepted,
      -- e.g. Red-tailed Hawk (abieticola), Upland Goose (Bar-breasted).
    | Form
  deriving (Int -> TaxonomyCategory -> ShowS
[TaxonomyCategory] -> ShowS
TaxonomyCategory -> String
(Int -> TaxonomyCategory -> ShowS)
-> (TaxonomyCategory -> String)
-> ([TaxonomyCategory] -> ShowS)
-> Show TaxonomyCategory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxonomyCategory -> ShowS
showsPrec :: Int -> TaxonomyCategory -> ShowS
$cshow :: TaxonomyCategory -> String
show :: TaxonomyCategory -> String
$cshowList :: [TaxonomyCategory] -> ShowS
showList :: [TaxonomyCategory] -> ShowS
Show, ReadPrec [TaxonomyCategory]
ReadPrec TaxonomyCategory
Int -> ReadS TaxonomyCategory
ReadS [TaxonomyCategory]
(Int -> ReadS TaxonomyCategory)
-> ReadS [TaxonomyCategory]
-> ReadPrec TaxonomyCategory
-> ReadPrec [TaxonomyCategory]
-> Read TaxonomyCategory
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxonomyCategory
readsPrec :: Int -> ReadS TaxonomyCategory
$creadList :: ReadS [TaxonomyCategory]
readList :: ReadS [TaxonomyCategory]
$creadPrec :: ReadPrec TaxonomyCategory
readPrec :: ReadPrec TaxonomyCategory
$creadListPrec :: ReadPrec [TaxonomyCategory]
readListPrec :: ReadPrec [TaxonomyCategory]
Read, TaxonomyCategory -> TaxonomyCategory -> Bool
(TaxonomyCategory -> TaxonomyCategory -> Bool)
-> (TaxonomyCategory -> TaxonomyCategory -> Bool)
-> Eq TaxonomyCategory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxonomyCategory -> TaxonomyCategory -> Bool
== :: TaxonomyCategory -> TaxonomyCategory -> Bool
$c/= :: TaxonomyCategory -> TaxonomyCategory -> Bool
/= :: TaxonomyCategory -> TaxonomyCategory -> Bool
Eq)

-- | 'TaxonomyCategories' values contain a 'NonEmpty' list of
-- 'TaxonomyCategory's.
newtype TaxonomyCategories =
    TaxonomyCategories
      { TaxonomyCategories -> NonEmpty TaxonomyCategory
taxonomyCategoriesCategories :: NonEmpty TaxonomyCategory
      }
  deriving (Int -> TaxonomyCategories -> ShowS
[TaxonomyCategories] -> ShowS
TaxonomyCategories -> String
(Int -> TaxonomyCategories -> ShowS)
-> (TaxonomyCategories -> String)
-> ([TaxonomyCategories] -> ShowS)
-> Show TaxonomyCategories
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxonomyCategories -> ShowS
showsPrec :: Int -> TaxonomyCategories -> ShowS
$cshow :: TaxonomyCategories -> String
show :: TaxonomyCategories -> String
$cshowList :: [TaxonomyCategories] -> ShowS
showList :: [TaxonomyCategories] -> ShowS
Show, ReadPrec [TaxonomyCategories]
ReadPrec TaxonomyCategories
Int -> ReadS TaxonomyCategories
ReadS [TaxonomyCategories]
(Int -> ReadS TaxonomyCategories)
-> ReadS [TaxonomyCategories]
-> ReadPrec TaxonomyCategories
-> ReadPrec [TaxonomyCategories]
-> Read TaxonomyCategories
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxonomyCategories
readsPrec :: Int -> ReadS TaxonomyCategories
$creadList :: ReadS [TaxonomyCategories]
readList :: ReadS [TaxonomyCategories]
$creadPrec :: ReadPrec TaxonomyCategories
readPrec :: ReadPrec TaxonomyCategories
$creadListPrec :: ReadPrec [TaxonomyCategories]
readListPrec :: ReadPrec [TaxonomyCategories]
Read, TaxonomyCategories -> TaxonomyCategories -> Bool
(TaxonomyCategories -> TaxonomyCategories -> Bool)
-> (TaxonomyCategories -> TaxonomyCategories -> Bool)
-> Eq TaxonomyCategories
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxonomyCategories -> TaxonomyCategories -> Bool
== :: TaxonomyCategories -> TaxonomyCategories -> Bool
$c/= :: TaxonomyCategories -> TaxonomyCategories -> Bool
/= :: TaxonomyCategories -> TaxonomyCategories -> Bool
Eq)

-- ** Optics for taxonomy types

makeLenses ''Taxon
makeFieldLabels ''Taxon

-------------------------------------------------------------------------------
-- * Auxiliary eBird taxonomy-related API types
-------------------------------------------------------------------------------

-- | eBird maintains many common name translations. See their
-- ["Bird Names in eBird"](https://support.ebird.org/en/support/solutions/articles/48000804865-bird-names-in-ebird)
-- documentation for a discussion of the languages they support.
--
-- This type is an enumeration of those languages, and is used to support the
-- [eBird API](https://documenter.getpostman.com/view/664302/S1ENwy59)
-- endpoints which allow a locale to be specified.
data SPPLocale =
      Af     -- ^ Afrikaans
    | Sq     -- ^ Albanians
    | Ar     -- ^ Arabic
    | Hy     -- ^ Armenian
    | As     -- ^ Assamese
    | Ast    -- ^ Asturian
    | Az     -- ^ Azerbaijani
    | Eu     -- ^ Basque
    | Bn     -- ^ Bengali
    | Bg     -- ^ Bulgarian
    | Ca     -- ^ Catalan
    | Zh     -- ^ Chinese, Mandarin (traditional)
    | Zh_SIM -- ^ Chinese, Simple
    | Ht_HT  -- ^ Creole, Haiti
    | Hr     -- ^ Croatian
    | Cs     -- ^ Czech
    | Da     -- ^ Danish
    | Nl     -- ^ Dutch
    | En     -- ^ English
    | En_AU  -- ^ English, Australia
    | En_BD  -- ^ English, Bangladesh
    | En_HAW -- ^ English, Hawaii
    | En_HBW -- ^ English, HBW
    | En_IN  -- ^ English, India
    | En_IOC -- ^ English, IOC
    | En_KE  -- ^ English, Kenya
    | En_MY  -- ^ English, Malaysia
    | En_NZ  -- ^ English, New Zealand
    | En_PH  -- ^ English, Philippines
    | En_ZA  -- ^ English, South Africa
    | En_AE  -- ^ English, UAE
    | En_UK  -- ^ English, United Kingdon
    | En_US  -- ^ English, United States
    | Fo     -- ^ Faroese
    | Fi     -- ^ Finnish
    | Fr     -- ^ French
    | Fr_AOU -- ^ French, AOU
    | Fr_FR  -- ^ French, France
    | Fr_CA  -- ^ French, Canada
    | Fr_GF  -- ^ French, Guiana
    | Fr_GP  -- ^ French, Guadeloupe
    | Fr_HT  -- ^ French, Haiti
    | Gl     -- ^ Gallegan
    | De     -- ^ German
    | El     -- ^ Greek
    | Gu     -- ^ Gujarati
    | He     -- ^ Hebrew
    | Hi     -- ^ Hindi
    | Hu     -- ^ Hungarian
    | Is     -- ^ Icelandic
    | In     -- ^ Indonesian
    | It     -- ^ Italian
    | Ja     -- ^ Japanese
    | Ko     -- ^ Korean
    | Lv     -- ^ Latvian
    | Lt     -- ^ Lithuanian
    | Ml     -- ^ Malayalam
    | Mr     -- ^ Marathi
    | Mn     -- ^ Mongolian
    | No     -- ^ Norwegian
    | Or     -- ^ Odia
    | Fa     -- ^ Persian
    | Pl     -- ^ Polish
    | Pt_AO  -- ^ Portuguese, Angola
    | Pt_RAA -- ^ Portuguese, Azores
    | Pt_Br  -- ^ Portuguese, Brazil
    | Pt_RAM -- ^ Portuguese, Madeira
    | Pt_PT  -- ^ Portuguese, Portugal
    | Ro     -- ^ Romanian
    | Ru     -- ^ Russian
    | Sr     -- ^ Serbian
    | Sk     -- ^ Slovak
    | Sl     -- ^ Slovenian
    | Es     -- ^ Spanish
    | Es_AR  -- ^ Spanish, Argentina
    | Es_CL  -- ^ Spanish, Chile
    | Es_CR  -- ^ Spanish, Costa Rica
    | Es_CU  -- ^ Spanish, Cuba
    | Es_DO  -- ^ Spanish, Dominican Republic
    | Es_EC  -- ^ Spanish, Ecuador
    | Es_HN  -- ^ Spanish, Honduras
    | Es_MX  -- ^ Spanish, Mexico
    | Es_PA  -- ^ Spanish, Panama
    | Es_PY  -- ^ Spanish, Paraguay
    | Es_PE  -- ^ Spanish, Peru
    | Es_PR  -- ^ Spanish, Puerto Rico
    | Es_ES  -- ^ Spanish, Spain
    | Es_UY  -- ^ Spanish, Uruguay
    | Es_VE  -- ^ Spanish, Venezuela
    | Sv     -- ^ Swedish
    | Te     -- ^ Telugu
    | Th     -- ^ Thai
    | Tr     -- ^ Turkish
    | Uk     -- ^ Ukrainian
  deriving (Int -> SPPLocale -> ShowS
[SPPLocale] -> ShowS
SPPLocale -> String
(Int -> SPPLocale -> ShowS)
-> (SPPLocale -> String)
-> ([SPPLocale] -> ShowS)
-> Show SPPLocale
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SPPLocale -> ShowS
showsPrec :: Int -> SPPLocale -> ShowS
$cshow :: SPPLocale -> String
show :: SPPLocale -> String
$cshowList :: [SPPLocale] -> ShowS
showList :: [SPPLocale] -> ShowS
Show, ReadPrec [SPPLocale]
ReadPrec SPPLocale
Int -> ReadS SPPLocale
ReadS [SPPLocale]
(Int -> ReadS SPPLocale)
-> ReadS [SPPLocale]
-> ReadPrec SPPLocale
-> ReadPrec [SPPLocale]
-> Read SPPLocale
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SPPLocale
readsPrec :: Int -> ReadS SPPLocale
$creadList :: ReadS [SPPLocale]
readList :: ReadS [SPPLocale]
$creadPrec :: ReadPrec SPPLocale
readPrec :: ReadPrec SPPLocale
$creadListPrec :: ReadPrec [SPPLocale]
readListPrec :: ReadPrec [SPPLocale]
Read, SPPLocale -> SPPLocale -> Bool
(SPPLocale -> SPPLocale -> Bool)
-> (SPPLocale -> SPPLocale -> Bool) -> Eq SPPLocale
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SPPLocale -> SPPLocale -> Bool
== :: SPPLocale -> SPPLocale -> Bool
$c/= :: SPPLocale -> SPPLocale -> Bool
/= :: SPPLocale -> SPPLocale -> Bool
Eq)

-- | Values returned from the 'Data.EBird.API.TaxaLocaleCodesAPI'.
data SPPLocaleListEntry =
    SPPLocaleListEntry
      { -- | The code of the locale, e.g. 'En_US'
        SPPLocaleListEntry -> SPPLocale
_sppLocaleListEntryCode :: SPPLocale

        -- | The name, e.g. "English (United States)"
      , SPPLocaleListEntry -> Text
_sppLocaleListEntryName :: Text

        -- | The date and time of the last update for this locale
      , SPPLocaleListEntry -> Text
_sppLocaleListEntryLastUpdate :: Text
      }
  deriving (Int -> SPPLocaleListEntry -> ShowS
[SPPLocaleListEntry] -> ShowS
SPPLocaleListEntry -> String
(Int -> SPPLocaleListEntry -> ShowS)
-> (SPPLocaleListEntry -> String)
-> ([SPPLocaleListEntry] -> ShowS)
-> Show SPPLocaleListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SPPLocaleListEntry -> ShowS
showsPrec :: Int -> SPPLocaleListEntry -> ShowS
$cshow :: SPPLocaleListEntry -> String
show :: SPPLocaleListEntry -> String
$cshowList :: [SPPLocaleListEntry] -> ShowS
showList :: [SPPLocaleListEntry] -> ShowS
Show, ReadPrec [SPPLocaleListEntry]
ReadPrec SPPLocaleListEntry
Int -> ReadS SPPLocaleListEntry
ReadS [SPPLocaleListEntry]
(Int -> ReadS SPPLocaleListEntry)
-> ReadS [SPPLocaleListEntry]
-> ReadPrec SPPLocaleListEntry
-> ReadPrec [SPPLocaleListEntry]
-> Read SPPLocaleListEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SPPLocaleListEntry
readsPrec :: Int -> ReadS SPPLocaleListEntry
$creadList :: ReadS [SPPLocaleListEntry]
readList :: ReadS [SPPLocaleListEntry]
$creadPrec :: ReadPrec SPPLocaleListEntry
readPrec :: ReadPrec SPPLocaleListEntry
$creadListPrec :: ReadPrec [SPPLocaleListEntry]
readListPrec :: ReadPrec [SPPLocaleListEntry]
Read, SPPLocaleListEntry -> SPPLocaleListEntry -> Bool
(SPPLocaleListEntry -> SPPLocaleListEntry -> Bool)
-> (SPPLocaleListEntry -> SPPLocaleListEntry -> Bool)
-> Eq SPPLocaleListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SPPLocaleListEntry -> SPPLocaleListEntry -> Bool
== :: SPPLocaleListEntry -> SPPLocaleListEntry -> Bool
$c/= :: SPPLocaleListEntry -> SPPLocaleListEntry -> Bool
/= :: SPPLocaleListEntry -> SPPLocaleListEntry -> Bool
Eq)

-- | Values represent the different ways that taxonomic groups may be grouped.
-- 'MerlinGrouping' puts like birds together, with falcons next to hawks.
-- 'EBirdGrouping' follows taxonomic order.
data SPPGrouping = MerlinGrouping | EBirdGrouping
  deriving (Int -> SPPGrouping -> ShowS
[SPPGrouping] -> ShowS
SPPGrouping -> String
(Int -> SPPGrouping -> ShowS)
-> (SPPGrouping -> String)
-> ([SPPGrouping] -> ShowS)
-> Show SPPGrouping
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SPPGrouping -> ShowS
showsPrec :: Int -> SPPGrouping -> ShowS
$cshow :: SPPGrouping -> String
show :: SPPGrouping -> String
$cshowList :: [SPPGrouping] -> ShowS
showList :: [SPPGrouping] -> ShowS
Show, ReadPrec [SPPGrouping]
ReadPrec SPPGrouping
Int -> ReadS SPPGrouping
ReadS [SPPGrouping]
(Int -> ReadS SPPGrouping)
-> ReadS [SPPGrouping]
-> ReadPrec SPPGrouping
-> ReadPrec [SPPGrouping]
-> Read SPPGrouping
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS SPPGrouping
readsPrec :: Int -> ReadS SPPGrouping
$creadList :: ReadS [SPPGrouping]
readList :: ReadS [SPPGrouping]
$creadPrec :: ReadPrec SPPGrouping
readPrec :: ReadPrec SPPGrouping
$creadListPrec :: ReadPrec [SPPGrouping]
readListPrec :: ReadPrec [SPPGrouping]
Read, SPPGrouping -> SPPGrouping -> Bool
(SPPGrouping -> SPPGrouping -> Bool)
-> (SPPGrouping -> SPPGrouping -> Bool) -> Eq SPPGrouping
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SPPGrouping -> SPPGrouping -> Bool
== :: SPPGrouping -> SPPGrouping -> Bool
$c/= :: SPPGrouping -> SPPGrouping -> Bool
/= :: SPPGrouping -> SPPGrouping -> Bool
Eq)

-- | Values returned by the 'Data.EBird.API.TaxonomicGroupsAPI'.
data TaxonomicGroupListEntry =
    TaxonomicGroupListEntry
      { -- | Name of the group, e.g. \"Waterfowl\"
        TaxonomicGroupListEntry -> Text
_taxonomicGroupListEntryName :: Text

        -- | Numeric value determining the location of this group in the list
      , TaxonomicGroupListEntry -> Integer
_taxonomicGroupListEntryOrder :: Integer

        -- | The bounds of the ordering, depending on the grouping
      , TaxonomicGroupListEntry -> [(Integer, Integer)]
_taxonomicGroupListEntryOrderBounds :: [(Integer, Integer)]
      }
  deriving (Int -> TaxonomicGroupListEntry -> ShowS
[TaxonomicGroupListEntry] -> ShowS
TaxonomicGroupListEntry -> String
(Int -> TaxonomicGroupListEntry -> ShowS)
-> (TaxonomicGroupListEntry -> String)
-> ([TaxonomicGroupListEntry] -> ShowS)
-> Show TaxonomicGroupListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxonomicGroupListEntry -> ShowS
showsPrec :: Int -> TaxonomicGroupListEntry -> ShowS
$cshow :: TaxonomicGroupListEntry -> String
show :: TaxonomicGroupListEntry -> String
$cshowList :: [TaxonomicGroupListEntry] -> ShowS
showList :: [TaxonomicGroupListEntry] -> ShowS
Show, ReadPrec [TaxonomicGroupListEntry]
ReadPrec TaxonomicGroupListEntry
Int -> ReadS TaxonomicGroupListEntry
ReadS [TaxonomicGroupListEntry]
(Int -> ReadS TaxonomicGroupListEntry)
-> ReadS [TaxonomicGroupListEntry]
-> ReadPrec TaxonomicGroupListEntry
-> ReadPrec [TaxonomicGroupListEntry]
-> Read TaxonomicGroupListEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxonomicGroupListEntry
readsPrec :: Int -> ReadS TaxonomicGroupListEntry
$creadList :: ReadS [TaxonomicGroupListEntry]
readList :: ReadS [TaxonomicGroupListEntry]
$creadPrec :: ReadPrec TaxonomicGroupListEntry
readPrec :: ReadPrec TaxonomicGroupListEntry
$creadListPrec :: ReadPrec [TaxonomicGroupListEntry]
readListPrec :: ReadPrec [TaxonomicGroupListEntry]
Read, TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool
(TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool)
-> (TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool)
-> Eq TaxonomicGroupListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool
== :: TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool
$c/= :: TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool
/= :: TaxonomicGroupListEntry -> TaxonomicGroupListEntry -> Bool
Eq)

-- | Values returned by the 'Data.EBird.API.TaxonomyVersionsAPI'.
data TaxonomyVersionListEntry =
    TaxonomyVersionListEntry
      { TaxonomyVersionListEntry -> Double
_taxonomyVersionAuthorityVersion :: Double
      , TaxonomyVersionListEntry -> Bool
_taxonomyVersionLatest :: Bool
      }
  deriving (Int -> TaxonomyVersionListEntry -> ShowS
[TaxonomyVersionListEntry] -> ShowS
TaxonomyVersionListEntry -> String
(Int -> TaxonomyVersionListEntry -> ShowS)
-> (TaxonomyVersionListEntry -> String)
-> ([TaxonomyVersionListEntry] -> ShowS)
-> Show TaxonomyVersionListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TaxonomyVersionListEntry -> ShowS
showsPrec :: Int -> TaxonomyVersionListEntry -> ShowS
$cshow :: TaxonomyVersionListEntry -> String
show :: TaxonomyVersionListEntry -> String
$cshowList :: [TaxonomyVersionListEntry] -> ShowS
showList :: [TaxonomyVersionListEntry] -> ShowS
Show, ReadPrec [TaxonomyVersionListEntry]
ReadPrec TaxonomyVersionListEntry
Int -> ReadS TaxonomyVersionListEntry
ReadS [TaxonomyVersionListEntry]
(Int -> ReadS TaxonomyVersionListEntry)
-> ReadS [TaxonomyVersionListEntry]
-> ReadPrec TaxonomyVersionListEntry
-> ReadPrec [TaxonomyVersionListEntry]
-> Read TaxonomyVersionListEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TaxonomyVersionListEntry
readsPrec :: Int -> ReadS TaxonomyVersionListEntry
$creadList :: ReadS [TaxonomyVersionListEntry]
readList :: ReadS [TaxonomyVersionListEntry]
$creadPrec :: ReadPrec TaxonomyVersionListEntry
readPrec :: ReadPrec TaxonomyVersionListEntry
$creadListPrec :: ReadPrec [TaxonomyVersionListEntry]
readListPrec :: ReadPrec [TaxonomyVersionListEntry]
Read, TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool
(TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool)
-> (TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool)
-> Eq TaxonomyVersionListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool
== :: TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool
$c/= :: TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool
/= :: TaxonomyVersionListEntry -> TaxonomyVersionListEntry -> Bool
Eq)

-- ** Optics for taxonomy-related types

makeLenses ''SPPLocaleListEntry
makeFieldLabels ''SPPLocaleListEntry
makeLenses ''TaxonomicGroupListEntry
makeFieldLabels ''TaxonomicGroupListEntry
makeLenses ''TaxonomyVersionListEntry
makeFieldLabels ''TaxonomyVersionListEntry

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

-- | Explicit instance for compatibility with their field names
instance FromJSON Taxon where
  parseJSON :: Value -> Parser Taxon
parseJSON = String -> (Object -> Parser Taxon) -> Value -> Parser Taxon
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"Taxon" ((Object -> Parser Taxon) -> Value -> Parser Taxon)
-> (Object -> Parser Taxon) -> Value -> Parser Taxon
forall a b. (a -> b) -> a -> b
$ \Object
v ->
          Text
-> Text
-> SpeciesCode
-> TaxonomyCategory
-> Double
-> [Text]
-> [Text]
-> [Text]
-> Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Taxon
Taxon
      (Text
 -> Text
 -> SpeciesCode
 -> TaxonomyCategory
 -> Double
 -> [Text]
 -> [Text]
 -> [Text]
 -> Text
 -> Maybe Text
 -> Maybe Text
 -> Maybe Text
 -> Taxon)
-> Parser Text
-> Parser
     (Text
      -> SpeciesCode
      -> TaxonomyCategory
      -> Double
      -> [Text]
      -> [Text]
      -> [Text]
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Taxon)
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
"sciName"
      Parser
  (Text
   -> SpeciesCode
   -> TaxonomyCategory
   -> Double
   -> [Text]
   -> [Text]
   -> [Text]
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Taxon)
-> Parser Text
-> Parser
     (SpeciesCode
      -> TaxonomyCategory
      -> Double
      -> [Text]
      -> [Text]
      -> [Text]
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Taxon)
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
  (SpeciesCode
   -> TaxonomyCategory
   -> Double
   -> [Text]
   -> [Text]
   -> [Text]
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Taxon)
-> Parser SpeciesCode
-> Parser
     (TaxonomyCategory
      -> Double
      -> [Text]
      -> [Text]
      -> [Text]
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Taxon)
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 SpeciesCode
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"speciesCode"
      Parser
  (TaxonomyCategory
   -> Double
   -> [Text]
   -> [Text]
   -> [Text]
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Taxon)
-> Parser TaxonomyCategory
-> Parser
     (Double
      -> [Text]
      -> [Text]
      -> [Text]
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Taxon)
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 TaxonomyCategory
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"category"
      Parser
  (Double
   -> [Text]
   -> [Text]
   -> [Text]
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Taxon)
-> Parser Double
-> Parser
     ([Text]
      -> [Text]
      -> [Text]
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Taxon)
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
"taxonOrder"
      Parser
  ([Text]
   -> [Text]
   -> [Text]
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Taxon)
-> Parser [Text]
-> Parser
     ([Text]
      -> [Text]
      -> Text
      -> Maybe Text
      -> Maybe Text
      -> Maybe Text
      -> Taxon)
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
"bandingCodes"
      Parser
  ([Text]
   -> [Text]
   -> Text
   -> Maybe Text
   -> Maybe Text
   -> Maybe Text
   -> Taxon)
-> Parser [Text]
-> Parser
     ([Text] -> Text -> Maybe Text -> Maybe Text -> Maybe Text -> Taxon)
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
"comNameCodes"
      Parser
  ([Text] -> Text -> Maybe Text -> Maybe Text -> Maybe Text -> Taxon)
-> Parser [Text]
-> Parser (Text -> Maybe Text -> Maybe Text -> Maybe Text -> Taxon)
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
"sciNameCodes"
      Parser (Text -> Maybe Text -> Maybe Text -> Maybe Text -> Taxon)
-> Parser Text
-> Parser (Maybe Text -> Maybe Text -> Maybe Text -> Taxon)
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
"order"
      Parser (Maybe Text -> Maybe Text -> Maybe Text -> Taxon)
-> Parser (Maybe Text)
-> Parser (Maybe Text -> Maybe Text -> Taxon)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"familyCode"
      Parser (Maybe Text -> Maybe Text -> Taxon)
-> Parser (Maybe Text) -> Parser (Maybe Text -> Taxon)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"familyComName"
      Parser (Maybe Text -> Taxon) -> Parser (Maybe Text) -> Parser Taxon
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser (Maybe Text)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"familySciName"


-- | Explicit instance for compatibility with their field names
instance ToJSON Taxon where
  toJSON :: Taxon -> Value
toJSON Taxon{Double
[Text]
Maybe Text
Text
TaxonomyCategory
SpeciesCode
_taxonScientificName :: Taxon -> Text
_taxonCommonName :: Taxon -> Text
_taxonSpeciesCode :: Taxon -> SpeciesCode
_taxonCategory :: Taxon -> TaxonomyCategory
_taxonTaxonOrder :: Taxon -> Double
_taxonBandingCodes :: Taxon -> [Text]
_taxonCommonNameCodes :: Taxon -> [Text]
_taxonScientificNameCodes :: Taxon -> [Text]
_taxonOrder :: Taxon -> Text
_taxonFamilyCode :: Taxon -> Maybe Text
_taxonFamilyCommonName :: Taxon -> Maybe Text
_taxonFamilyScientificName :: Taxon -> Maybe Text
_taxonScientificName :: Text
_taxonCommonName :: Text
_taxonSpeciesCode :: SpeciesCode
_taxonCategory :: TaxonomyCategory
_taxonTaxonOrder :: Double
_taxonBandingCodes :: [Text]
_taxonCommonNameCodes :: [Text]
_taxonScientificNameCodes :: [Text]
_taxonOrder :: Text
_taxonFamilyCode :: Maybe Text
_taxonFamilyCommonName :: Maybe Text
_taxonFamilyScientificName :: Maybe Text
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"sciName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_taxonScientificName
        , Key
"comName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_taxonCommonName
        , Key
"speciesCode" Key -> SpeciesCode -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SpeciesCode
_taxonSpeciesCode
        , Key
"category" Key -> TaxonomyCategory -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= TaxonomyCategory
_taxonCategory
        , Key
"taxonOrder" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_taxonTaxonOrder
        , Key
"bandingCodes" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Text]
_taxonBandingCodes
        , Key
"comNameCodes" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Text]
_taxonCommonNameCodes
        , Key
"sciNameCodes" Key -> [Text] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [Text]
_taxonScientificNameCodes
        , Key
"order" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_taxonOrder
        , Key
"familyComName" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
_taxonFamilyCommonName
        , Key
"familySciName" Key -> Maybe Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Maybe Text
_taxonFamilyScientificName
        ]
        -- Fields that may or may not be included
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"familyCode" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
c | Just Text
c <- [Maybe Text
_taxonFamilyCode]]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"familyComName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
n | Just Text
n <- [Maybe Text
_taxonFamilyCommonName]]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [ Key
"familySciName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
n | Just Text
n <- [Maybe Text
_taxonFamilyScientificName]]

instance FromJSON SpeciesCode where
  parseJSON :: Value -> Parser SpeciesCode
parseJSON = String
-> (Text -> Parser SpeciesCode) -> Value -> Parser SpeciesCode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SpeciesCode" (SpeciesCode -> Parser SpeciesCode
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SpeciesCode -> Parser SpeciesCode)
-> (Text -> SpeciesCode) -> Text -> Parser SpeciesCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> SpeciesCode
SpeciesCode)

instance ToJSON SpeciesCode where
  toJSON :: SpeciesCode -> Value
toJSON SpeciesCode{Text
speciesCode :: SpeciesCode -> Text
speciesCode :: Text
..} = Text -> Value
String Text
speciesCode

instance FromJSON SpeciesCodes where
  parseJSON :: Value -> Parser SpeciesCodes
parseJSON = String
-> (Array -> Parser SpeciesCodes) -> Value -> Parser SpeciesCodes
forall a. String -> (Array -> Parser a) -> Value -> Parser a
withArray String
"SpeciesCodes" ((Array -> Parser SpeciesCodes) -> Value -> Parser SpeciesCodes)
-> (Array -> Parser SpeciesCodes) -> Value -> Parser SpeciesCodes
forall a b. (a -> b) -> a -> b
$
      (Vector SpeciesCode -> SpeciesCodes)
-> Parser (Vector SpeciesCode) -> Parser SpeciesCodes
forall a b. (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ([SpeciesCode] -> SpeciesCodes
SpeciesCodes ([SpeciesCode] -> SpeciesCodes)
-> (Vector SpeciesCode -> [SpeciesCode])
-> Vector SpeciesCode
-> SpeciesCodes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector SpeciesCode -> [Item (Vector SpeciesCode)]
Vector SpeciesCode -> [SpeciesCode]
forall l. IsList l => l -> [Item l]
toList) (Parser (Vector SpeciesCode) -> Parser SpeciesCodes)
-> (Array -> Parser (Vector SpeciesCode))
-> Array
-> Parser SpeciesCodes
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Parser SpeciesCode)
-> Array -> Parser (Vector SpeciesCode)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Vector a -> f (Vector b)
traverse Value -> Parser SpeciesCode
forall a. FromJSON a => Value -> Parser a
parseJSON

instance ToJSON SpeciesCodes where
  toJSON :: SpeciesCodes -> Value
toJSON = Array -> Value
Array (Array -> Value)
-> (SpeciesCodes -> Array) -> SpeciesCodes -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item Array] -> Array
[Value] -> Array
forall l. IsList l => [Item l] -> l
fromList ([Value] -> Array)
-> (SpeciesCodes -> [Value]) -> SpeciesCodes -> Array
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpeciesCode -> Value) -> [SpeciesCode] -> [Value]
forall a b. (a -> b) -> [a] -> [b]
map SpeciesCode -> Value
forall a. ToJSON a => a -> Value
toJSON ([SpeciesCode] -> [Value])
-> (SpeciesCodes -> [SpeciesCode]) -> SpeciesCodes -> [Value]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeciesCodes -> [SpeciesCode]
speciesCodes

instance FromJSON TaxonomyCategory where
  parseJSON :: Value -> Parser TaxonomyCategory
parseJSON = String
-> (Text -> Parser TaxonomyCategory)
-> Value
-> Parser TaxonomyCategory
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"TaxonomyCategory" ((Text -> Parser TaxonomyCategory)
 -> Value -> Parser TaxonomyCategory)
-> (Text -> Parser TaxonomyCategory)
-> Value
-> Parser TaxonomyCategory
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Parser TaxonomyCategory -> Text -> Either String TaxonomyCategory
forall a. Parser a -> Text -> Either String a
parseOnly Parser TaxonomyCategory
parseTaxonomyCategory Text
t of
        Left String
_ -> String -> Parser TaxonomyCategory
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse taxonomy category"
        Right TaxonomyCategory
r -> TaxonomyCategory -> Parser TaxonomyCategory
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return TaxonomyCategory
r

instance ToJSON TaxonomyCategory where
  toJSON :: TaxonomyCategory -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (TaxonomyCategory -> Text) -> TaxonomyCategory -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TaxonomyCategory -> Text
forall a. EBirdString a => a -> Text
toEBirdString

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

-- | Explicit instance for compatibility with their field names
instance ToJSON TaxonomyVersionListEntry where
  toJSON :: TaxonomyVersionListEntry -> Value
toJSON TaxonomyVersionListEntry{Bool
Double
_taxonomyVersionAuthorityVersion :: TaxonomyVersionListEntry -> Double
_taxonomyVersionLatest :: TaxonomyVersionListEntry -> Bool
_taxonomyVersionAuthorityVersion :: Double
_taxonomyVersionLatest :: Bool
..} =
      [Pair] -> Value
object
        [ Key
"authorityVer" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_taxonomyVersionAuthorityVersion
        , Key
"latest" Key -> Bool -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Bool
_taxonomyVersionLatest
        ]

instance FromJSON SPPLocale where
  parseJSON :: Value -> Parser SPPLocale
parseJSON = String -> (Text -> Parser SPPLocale) -> Value -> Parser SPPLocale
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"SPPLocale" ((Text -> Parser SPPLocale) -> Value -> Parser SPPLocale)
-> (Text -> Parser SPPLocale) -> Value -> Parser SPPLocale
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Parser SPPLocale -> Text -> Either String SPPLocale
forall a. Parser a -> Text -> Either String a
parseOnly Parser SPPLocale
parseSPPLocale Text
t of
        Left String
_ -> String -> Parser SPPLocale
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SPPLocale) -> String -> Parser SPPLocale
forall a b. (a -> b) -> a -> b
$ String
"failed to parse spp locale: " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Text -> String
Text.unpack Text
t
        Right SPPLocale
r -> SPPLocale -> Parser SPPLocale
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return SPPLocale
r

instance ToJSON SPPLocale where
  toJSON :: SPPLocale -> Value
toJSON = Text -> Value
String (Text -> Value) -> (SPPLocale -> Text) -> SPPLocale -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SPPLocale -> Text
forall a. EBirdString a => a -> Text
toEBirdString

-- | Explicit instance for compatibility with their field names
instance FromJSON SPPLocaleListEntry where
  parseJSON :: Value -> Parser SPPLocaleListEntry
parseJSON = String
-> (Object -> Parser SPPLocaleListEntry)
-> Value
-> Parser SPPLocaleListEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"SPPLocaleListEntry" ((Object -> Parser SPPLocaleListEntry)
 -> Value -> Parser SPPLocaleListEntry)
-> (Object -> Parser SPPLocaleListEntry)
-> Value
-> Parser SPPLocaleListEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
          SPPLocale -> Text -> Text -> SPPLocaleListEntry
SPPLocaleListEntry
      (SPPLocale -> Text -> Text -> SPPLocaleListEntry)
-> Parser SPPLocale -> Parser (Text -> Text -> SPPLocaleListEntry)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
v Object -> Key -> Parser SPPLocale
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"code"
      Parser (Text -> Text -> SPPLocaleListEntry)
-> Parser Text -> Parser (Text -> SPPLocaleListEntry)
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
"name"
      Parser (Text -> SPPLocaleListEntry)
-> Parser Text -> Parser SPPLocaleListEntry
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
"lastUpdate"

-- | Explicit instance for compatibility with their field names
instance ToJSON SPPLocaleListEntry where
  toJSON :: SPPLocaleListEntry -> Value
toJSON SPPLocaleListEntry{Text
SPPLocale
_sppLocaleListEntryCode :: SPPLocaleListEntry -> SPPLocale
_sppLocaleListEntryName :: SPPLocaleListEntry -> Text
_sppLocaleListEntryLastUpdate :: SPPLocaleListEntry -> Text
_sppLocaleListEntryCode :: SPPLocale
_sppLocaleListEntryName :: Text
_sppLocaleListEntryLastUpdate :: Text
..} =
      [Pair] -> Value
object
        [ Key
"code" Key -> SPPLocale -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= SPPLocale
_sppLocaleListEntryCode
        , Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_sppLocaleListEntryName
        , Key
"lastUpdate" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_sppLocaleListEntryLastUpdate
        ]

-- | Explicit instance for compatibility with their field names
instance FromJSON TaxonomicGroupListEntry where
  parseJSON :: Value -> Parser TaxonomicGroupListEntry
parseJSON = String
-> (Object -> Parser TaxonomicGroupListEntry)
-> Value
-> Parser TaxonomicGroupListEntry
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"TaxonomicGroupListEntry" ((Object -> Parser TaxonomicGroupListEntry)
 -> Value -> Parser TaxonomicGroupListEntry)
-> (Object -> Parser TaxonomicGroupListEntry)
-> Value
-> Parser TaxonomicGroupListEntry
forall a b. (a -> b) -> a -> b
$ \Object
v ->
          Text -> Integer -> [(Integer, Integer)] -> TaxonomicGroupListEntry
TaxonomicGroupListEntry
      (Text
 -> Integer -> [(Integer, Integer)] -> TaxonomicGroupListEntry)
-> Parser Text
-> Parser
     (Integer -> [(Integer, Integer)] -> TaxonomicGroupListEntry)
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
"groupName"
      Parser (Integer -> [(Integer, Integer)] -> TaxonomicGroupListEntry)
-> Parser Integer
-> Parser ([(Integer, Integer)] -> TaxonomicGroupListEntry)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser Integer
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"groupOrder"
      Parser ([(Integer, Integer)] -> TaxonomicGroupListEntry)
-> Parser [(Integer, Integer)] -> Parser TaxonomicGroupListEntry
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
v Object -> Key -> Parser [(Integer, Integer)]
forall a. FromJSON a => Object -> Key -> Parser a
.: Key
"taxonOrderBounds"

-- | Explicit instance for compatibility with their field names
instance ToJSON TaxonomicGroupListEntry where
  toJSON :: TaxonomicGroupListEntry -> Value
toJSON TaxonomicGroupListEntry{Integer
[(Integer, Integer)]
Text
_taxonomicGroupListEntryName :: TaxonomicGroupListEntry -> Text
_taxonomicGroupListEntryOrder :: TaxonomicGroupListEntry -> Integer
_taxonomicGroupListEntryOrderBounds :: TaxonomicGroupListEntry -> [(Integer, Integer)]
_taxonomicGroupListEntryName :: Text
_taxonomicGroupListEntryOrder :: Integer
_taxonomicGroupListEntryOrderBounds :: [(Integer, Integer)]
..} =
      [Pair] -> Value
object
        [ Key
"groupName" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_taxonomicGroupListEntryName
        , Key
"groupOrder" Key -> Integer -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Integer
_taxonomicGroupListEntryOrder
        , Key
"taxonOrderBounds" Key -> [(Integer, Integer)] -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= [(Integer, Integer)]
_taxonomicGroupListEntryOrderBounds
        ]

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

-- | The eBird strings of the taxonomy categories are simply the lowercase
-- constructor names.
instance EBirdString TaxonomyCategory where
  toEBirdString :: TaxonomyCategory -> Text
toEBirdString =
      \case
        TaxonomyCategory
Species -> Text
"species"
        TaxonomyCategory
ISSF -> Text
"issf"
        TaxonomyCategory
Spuh -> Text
"spuh"
        TaxonomyCategory
Slash -> Text
"slash"
        TaxonomyCategory
Hybrid -> Text
"hybrid"
        TaxonomyCategory
Intergrade -> Text
"intergrade"
        TaxonomyCategory
Domestic -> Text
"domestic"
        TaxonomyCategory
Form -> Text
"form"

  fromEBirdString :: Text -> Either Text TaxonomyCategory
fromEBirdString Text
str =
        Parser TaxonomyCategory -> Text -> Either String TaxonomyCategory
forall a. Parser a -> Text -> Either String a
parseOnly Parser TaxonomyCategory
parseTaxonomyCategory Text
str
      Either String TaxonomyCategory
-> (Either String TaxonomyCategory -> Either Text TaxonomyCategory)
-> Either Text TaxonomyCategory
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String TaxonomyCategory -> Either Text TaxonomyCategory
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 TaxonomyCategory: " 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 of a 'TaxonomyCategories' is the comma-separated list of
-- category strings.
instance EBirdString TaxonomyCategories where
  toEBirdString :: TaxonomyCategories -> Text
toEBirdString (TaxonomyCategories (TaxonomyCategory
c :| [TaxonomyCategory]
cs)) =
      Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (TaxonomyCategory -> Text) -> [TaxonomyCategory] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map TaxonomyCategory -> Text
forall a. EBirdString a => a -> Text
toEBirdString (TaxonomyCategory
c TaxonomyCategory -> [TaxonomyCategory] -> [TaxonomyCategory]
forall a. a -> [a] -> [a]
: [TaxonomyCategory]
cs)

  fromEBirdString :: Text -> Either Text TaxonomyCategories
fromEBirdString Text
str =
        Parser TaxonomyCategories
-> Text -> Either String TaxonomyCategories
forall a. Parser a -> Text -> Either String a
parseOnly Parser TaxonomyCategories
parseTaxonomyCategories Text
str
      Either String TaxonomyCategories
-> (Either String TaxonomyCategories
    -> Either Text TaxonomyCategories)
-> Either Text TaxonomyCategories
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String TaxonomyCategories
-> Either Text TaxonomyCategories
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 TaxonomyCategories: " 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 of a 'SpeciesCode' is simply the literal string
instance EBirdString SpeciesCode where
  toEBirdString :: SpeciesCode -> Text
toEBirdString (SpeciesCode Text
c) = Text
c

  fromEBirdString :: Text -> Either Text SpeciesCode
fromEBirdString Text
str =
        Parser SpeciesCode -> Text -> Either String SpeciesCode
forall a. Parser a -> Text -> Either String a
parseOnly Parser SpeciesCode
parseSpeciesCode Text
str
      Either String SpeciesCode
-> (Either String SpeciesCode -> Either Text SpeciesCode)
-> Either Text SpeciesCode
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String SpeciesCode -> Either Text SpeciesCode
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 SpeciesCode: " 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 of a 'SpeciesCodes' is simply the comma-separated
-- 'SpeciesCode's
instance EBirdString SpeciesCodes where
  toEBirdString :: SpeciesCodes -> Text
toEBirdString (SpeciesCodes [SpeciesCode]
cs) = Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (SpeciesCode -> Text) -> [SpeciesCode] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SpeciesCode -> Text
forall a. EBirdString a => a -> Text
toEBirdString [SpeciesCode]
cs

  fromEBirdString :: Text -> Either Text SpeciesCodes
fromEBirdString Text
str =
        Parser SpeciesCodes -> Text -> Either String SpeciesCodes
forall a. Parser a -> Text -> Either String a
parseOnly Parser SpeciesCodes
parseSpeciesCodes Text
str
      Either String SpeciesCodes
-> (Either String SpeciesCodes -> Either Text SpeciesCodes)
-> Either Text SpeciesCodes
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String SpeciesCodes -> Either Text SpeciesCodes
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 SpeciesCodes: " 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 strings of the species locales are simply the lowercase
-- constructor names.
instance EBirdString SPPLocale where
  toEBirdString :: SPPLocale -> Text
toEBirdString =
      \case
        SPPLocale
Af -> Text
"af"
        SPPLocale
Sq -> Text
"sq"
        SPPLocale
Ar -> Text
"ar"
        SPPLocale
Hy -> Text
"hy"
        SPPLocale
As -> Text
"as"
        SPPLocale
Ast -> Text
"ast"
        SPPLocale
Az -> Text
"az"
        SPPLocale
Eu -> Text
"eu"
        SPPLocale
Bn -> Text
"bn"
        SPPLocale
Bg -> Text
"bg"
        SPPLocale
Ca -> Text
"ca"
        SPPLocale
Zh -> Text
"zh"
        SPPLocale
Zh_SIM -> Text
"zh_SIM"
        SPPLocale
Ht_HT -> Text
"ht_HT"
        SPPLocale
Hr -> Text
"hr"
        SPPLocale
Cs -> Text
"cs"
        SPPLocale
Da -> Text
"da"
        SPPLocale
Nl -> Text
"nl"
        SPPLocale
En -> Text
"en"
        SPPLocale
En_AU -> Text
"en_AU"
        SPPLocale
En_BD -> Text
"en_BD"
        SPPLocale
En_HAW -> Text
"en_HAW"
        SPPLocale
En_HBW -> Text
"en_HBW"
        SPPLocale
En_IN -> Text
"en_IN"
        SPPLocale
En_IOC -> Text
"en_IOC"
        SPPLocale
En_KE -> Text
"en_KE"
        SPPLocale
En_MY -> Text
"en_MY"
        SPPLocale
En_NZ -> Text
"en_NZ"
        SPPLocale
En_PH -> Text
"en_PH"
        SPPLocale
En_ZA -> Text
"en_ZA"
        SPPLocale
En_AE -> Text
"en_AE"
        SPPLocale
En_UK -> Text
"en_UK"
        SPPLocale
En_US -> Text
"en_US"
        SPPLocale
Fo -> Text
"fo"
        SPPLocale
Fi -> Text
"fi"
        SPPLocale
Fr -> Text
"fr"
        SPPLocale
Fr_AOU -> Text
"fr_AOU"
        SPPLocale
Fr_FR -> Text
"fr_FR"
        SPPLocale
Fr_CA -> Text
"fr_CA"
        SPPLocale
Fr_GF -> Text
"fr_GF"
        SPPLocale
Fr_GP -> Text
"fr_GP"
        SPPLocale
Fr_HT -> Text
"fr_HT"
        SPPLocale
Gl -> Text
"gl"
        SPPLocale
De -> Text
"de"
        SPPLocale
El -> Text
"el"
        SPPLocale
Gu -> Text
"gu"
        SPPLocale
He -> Text
"he"
        SPPLocale
Hi -> Text
"hi"
        SPPLocale
Hu -> Text
"hu"
        SPPLocale
Is -> Text
"is"
        SPPLocale
In -> Text
"in"
        SPPLocale
It -> Text
"it"
        SPPLocale
Ja -> Text
"ja"
        SPPLocale
Ko -> Text
"ko"
        SPPLocale
Lv -> Text
"lv"
        SPPLocale
Lt -> Text
"lt"
        SPPLocale
Ml -> Text
"ml"
        SPPLocale
Mr -> Text
"mr"
        SPPLocale
Mn -> Text
"mn"
        SPPLocale
No -> Text
"no"
        SPPLocale
Or -> Text
"or"
        SPPLocale
Fa -> Text
"fa"
        SPPLocale
Pl -> Text
"pl"
        SPPLocale
Pt_AO -> Text
"pt_AO"
        SPPLocale
Pt_RAA -> Text
"pt_RAA"
        SPPLocale
Pt_Br -> Text
"pt_BR"
        SPPLocale
Pt_RAM -> Text
"pt_RAM"
        SPPLocale
Pt_PT -> Text
"pt_PT"
        SPPLocale
Ro -> Text
"ro"
        SPPLocale
Ru -> Text
"ru"
        SPPLocale
Sr -> Text
"sr"
        SPPLocale
Sk -> Text
"sk"
        SPPLocale
Sl -> Text
"sl"
        SPPLocale
Es -> Text
"es"
        SPPLocale
Es_AR -> Text
"es_AR"
        SPPLocale
Es_CL -> Text
"es_CL"
        SPPLocale
Es_CR -> Text
"es_CR"
        SPPLocale
Es_CU -> Text
"es_CU"
        SPPLocale
Es_DO -> Text
"es_DO"
        SPPLocale
Es_EC -> Text
"es_EC"
        SPPLocale
Es_HN -> Text
"es_HN"
        SPPLocale
Es_MX -> Text
"es_MX"
        SPPLocale
Es_PA -> Text
"es_PA"
        SPPLocale
Es_PY -> Text
"es_PY"
        SPPLocale
Es_PE -> Text
"es_PE"
        SPPLocale
Es_PR -> Text
"es_PR"
        SPPLocale
Es_ES -> Text
"es_ES"
        SPPLocale
Es_UY -> Text
"es_UY"
        SPPLocale
Es_VE -> Text
"es_VE"
        SPPLocale
Sv -> Text
"sv"
        SPPLocale
Te -> Text
"te"
        SPPLocale
Th -> Text
"th"
        SPPLocale
Tr -> Text
"tr"
        SPPLocale
Uk -> Text
"uk"

  fromEBirdString :: Text -> Either Text SPPLocale
fromEBirdString Text
str =
        Parser SPPLocale -> Text -> Either String SPPLocale
forall a. Parser a -> Text -> Either String a
parseOnly Parser SPPLocale
parseSPPLocale Text
str
      Either String SPPLocale
-> (Either String SPPLocale -> Either Text SPPLocale)
-> Either Text SPPLocale
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String SPPLocale -> Either Text SPPLocale
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 SPPLocale: " 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 of an 'SPPGrouping' is either "merlin" or "ebird"
instance EBirdString SPPGrouping where
  toEBirdString :: SPPGrouping -> Text
toEBirdString =
      \case
        SPPGrouping
MerlinGrouping -> Text
"merlin"
        SPPGrouping
EBirdGrouping -> Text
"ebird"

  fromEBirdString :: Text -> Either Text SPPGrouping
fromEBirdString Text
str =
        Parser SPPGrouping -> Text -> Either String SPPGrouping
forall a. Parser a -> Text -> Either String a
parseOnly Parser SPPGrouping
parseSPPGrouping Text
str
      Either String SPPGrouping
-> (Either String SPPGrouping -> Either Text SPPGrouping)
-> Either Text SPPGrouping
forall a b. a -> (a -> b) -> b
& (String -> Text)
-> Either String SPPGrouping -> Either Text SPPGrouping
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 SPPGrouping: " 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 TaxonomyCategory where
  fromString :: String -> TaxonomyCategory
fromString = Text -> TaxonomyCategory
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> TaxonomyCategory)
-> (String -> Text) -> String -> TaxonomyCategory
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 TaxonomyCategories where
  fromString :: String -> TaxonomyCategories
fromString = Text -> TaxonomyCategories
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> TaxonomyCategories)
-> (String -> Text) -> String -> TaxonomyCategories
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 SpeciesCode where
  fromString :: String -> SpeciesCode
fromString = Text -> SpeciesCode
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> SpeciesCode) -> (String -> Text) -> String -> SpeciesCode
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 SpeciesCodes where
  fromString :: String -> SpeciesCodes
fromString = Text -> SpeciesCodes
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> SpeciesCodes)
-> (String -> Text) -> String -> SpeciesCodes
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 SPPLocale where
  fromString :: String -> SPPLocale
fromString = Text -> SPPLocale
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> SPPLocale) -> (String -> Text) -> String -> SPPLocale
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 SPPGrouping where
  fromString :: String -> SPPGrouping
fromString = Text -> SPPGrouping
forall a. (HasCallStack, EBirdString a) => Text -> a
unsafeFromEBirdString (Text -> SPPGrouping) -> (String -> Text) -> String -> SPPGrouping
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

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

-- | Parse an eBird species code, which we loosely assume is a string of one or
-- more alphanumeric characters.
parseSpeciesCode :: Parser SpeciesCode
parseSpeciesCode :: Parser SpeciesCode
parseSpeciesCode = Text -> SpeciesCode
SpeciesCode (Text -> SpeciesCode) -> (String -> Text) -> String -> SpeciesCode
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack (String -> SpeciesCode) -> Parser Text String -> Parser SpeciesCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Char -> Parser Text String
forall (f :: * -> *) a. Alternative f => f a -> f [a]
many1 ((Char -> Bool) -> Parser Text Char
satisfy Char -> Bool
isAlphaNum)

-- | Parse a comma separated list of zero or more 'SpeciesCode's
parseSpeciesCodes :: Parser SpeciesCodes
parseSpeciesCodes :: Parser SpeciesCodes
parseSpeciesCodes = [SpeciesCode] -> SpeciesCodes
SpeciesCodes ([SpeciesCode] -> SpeciesCodes)
-> Parser Text [SpeciesCode] -> Parser SpeciesCodes
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser SpeciesCode
parseSpeciesCode Parser SpeciesCode -> Parser Text Char -> Parser Text [SpeciesCode]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Text Char
char Char
','

-- | Parse an eBird 'TaxonomyCategory'.
parseTaxonomyCategory :: Parser TaxonomyCategory
parseTaxonomyCategory :: Parser TaxonomyCategory
parseTaxonomyCategory =
    [Parser TaxonomyCategory] -> Parser TaxonomyCategory
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"species" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Species
      , Parser Text Text
"spuh" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Spuh
      , Parser Text Text
"issf" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
ISSF
      , Parser Text Text
"slash" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Slash
      , Parser Text Text
"hybrid" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Hybrid
      , Parser Text Text
"intergrade" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Intergrade
      , Parser Text Text
"domestic" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Domestic
      , Parser Text Text
"form" Parser Text Text -> TaxonomyCategory -> Parser TaxonomyCategory
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TaxonomyCategory
Form
      ]
  where
    _casesCovered :: TaxonomyCategory -> ()
    _casesCovered :: TaxonomyCategory -> ()
_casesCovered =
      \case
        TaxonomyCategory
Species -> ()
        TaxonomyCategory
Spuh -> ()
        TaxonomyCategory
ISSF -> ()
        TaxonomyCategory
Slash -> ()
        TaxonomyCategory
Hybrid -> ()
        TaxonomyCategory
Intergrade -> ()
        TaxonomyCategory
Domestic -> ()
        TaxonomyCategory
Form -> ()

-- | Parse a list of eBird API taxononomy categories. To avoid the partial
-- behavior of converting a 'sepBy1' result into a 'NonEmpty', we manually parse
-- the first category followed by an optional tail.
parseTaxonomyCategories :: Parser TaxonomyCategories
parseTaxonomyCategories :: Parser TaxonomyCategories
parseTaxonomyCategories = do
    TaxonomyCategory
c <- Parser TaxonomyCategory
parseTaxonomyCategory
    [TaxonomyCategory]
cs <- Parser Text Bool
forall t. Chunk t => Parser t Bool
atEnd Parser Text Bool
-> (Bool -> Parser Text [TaxonomyCategory])
-> Parser Text [TaxonomyCategory]
forall a b. Parser Text a -> (a -> Parser Text b) -> Parser Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Bool
True -> [TaxonomyCategory] -> Parser Text [TaxonomyCategory]
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return []
      Bool
False -> do
        (Char -> Bool) -> Parser ()
skip (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
',')
        Parser TaxonomyCategory
parseTaxonomyCategory Parser TaxonomyCategory
-> Parser Text Char -> Parser Text [TaxonomyCategory]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Text Char
char Char
','
    TaxonomyCategories -> Parser TaxonomyCategories
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (TaxonomyCategories -> Parser TaxonomyCategories)
-> TaxonomyCategories -> Parser TaxonomyCategories
forall a b. (a -> b) -> a -> b
$ NonEmpty TaxonomyCategory -> TaxonomyCategories
TaxonomyCategories (TaxonomyCategory
c TaxonomyCategory -> [TaxonomyCategory] -> NonEmpty TaxonomyCategory
forall a. a -> [a] -> NonEmpty a
:| [TaxonomyCategory]
cs)

-- | Parse an eBird 'SPPLocale'.
parseSPPLocale :: Parser SPPLocale
parseSPPLocale :: Parser SPPLocale
parseSPPLocale =
    [Parser SPPLocale] -> Parser SPPLocale
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"af" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Af
      , Parser Text Text
"sq" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Sq
      , Parser Text Text
"ar" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ar
      , Parser Text Text
"hy" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Hy
      , Parser Text Text
"as" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
As
      , Parser Text Text
"ast" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ast
      , Parser Text Text
"az" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Az
      , Parser Text Text
"eu" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Eu
      , Parser Text Text
"bn" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Bn
      , Parser Text Text
"bg" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Bg
      , Parser Text Text
"ca" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ca
      , Parser Text Text
"zh" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Zh
      , Parser Text Text
"zh_SIM" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Zh_SIM
      , Parser Text Text
"ht_HT" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ht_HT
      , Parser Text Text
"hr" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Hr
      , Parser Text Text
"cs" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Cs
      , Parser Text Text
"da" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Da
      , Parser Text Text
"nl" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Nl
      , Parser Text Text
"en" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En
      , Parser Text Text
"en_AU" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_AU
      , Parser Text Text
"en_BD" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_BD
      , Parser Text Text
"en_HAW" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_HAW
      , Parser Text Text
"en_HBW" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_HBW
      , Parser Text Text
"en_IN" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_IN
      , Parser Text Text
"en_IOC" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_IOC
      , Parser Text Text
"en_KE" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_KE
      , Parser Text Text
"en_MY" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_MY
      , Parser Text Text
"en_NZ" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_NZ
      , Parser Text Text
"en_PH" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_PH
      , Parser Text Text
"en_ZA" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_ZA
      , Parser Text Text
"en_AE" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_AE
      , Parser Text Text
"en_UK" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_UK
      , Parser Text Text
"en_US" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
En_US
      , Parser Text Text
"fo" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fo
      , Parser Text Text
"fi" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fi
      , Parser Text Text
"fr" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr
      , Parser Text Text
"fr_AOU" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr_AOU
      , Parser Text Text
"fr_FR" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr_FR
      , Parser Text Text
"fr_CA" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr_CA
      , Parser Text Text
"fr_GF" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr_GF
      , Parser Text Text
"fr_GP" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr_GP
      , Parser Text Text
"fr_HT" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fr_HT
      , Parser Text Text
"gl" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Gl
      , Parser Text Text
"de" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
De
      , Parser Text Text
"el" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
El
      , Parser Text Text
"gu" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Gu
      , Parser Text Text
"he" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
He
      , Parser Text Text
"hi" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Hi
      , Parser Text Text
"hu" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Hu
      , Parser Text Text
"is" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Is
      , Parser Text Text
"in" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
In
      , Parser Text Text
"it" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
It
      , Parser Text Text
"ja" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ja
      , Parser Text Text
"ko" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ko
      , Parser Text Text
"lv" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Lv
      , Parser Text Text
"lt" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Lt
      , Parser Text Text
"ml" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ml
      , Parser Text Text
"mr" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Mr
      , Parser Text Text
"mn" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Mn
      , Parser Text Text
"no" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
No
      , Parser Text Text
"or" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Or
      , Parser Text Text
"fa" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Fa
      , Parser Text Text
"pl" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Pl
      , Parser Text Text
"pt_AO" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Pt_AO
      , Parser Text Text
"pt_RAA" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Pt_RAA
      , Parser Text Text
"pt_BR" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Pt_Br
      , Parser Text Text
"pt_RAM" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Pt_RAM
      , Parser Text Text
"pt_PT" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Pt_PT
      , Parser Text Text
"ro" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ro
      , Parser Text Text
"ru" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Ru
      , Parser Text Text
"sr" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Sr
      , Parser Text Text
"sk" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Sk
      , Parser Text Text
"sl" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Sl
      , Parser Text Text
"es" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es
      , Parser Text Text
"es_AR" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_AR
      , Parser Text Text
"es_CL" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_CL
      , Parser Text Text
"es_CR" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_CR
      , Parser Text Text
"es_CU" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_CU
      , Parser Text Text
"es_DO" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_DO
      , Parser Text Text
"es_EC" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_EC
      , Parser Text Text
"es_HN" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_HN
      , Parser Text Text
"es_MX" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_MX
      , Parser Text Text
"es_PA" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_PA
      , Parser Text Text
"es_PY" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_PY
      , Parser Text Text
"es_PE" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_PE
      , Parser Text Text
"es_PR" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_PR
      , Parser Text Text
"es_ES" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_ES
      , Parser Text Text
"es_UY" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_UY
      , Parser Text Text
"es_VE" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Es_VE
      , Parser Text Text
"sv" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Sv
      , Parser Text Text
"te" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Te
      , Parser Text Text
"th" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Th
      , Parser Text Text
"tr" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Tr
      , Parser Text Text
"uk" Parser Text Text -> SPPLocale -> Parser SPPLocale
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPLocale
Uk
      ]
  where
    _casesCovered :: SPPLocale -> ()
    _casesCovered :: SPPLocale -> ()
_casesCovered =
      \case
        SPPLocale
Af -> ()
        SPPLocale
Sq -> ()
        SPPLocale
Ar -> ()
        SPPLocale
Hy -> ()
        SPPLocale
As -> ()
        SPPLocale
Ast -> ()
        SPPLocale
Az -> ()
        SPPLocale
Eu -> ()
        SPPLocale
Bn -> ()
        SPPLocale
Bg -> ()
        SPPLocale
Ca -> ()
        SPPLocale
Zh -> ()
        SPPLocale
Zh_SIM -> ()
        SPPLocale
Ht_HT -> ()
        SPPLocale
Hr -> ()
        SPPLocale
Cs -> ()
        SPPLocale
Da -> ()
        SPPLocale
Nl -> ()
        SPPLocale
En -> ()
        SPPLocale
En_AU -> ()
        SPPLocale
En_BD -> ()
        SPPLocale
En_HAW -> ()
        SPPLocale
En_HBW -> ()
        SPPLocale
En_IN -> ()
        SPPLocale
En_IOC -> ()
        SPPLocale
En_KE -> ()
        SPPLocale
En_MY -> ()
        SPPLocale
En_NZ -> ()
        SPPLocale
En_PH -> ()
        SPPLocale
En_ZA -> ()
        SPPLocale
En_AE -> ()
        SPPLocale
En_UK -> ()
        SPPLocale
En_US -> ()
        SPPLocale
Fo -> ()
        SPPLocale
Fi -> ()
        SPPLocale
Fr -> ()
        SPPLocale
Fr_AOU -> ()
        SPPLocale
Fr_FR -> ()
        SPPLocale
Fr_CA -> ()
        SPPLocale
Fr_GF -> ()
        SPPLocale
Fr_GP -> ()
        SPPLocale
Fr_HT -> ()
        SPPLocale
Gl -> ()
        SPPLocale
De -> ()
        SPPLocale
El -> ()
        SPPLocale
Gu -> ()
        SPPLocale
He -> ()
        SPPLocale
Hi -> ()
        SPPLocale
Hu -> ()
        SPPLocale
Is -> ()
        SPPLocale
In -> ()
        SPPLocale
It -> ()
        SPPLocale
Ja -> ()
        SPPLocale
Ko -> ()
        SPPLocale
Lv -> ()
        SPPLocale
Lt -> ()
        SPPLocale
Ml -> ()
        SPPLocale
Mr -> ()
        SPPLocale
Mn -> ()
        SPPLocale
No -> ()
        SPPLocale
Or -> ()
        SPPLocale
Fa -> ()
        SPPLocale
Pl -> ()
        SPPLocale
Pt_AO -> ()
        SPPLocale
Pt_RAA -> ()
        SPPLocale
Pt_Br -> ()
        SPPLocale
Pt_RAM -> ()
        SPPLocale
Pt_PT -> ()
        SPPLocale
Ro -> ()
        SPPLocale
Ru -> ()
        SPPLocale
Sr -> ()
        SPPLocale
Sk -> ()
        SPPLocale
Sl -> ()
        SPPLocale
Es -> ()
        SPPLocale
Es_AR -> ()
        SPPLocale
Es_CL -> ()
        SPPLocale
Es_CR -> ()
        SPPLocale
Es_CU -> ()
        SPPLocale
Es_DO -> ()
        SPPLocale
Es_EC -> ()
        SPPLocale
Es_HN -> ()
        SPPLocale
Es_MX -> ()
        SPPLocale
Es_PA -> ()
        SPPLocale
Es_PY -> ()
        SPPLocale
Es_PE -> ()
        SPPLocale
Es_PR -> ()
        SPPLocale
Es_ES -> ()
        SPPLocale
Es_UY -> ()
        SPPLocale
Es_VE -> ()
        SPPLocale
Sv -> ()
        SPPLocale
Te -> ()
        SPPLocale
Th -> ()
        SPPLocale
Tr -> ()
        SPPLocale
Uk -> ()

-- | Parse an eBird 'SPPGrouping'.
parseSPPGrouping :: Parser SPPGrouping
parseSPPGrouping :: Parser SPPGrouping
parseSPPGrouping =
    [Parser SPPGrouping] -> Parser SPPGrouping
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"merlin" Parser Text Text -> SPPGrouping -> Parser SPPGrouping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPGrouping
MerlinGrouping
      , Parser Text Text
"ebird" Parser Text Text -> SPPGrouping -> Parser SPPGrouping
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> SPPGrouping
EBirdGrouping
      ]
  where
    _casesCovered :: SPPGrouping -> ()
    _casesCovered :: SPPGrouping -> ()
_casesCovered =
      \case
        SPPGrouping
MerlinGrouping -> ()
        SPPGrouping
EBirdGrouping -> ()

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

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

instance ToHttpApiData SpeciesCodes where
  toUrlPiece :: SpeciesCodes -> Text
toUrlPiece = Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text)
-> (SpeciesCodes -> [Text]) -> SpeciesCodes -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SpeciesCode -> Text) -> [SpeciesCode] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map SpeciesCode -> Text
forall a. EBirdString a => a -> Text
toEBirdString ([SpeciesCode] -> [Text])
-> (SpeciesCodes -> [SpeciesCode]) -> SpeciesCodes -> [Text]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SpeciesCodes -> [SpeciesCode]
speciesCodes

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

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

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