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

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

module Data.EBird.API.Regions where

import Control.Arrow
import Data.Aeson
import Data.Attoparsec.Text
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 Servant.API (ToHttpApiData(..))

import Data.EBird.API.EBirdString

-------------------------------------------------------------------------------
-- * Region-related API types
-------------------------------------------------------------------------------

-- | eBird divides the world into countries, subnational1 regions (states) or
-- subnational2 regions (counties). 'Location' regions are eBird-specific
-- location identifiers.
data Region =
      -- | Regions may be specified as location IDs, e.g. @L227544@
      Location Integer

      -- | The world is a region
    | World

      -- | At the top level, the world is divided into countries
    | Country Text

      -- | Subnational1 regions are states within countries
    | Subnational1
        Text -- ^ The country
        Text -- ^ The state

      -- | Subnational2 regions are counties within states
    | Subnational2
        Text -- ^ The country
        Text -- ^ The state
        Text -- ^ The county
  deriving (Int -> Region -> ShowS
[Region] -> ShowS
Region -> String
(Int -> Region -> ShowS)
-> (Region -> String) -> ([Region] -> ShowS) -> Show Region
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Region -> ShowS
showsPrec :: Int -> Region -> ShowS
$cshow :: Region -> String
show :: Region -> String
$cshowList :: [Region] -> ShowS
showList :: [Region] -> ShowS
Show, ReadPrec [Region]
ReadPrec Region
Int -> ReadS Region
ReadS [Region]
(Int -> ReadS Region)
-> ReadS [Region]
-> ReadPrec Region
-> ReadPrec [Region]
-> Read Region
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS Region
readsPrec :: Int -> ReadS Region
$creadList :: ReadS [Region]
readList :: ReadS [Region]
$creadPrec :: ReadPrec Region
readPrec :: ReadPrec Region
$creadListPrec :: ReadPrec [Region]
readListPrec :: ReadPrec [Region]
Read, Region -> Region -> Bool
(Region -> Region -> Bool)
-> (Region -> Region -> Bool) -> Eq Region
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Region -> Region -> Bool
== :: Region -> Region -> Bool
$c/= :: Region -> Region -> Bool
/= :: Region -> Region -> Bool
Eq)

-- | One constructor per eBird "region type" (countries, subnational1 (states),
-- or subnational2 (counties)).
data RegionType =
      CountryType
    | Subnational1Type
    | Subnational2Type
  deriving (Int -> RegionType -> ShowS
[RegionType] -> ShowS
RegionType -> String
(Int -> RegionType -> ShowS)
-> (RegionType -> String)
-> ([RegionType] -> ShowS)
-> Show RegionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionType -> ShowS
showsPrec :: Int -> RegionType -> ShowS
$cshow :: RegionType -> String
show :: RegionType -> String
$cshowList :: [RegionType] -> ShowS
showList :: [RegionType] -> ShowS
Show, ReadPrec [RegionType]
ReadPrec RegionType
Int -> ReadS RegionType
ReadS [RegionType]
(Int -> ReadS RegionType)
-> ReadS [RegionType]
-> ReadPrec RegionType
-> ReadPrec [RegionType]
-> Read RegionType
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionType
readsPrec :: Int -> ReadS RegionType
$creadList :: ReadS [RegionType]
readList :: ReadS [RegionType]
$creadPrec :: ReadPrec RegionType
readPrec :: ReadPrec RegionType
$creadListPrec :: ReadPrec [RegionType]
readListPrec :: ReadPrec [RegionType]
Read, RegionType -> RegionType -> Bool
(RegionType -> RegionType -> Bool)
-> (RegionType -> RegionType -> Bool) -> Eq RegionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionType -> RegionType -> Bool
== :: RegionType -> RegionType -> Bool
$c/= :: RegionType -> RegionType -> Bool
/= :: RegionType -> RegionType -> Bool
Eq)

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

-- | 'RegionNameFormat' values specify what format the API should return region
-- names in. See the constructor docs for examples.
data RegionNameFormat =
      -- | 'DetailedNameFormat' region name values are fully qualified with only
      -- the country abbreviated, e.g. "Madison County, New York, US"
      DetailedNameFormat

      -- | 'DetailedNoQualNameFormat' region name values are like
      -- 'DetailedNameFormat' but without the country qualifier and no "county"
      -- annotation, e.g. "Madison, New York"
    | DetailedNoQualNameFormat

      -- | 'FullNameFormat' region name values are fully qualified with no
      -- abbreviated country name and no "county" annotation, e.g. "Madison,
      -- New York, United States"
    | FullNameFormat

      -- | 'NameQualNameFormat' region name values are just the annotated name,
      -- e.g. "Madison County"
    | NameQualNameFormat

      -- | 'NameOnlyNameFormat' region name values are just the name, e.g.
      -- \"Madison\"
    | NameOnlyNameFormat

      -- | 'RevDetailedNameFormat' region name values are like
      -- 'DetailedNameFormat' but with reverse qualifiers, e.g. "US, New York,
      -- Madison County"
    | RevDetailedNameFormat
  deriving (Int -> RegionNameFormat -> ShowS
[RegionNameFormat] -> ShowS
RegionNameFormat -> String
(Int -> RegionNameFormat -> ShowS)
-> (RegionNameFormat -> String)
-> ([RegionNameFormat] -> ShowS)
-> Show RegionNameFormat
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionNameFormat -> ShowS
showsPrec :: Int -> RegionNameFormat -> ShowS
$cshow :: RegionNameFormat -> String
show :: RegionNameFormat -> String
$cshowList :: [RegionNameFormat] -> ShowS
showList :: [RegionNameFormat] -> ShowS
Show, ReadPrec [RegionNameFormat]
ReadPrec RegionNameFormat
Int -> ReadS RegionNameFormat
ReadS [RegionNameFormat]
(Int -> ReadS RegionNameFormat)
-> ReadS [RegionNameFormat]
-> ReadPrec RegionNameFormat
-> ReadPrec [RegionNameFormat]
-> Read RegionNameFormat
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionNameFormat
readsPrec :: Int -> ReadS RegionNameFormat
$creadList :: ReadS [RegionNameFormat]
readList :: ReadS [RegionNameFormat]
$creadPrec :: ReadPrec RegionNameFormat
readPrec :: ReadPrec RegionNameFormat
$creadListPrec :: ReadPrec [RegionNameFormat]
readListPrec :: ReadPrec [RegionNameFormat]
Read, RegionNameFormat -> RegionNameFormat -> Bool
(RegionNameFormat -> RegionNameFormat -> Bool)
-> (RegionNameFormat -> RegionNameFormat -> Bool)
-> Eq RegionNameFormat
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionNameFormat -> RegionNameFormat -> Bool
== :: RegionNameFormat -> RegionNameFormat -> Bool
$c/= :: RegionNameFormat -> RegionNameFormat -> Bool
/= :: RegionNameFormat -> RegionNameFormat -> Bool
Eq)

-- | 'RegionInfo' specifies the name of a region (in some 'RegionNameFormat')
-- and the bounds of that region as 'RegionBounds'.
data RegionInfo =
    RegionInfo
      { RegionInfo -> Text
_regionInfoName :: Text
      , RegionInfo -> Maybe RegionBounds
_regionInfoBounds :: Maybe RegionBounds
      }
  deriving (Int -> RegionInfo -> ShowS
[RegionInfo] -> ShowS
RegionInfo -> String
(Int -> RegionInfo -> ShowS)
-> (RegionInfo -> String)
-> ([RegionInfo] -> ShowS)
-> Show RegionInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionInfo -> ShowS
showsPrec :: Int -> RegionInfo -> ShowS
$cshow :: RegionInfo -> String
show :: RegionInfo -> String
$cshowList :: [RegionInfo] -> ShowS
showList :: [RegionInfo] -> ShowS
Show, ReadPrec [RegionInfo]
ReadPrec RegionInfo
Int -> ReadS RegionInfo
ReadS [RegionInfo]
(Int -> ReadS RegionInfo)
-> ReadS [RegionInfo]
-> ReadPrec RegionInfo
-> ReadPrec [RegionInfo]
-> Read RegionInfo
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionInfo
readsPrec :: Int -> ReadS RegionInfo
$creadList :: ReadS [RegionInfo]
readList :: ReadS [RegionInfo]
$creadPrec :: ReadPrec RegionInfo
readPrec :: ReadPrec RegionInfo
$creadListPrec :: ReadPrec [RegionInfo]
readListPrec :: ReadPrec [RegionInfo]
Read, RegionInfo -> RegionInfo -> Bool
(RegionInfo -> RegionInfo -> Bool)
-> (RegionInfo -> RegionInfo -> Bool) -> Eq RegionInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionInfo -> RegionInfo -> Bool
== :: RegionInfo -> RegionInfo -> Bool
$c/= :: RegionInfo -> RegionInfo -> Bool
/= :: RegionInfo -> RegionInfo -> Bool
Eq)


-- | 'RegionBounds' specify the corners of a bounding box around a region.
data RegionBounds =
    RegionBounds
      { RegionBounds -> Double
_regionBoundsMinX :: Double
      , RegionBounds -> Double
_regionBoundsMaxX :: Double
      , RegionBounds -> Double
_regionBoundsMinY :: Double
      , RegionBounds -> Double
_regionBoundsMaxY :: Double
      }
  deriving (Int -> RegionBounds -> ShowS
[RegionBounds] -> ShowS
RegionBounds -> String
(Int -> RegionBounds -> ShowS)
-> (RegionBounds -> String)
-> ([RegionBounds] -> ShowS)
-> Show RegionBounds
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionBounds -> ShowS
showsPrec :: Int -> RegionBounds -> ShowS
$cshow :: RegionBounds -> String
show :: RegionBounds -> String
$cshowList :: [RegionBounds] -> ShowS
showList :: [RegionBounds] -> ShowS
Show, ReadPrec [RegionBounds]
ReadPrec RegionBounds
Int -> ReadS RegionBounds
ReadS [RegionBounds]
(Int -> ReadS RegionBounds)
-> ReadS [RegionBounds]
-> ReadPrec RegionBounds
-> ReadPrec [RegionBounds]
-> Read RegionBounds
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionBounds
readsPrec :: Int -> ReadS RegionBounds
$creadList :: ReadS [RegionBounds]
readList :: ReadS [RegionBounds]
$creadPrec :: ReadPrec RegionBounds
readPrec :: ReadPrec RegionBounds
$creadListPrec :: ReadPrec [RegionBounds]
readListPrec :: ReadPrec [RegionBounds]
Read, RegionBounds -> RegionBounds -> Bool
(RegionBounds -> RegionBounds -> Bool)
-> (RegionBounds -> RegionBounds -> Bool) -> Eq RegionBounds
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionBounds -> RegionBounds -> Bool
== :: RegionBounds -> RegionBounds -> Bool
$c/= :: RegionBounds -> RegionBounds -> Bool
/= :: RegionBounds -> RegionBounds -> Bool
Eq)

-- | The data structure returned by the eBird 'Data.EBird.API.SubregionListAPI' and
-- 'Data.EBird.API.AdjacentRegionsAPI'.
data RegionListEntry =
    RegionListEntry
      { RegionListEntry -> Region
_regionListEntryRegion :: Region
      , RegionListEntry -> Text
_regionListEntryName :: Text
      }
  deriving (Int -> RegionListEntry -> ShowS
[RegionListEntry] -> ShowS
RegionListEntry -> String
(Int -> RegionListEntry -> ShowS)
-> (RegionListEntry -> String)
-> ([RegionListEntry] -> ShowS)
-> Show RegionListEntry
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> RegionListEntry -> ShowS
showsPrec :: Int -> RegionListEntry -> ShowS
$cshow :: RegionListEntry -> String
show :: RegionListEntry -> String
$cshowList :: [RegionListEntry] -> ShowS
showList :: [RegionListEntry] -> ShowS
Show, ReadPrec [RegionListEntry]
ReadPrec RegionListEntry
Int -> ReadS RegionListEntry
ReadS [RegionListEntry]
(Int -> ReadS RegionListEntry)
-> ReadS [RegionListEntry]
-> ReadPrec RegionListEntry
-> ReadPrec [RegionListEntry]
-> Read RegionListEntry
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS RegionListEntry
readsPrec :: Int -> ReadS RegionListEntry
$creadList :: ReadS [RegionListEntry]
readList :: ReadS [RegionListEntry]
$creadPrec :: ReadPrec RegionListEntry
readPrec :: ReadPrec RegionListEntry
$creadListPrec :: ReadPrec [RegionListEntry]
readListPrec :: ReadPrec [RegionListEntry]
Read, RegionListEntry -> RegionListEntry -> Bool
(RegionListEntry -> RegionListEntry -> Bool)
-> (RegionListEntry -> RegionListEntry -> Bool)
-> Eq RegionListEntry
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: RegionListEntry -> RegionListEntry -> Bool
== :: RegionListEntry -> RegionListEntry -> Bool
$c/= :: RegionListEntry -> RegionListEntry -> Bool
/= :: RegionListEntry -> RegionListEntry -> Bool
Eq)

-- ** Optics for region-related API types

makeLenses ''RegionInfo
makeFieldLabels ''RegionInfo
makeLenses ''RegionBounds
makeFieldLabels ''RegionBounds
makeLenses ''RegionListEntry
makeFieldLabels ''RegionListEntry

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

instance FromJSON RegionCode where
  parseJSON :: Value -> Parser RegionCode
parseJSON = String -> (Text -> Parser RegionCode) -> Value -> Parser RegionCode
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"RegionCode" ((Text -> Parser RegionCode) -> Value -> Parser RegionCode)
-> (Text -> Parser RegionCode) -> Value -> Parser RegionCode
forall a b. (a -> b) -> a -> b
$ \Text
t ->
      case Parser RegionCode -> Text -> Either String RegionCode
forall a. Parser a -> Text -> Either String a
parseOnly Parser RegionCode
parseRegionCode Text
t of
        Left String
_ -> String -> Parser RegionCode
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"failed to parse region code"
        Right RegionCode
c -> RegionCode -> Parser RegionCode
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return RegionCode
c

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

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

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

-- | Explicit instance for compatibility with their field names
instance FromJSON RegionInfo where
  parseJSON :: Value -> Parser RegionInfo
parseJSON = String
-> (Object -> Parser RegionInfo) -> Value -> Parser RegionInfo
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RegionInfo" ((Object -> Parser RegionInfo) -> Value -> Parser RegionInfo)
-> (Object -> Parser RegionInfo) -> Value -> Parser RegionInfo
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Text -> Maybe RegionBounds -> RegionInfo
RegionInfo
        (Text -> Maybe RegionBounds -> RegionInfo)
-> Parser Text -> Parser (Maybe RegionBounds -> RegionInfo)
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
"result"
        Parser (Maybe RegionBounds -> RegionInfo)
-> Parser (Maybe RegionBounds) -> Parser RegionInfo
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 RegionBounds)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
.:? Key
"bounds"

-- | Explicit instance for compatibility with their field names
instance ToJSON RegionInfo where
  toJSON :: RegionInfo -> Value
toJSON RegionInfo{Maybe RegionBounds
Text
_regionInfoName :: RegionInfo -> Text
_regionInfoBounds :: RegionInfo -> Maybe RegionBounds
_regionInfoName :: Text
_regionInfoBounds :: Maybe RegionBounds
..} =
      [Pair] -> Value
object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
        [ Key
"result" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_regionInfoName
        ]
        [Pair] -> [Pair] -> [Pair]
forall a. Semigroup a => a -> a -> a
<> [Key
"bounds" Key -> RegionBounds -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= RegionBounds
bs | Just RegionBounds
bs <- [Maybe RegionBounds
_regionInfoBounds]]

-- | Explicit instance for compatibility with their field names
instance FromJSON RegionBounds where
  parseJSON :: Value -> Parser RegionBounds
parseJSON = String
-> (Object -> Parser RegionBounds) -> Value -> Parser RegionBounds
forall a. String -> (Object -> Parser a) -> Value -> Parser a
withObject String
"RegionBounds" ((Object -> Parser RegionBounds) -> Value -> Parser RegionBounds)
-> (Object -> Parser RegionBounds) -> Value -> Parser RegionBounds
forall a b. (a -> b) -> a -> b
$ \Object
v ->
      Double -> Double -> Double -> Double -> RegionBounds
RegionBounds
        (Double -> Double -> Double -> Double -> RegionBounds)
-> Parser Double
-> Parser (Double -> Double -> Double -> RegionBounds)
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
"minX"
        Parser (Double -> Double -> Double -> RegionBounds)
-> Parser Double -> Parser (Double -> Double -> RegionBounds)
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
"maxX"
        Parser (Double -> Double -> RegionBounds)
-> Parser Double -> Parser (Double -> RegionBounds)
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
"minY"
        Parser (Double -> RegionBounds)
-> Parser Double -> Parser RegionBounds
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
"maxY"

-- | Explicit instance for compatibility with their field names
instance ToJSON RegionBounds where
  toJSON :: RegionBounds -> Value
toJSON RegionBounds{Double
_regionBoundsMinX :: RegionBounds -> Double
_regionBoundsMaxX :: RegionBounds -> Double
_regionBoundsMinY :: RegionBounds -> Double
_regionBoundsMaxY :: RegionBounds -> Double
_regionBoundsMinX :: Double
_regionBoundsMaxX :: Double
_regionBoundsMinY :: Double
_regionBoundsMaxY :: Double
..} =
      [Pair] -> Value
object
        [ Key
"minX" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_regionBoundsMinX
        , Key
"maxX" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_regionBoundsMaxX
        , Key
"minY" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_regionBoundsMinY
        , Key
"maxY" Key -> Double -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Double
_regionBoundsMaxY
        ]

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

-- | Explicit instance for compatibility with their field names
instance ToJSON RegionListEntry where
  toJSON :: RegionListEntry -> Value
toJSON RegionListEntry{Text
Region
_regionListEntryRegion :: RegionListEntry -> Region
_regionListEntryName :: RegionListEntry -> Text
_regionListEntryRegion :: Region
_regionListEntryName :: Text
..} =
      [Pair] -> Value
object
        [ Key
"code" Key -> Region -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Region
_regionListEntryRegion
        , Key
"name" Key -> Text -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
forall v. ToJSON v => Key -> v -> Pair
.= Text
_regionListEntryName
        ]

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

-- | A 'Region' eBird string is either:
--
--    * \"L227544\" for location regions, where L227544 is the location ID.
--    * "world" for 'World' regions.
--    * The country identifier (e.g. \"US\" for the United States) for 'Country'
--      regions.
--    * The country identifier and the state identifier separated by a hyphen
--      for 'Subnational1' regions (e.g. "US-WY" for Wyoming in the United
--      States).
--    * The county identifier, the state identifier, and the country identifier
--      separated by hyphens for 'Subnational2' regions (e.g. US-WY-013)
instance EBirdString Region where
  toEBirdString :: Region -> Text
toEBirdString =
      \case
        Location Integer
n -> Text
"L" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
Text.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n)
        Region
World -> Text
"world"
        Country Text
cr -> Text
cr
        Subnational1 Text
cr Text
st -> Text
cr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
st
        Subnational2 Text
cr Text
st Text
cy -> Text
cr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
st Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"-" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
cy

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

-- | Results in
-- [eBird region type format](https://documenter.getpostman.com/view/664302/S1ENwy59#382da1c8-8bff-4926-936a-a1f8b065e7d5)
instance EBirdString RegionType where
  toEBirdString :: RegionType -> Text
toEBirdString =
      \case
        RegionType
CountryType -> Text
"country"
        RegionType
Subnational1Type -> Text
"subnational1"
        RegionType
Subnational2Type -> Text
"subnational2"

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

-- | A 'RegionCode' eBird string is a comma-separated list of regions.
instance EBirdString RegionCode where
  toEBirdString :: RegionCode -> Text
toEBirdString (RegionCode (Region
r :| [Region]
rs)) =
      Text -> [Text] -> Text
Text.intercalate Text
"," ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Region -> Text) -> [Region] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Region -> Text
forall a. EBirdString a => a -> Text
toEBirdString (Region
r Region -> [Region] -> [Region]
forall a. a -> [a] -> [a]
: [Region]
rs)

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

-- | A 'RegionNameFormat' is shown as the constructor name without the
-- @NameFormat@ suffix, in all lower-case.
instance EBirdString RegionNameFormat where
  toEBirdString :: RegionNameFormat -> Text
toEBirdString =
      \case
        RegionNameFormat
DetailedNameFormat -> Text
"detailed"
        RegionNameFormat
DetailedNoQualNameFormat -> Text
"detailednoqual"
        RegionNameFormat
FullNameFormat -> Text
"full"
        RegionNameFormat
NameQualNameFormat -> Text
"namequal"
        RegionNameFormat
NameOnlyNameFormat -> Text
"nameonly"
        RegionNameFormat
RevDetailedNameFormat -> Text
"revdetailed"

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

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

-- | Parse an eBird API region code, which is a comma-separated list of one or
-- more regions. To avoid the partial behavior of converting a 'sepBy1' result
-- into a 'NonEmpty', we manually parse the first region followed by an optional
-- tail.
parseRegionCode :: Parser RegionCode
parseRegionCode :: Parser RegionCode
parseRegionCode = do
    Region
r <- Parser Region
parseRegion
    [Region]
rs <- Parser Text Bool
forall t. Chunk t => Parser t Bool
atEnd Parser Text Bool
-> (Bool -> Parser Text [Region]) -> Parser Text [Region]
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 -> [Region] -> Parser Text [Region]
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 Region
parseRegion Parser Region -> Parser Text Char -> Parser Text [Region]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
`sepBy` Char -> Parser Text Char
char Char
','
    RegionCode -> Parser RegionCode
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (RegionCode -> Parser RegionCode)
-> RegionCode -> Parser RegionCode
forall a b. (a -> b) -> a -> b
$ NonEmpty Region -> RegionCode
RegionCode (Region
r Region -> [Region] -> NonEmpty Region
forall a. a -> [a] -> NonEmpty a
:| [Region]
rs)

-- | Parse an eBird API region. This parser only ensures that the input is
-- somewhat well-formed, in that it is either:
--
--    * A 'Location' region (an \'L\' followed by an integral number)
--    * The 'World' region (just the string "world")
--    * A 'Subnational2' region (formatted as "LETTERS-LETTERS-NUMBER" where
--      "LETTERS" is one or more letters in any case, and "NUMBERS" is an
--      integral number)
--    * A 'Subnational1' region (formatterd as "LETTERS-LETTERS")
--    * A 'Country' region (just \"LETTERS\")
parseRegion :: Parser Region
parseRegion :: Parser Region
parseRegion =
    [Parser Region] -> Parser Region
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Region
parseLocationId
      , Parser Region
parseWorld
      , Parser Region
parseSubnational2
      , Parser Region
parseSubnational1
      , Parser Region
parseCountry
      ]
  where
    parseLocationId :: Parser Region
    parseLocationId :: Parser Region
parseLocationId = do
      Parser Text Text
"L" Parser Text Text -> Parser Region -> Parser Region
forall a b. Parser Text a -> Parser Text b -> Parser Text b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Integer -> Region
Location (Integer -> Region) -> Parser Text Integer -> Parser Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Integer
forall a. Integral a => Parser a
decimal)

    parseWorld :: Parser Region
    parseWorld :: Parser Region
parseWorld = do
      Parser Text Text
"world" Parser Text Text -> Region -> Parser Region
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Region
World

    parseCountry :: Parser Region
    parseCountry :: Parser Region
parseCountry = Text -> Region
Country (Text -> Region) -> Parser Text Text -> Parser Region
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Text
letters

    parseSubnational1 :: Parser Region
    parseSubnational1 :: Parser Region
parseSubnational1 = do
      Text
cr <- Parser Text Text
letters
      Parser ()
skipHyphen
      Text
st <- Parser Text Text
letters
      Region -> Parser Region
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> Parser Region) -> Region -> Parser Region
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Region
Subnational1 Text
cr Text
st

    parseSubnational2 :: Parser Region
    parseSubnational2 :: Parser Region
parseSubnational2 = do
      Text
cr <- Parser Text Text
letters
      Parser ()
skipHyphen
      Text
st <- Parser Text Text
letters
      Parser ()
skipHyphen
      Text
cy <- [Parser Text Text] -> Parser Text Text
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice [Parser Text Text
letters, Parser Text Text
digits]
      Region -> Parser Region
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Region -> Parser Region) -> Region -> Parser Region
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Region
Subnational2 Text
cr Text
st Text
cy

    letters :: Parser Text
    letters :: Parser Text Text
letters = String -> Text
Text.pack (String -> Text) -> Parser Text String -> Parser Text Text
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 Parser Text Char
letter

    digits :: Parser Text
    digits :: Parser Text Text
digits = String -> Text
Text.pack (String -> Text) -> Parser Text String -> Parser Text Text
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 Parser Text Char
digit

    skipHyphen :: Parser ()
    skipHyphen :: Parser ()
skipHyphen = (Char -> Bool) -> Parser ()
skip (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==Char
'-')

-- | Parse an eBird API 'RegionNameFormat'.
parseRegionNameFormat :: Parser RegionNameFormat
parseRegionNameFormat :: Parser RegionNameFormat
parseRegionNameFormat =
    [Parser RegionNameFormat] -> Parser RegionNameFormat
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"detailednoqual" Parser Text Text -> RegionNameFormat -> Parser RegionNameFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionNameFormat
DetailedNoQualNameFormat
      , Parser Text Text
"detailed" Parser Text Text -> RegionNameFormat -> Parser RegionNameFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionNameFormat
DetailedNameFormat
      , Parser Text Text
"full" Parser Text Text -> RegionNameFormat -> Parser RegionNameFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionNameFormat
FullNameFormat
      , Parser Text Text
"namequal" Parser Text Text -> RegionNameFormat -> Parser RegionNameFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionNameFormat
NameQualNameFormat
      , Parser Text Text
"nameonly" Parser Text Text -> RegionNameFormat -> Parser RegionNameFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionNameFormat
NameOnlyNameFormat
      , Parser Text Text
"revdetailed" Parser Text Text -> RegionNameFormat -> Parser RegionNameFormat
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionNameFormat
RevDetailedNameFormat
      ]
  where
    _casesCovered :: RegionNameFormat -> ()
    _casesCovered :: RegionNameFormat -> ()
_casesCovered =
      \case
        RegionNameFormat
DetailedNoQualNameFormat -> ()
        RegionNameFormat
DetailedNameFormat -> ()
        RegionNameFormat
FullNameFormat -> ()
        RegionNameFormat
NameQualNameFormat -> ()
        RegionNameFormat
NameOnlyNameFormat -> ()
        RegionNameFormat
RevDetailedNameFormat -> ()

-- | Parse an eBird API 'RegionType'.
parseRegionType :: Parser RegionType
parseRegionType :: Parser RegionType
parseRegionType =
    [Parser RegionType] -> Parser RegionType
forall (f :: * -> *) a. Alternative f => [f a] -> f a
choice
      [ Parser Text Text
"country" Parser Text Text -> RegionType -> Parser RegionType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionType
CountryType
      , Parser Text Text
"subnational1" Parser Text Text -> RegionType -> Parser RegionType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionType
Subnational1Type
      , Parser Text Text
"subnational2" Parser Text Text -> RegionType -> Parser RegionType
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RegionType
Subnational2Type
      ]
  where
    _casesCovered :: RegionType -> ()
    _casesCovered :: RegionType -> ()
_casesCovered =
      \case
        RegionType
CountryType -> ()
        RegionType
Subnational1Type -> ()
        RegionType
Subnational2Type -> ()

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

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

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

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

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