{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE DerivingStrategies         #-}

-- |
-- Module      : Data.EBird.API.Util.Time
-- Copyright   : (c) 2023 Finley McIlwaine
-- License     : MIT (see LICENSE)
--
-- Maintainer  : Finley McIlwaine <finleymcilwaine@gmail.com>
--
-- Utilities for parsing and printing dates and times that the eBird API
-- provides.

module Data.EBird.API.Util.Time (
    -- * Date and time types
    EBirdDate(..)
  , EBirdTime(..)
  , EBirdDateTime(..)

    -- * Conversions
  , eBirdDateToGregorian

    -- * attoparsec parsers
  , parseEBirdDate
  , parseEBirdTime
  , parseEBirdDateTime
  ) where

import Control.Applicative
import Control.Arrow
import Data.Aeson
import Data.Attoparsec.Text
import Data.Attoparsec.Time
import Data.Function
import Data.String
import Data.Text qualified as Text
import Data.Time

import Data.EBird.API.EBirdString

-------------------------------------------------------------------------------
-- Date and time types
-------------------------------------------------------------------------------

-- | An 'EBirdDate' is simply a 'Day'.
newtype EBirdDate = EBirdDate { EBirdDate -> Day
eBirdDate :: Day }
  deriving (MonthOfYear -> EBirdDate -> ShowS
[EBirdDate] -> ShowS
EBirdDate -> String
(MonthOfYear -> EBirdDate -> ShowS)
-> (EBirdDate -> String)
-> ([EBirdDate] -> ShowS)
-> Show EBirdDate
forall a.
(MonthOfYear -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MonthOfYear -> EBirdDate -> ShowS
showsPrec :: MonthOfYear -> EBirdDate -> ShowS
$cshow :: EBirdDate -> String
show :: EBirdDate -> String
$cshowList :: [EBirdDate] -> ShowS
showList :: [EBirdDate] -> ShowS
Show, ReadPrec [EBirdDate]
ReadPrec EBirdDate
MonthOfYear -> ReadS EBirdDate
ReadS [EBirdDate]
(MonthOfYear -> ReadS EBirdDate)
-> ReadS [EBirdDate]
-> ReadPrec EBirdDate
-> ReadPrec [EBirdDate]
-> Read EBirdDate
forall a.
(MonthOfYear -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: MonthOfYear -> ReadS EBirdDate
readsPrec :: MonthOfYear -> ReadS EBirdDate
$creadList :: ReadS [EBirdDate]
readList :: ReadS [EBirdDate]
$creadPrec :: ReadPrec EBirdDate
readPrec :: ReadPrec EBirdDate
$creadListPrec :: ReadPrec [EBirdDate]
readListPrec :: ReadPrec [EBirdDate]
Read, EBirdDate -> EBirdDate -> Bool
(EBirdDate -> EBirdDate -> Bool)
-> (EBirdDate -> EBirdDate -> Bool) -> Eq EBirdDate
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EBirdDate -> EBirdDate -> Bool
== :: EBirdDate -> EBirdDate -> Bool
$c/= :: EBirdDate -> EBirdDate -> Bool
/= :: EBirdDate -> EBirdDate -> Bool
Eq, Eq EBirdDate
Eq EBirdDate =>
(EBirdDate -> EBirdDate -> Ordering)
-> (EBirdDate -> EBirdDate -> Bool)
-> (EBirdDate -> EBirdDate -> Bool)
-> (EBirdDate -> EBirdDate -> Bool)
-> (EBirdDate -> EBirdDate -> Bool)
-> (EBirdDate -> EBirdDate -> EBirdDate)
-> (EBirdDate -> EBirdDate -> EBirdDate)
-> Ord EBirdDate
EBirdDate -> EBirdDate -> Bool
EBirdDate -> EBirdDate -> Ordering
EBirdDate -> EBirdDate -> EBirdDate
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EBirdDate -> EBirdDate -> Ordering
compare :: EBirdDate -> EBirdDate -> Ordering
$c< :: EBirdDate -> EBirdDate -> Bool
< :: EBirdDate -> EBirdDate -> Bool
$c<= :: EBirdDate -> EBirdDate -> Bool
<= :: EBirdDate -> EBirdDate -> Bool
$c> :: EBirdDate -> EBirdDate -> Bool
> :: EBirdDate -> EBirdDate -> Bool
$c>= :: EBirdDate -> EBirdDate -> Bool
>= :: EBirdDate -> EBirdDate -> Bool
$cmax :: EBirdDate -> EBirdDate -> EBirdDate
max :: EBirdDate -> EBirdDate -> EBirdDate
$cmin :: EBirdDate -> EBirdDate -> EBirdDate
min :: EBirdDate -> EBirdDate -> EBirdDate
Ord)
  deriving newtype (MonthOfYear -> EBirdDate
EBirdDate -> MonthOfYear
EBirdDate -> [EBirdDate]
EBirdDate -> EBirdDate
EBirdDate -> EBirdDate -> [EBirdDate]
EBirdDate -> EBirdDate -> EBirdDate -> [EBirdDate]
(EBirdDate -> EBirdDate)
-> (EBirdDate -> EBirdDate)
-> (MonthOfYear -> EBirdDate)
-> (EBirdDate -> MonthOfYear)
-> (EBirdDate -> [EBirdDate])
-> (EBirdDate -> EBirdDate -> [EBirdDate])
-> (EBirdDate -> EBirdDate -> [EBirdDate])
-> (EBirdDate -> EBirdDate -> EBirdDate -> [EBirdDate])
-> Enum EBirdDate
forall a.
(a -> a)
-> (a -> a)
-> (MonthOfYear -> a)
-> (a -> MonthOfYear)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: EBirdDate -> EBirdDate
succ :: EBirdDate -> EBirdDate
$cpred :: EBirdDate -> EBirdDate
pred :: EBirdDate -> EBirdDate
$ctoEnum :: MonthOfYear -> EBirdDate
toEnum :: MonthOfYear -> EBirdDate
$cfromEnum :: EBirdDate -> MonthOfYear
fromEnum :: EBirdDate -> MonthOfYear
$cenumFrom :: EBirdDate -> [EBirdDate]
enumFrom :: EBirdDate -> [EBirdDate]
$cenumFromThen :: EBirdDate -> EBirdDate -> [EBirdDate]
enumFromThen :: EBirdDate -> EBirdDate -> [EBirdDate]
$cenumFromTo :: EBirdDate -> EBirdDate -> [EBirdDate]
enumFromTo :: EBirdDate -> EBirdDate -> [EBirdDate]
$cenumFromThenTo :: EBirdDate -> EBirdDate -> EBirdDate -> [EBirdDate]
enumFromThenTo :: EBirdDate -> EBirdDate -> EBirdDate -> [EBirdDate]
Enum)

-- | Since times that come from the eBird API are not provided with a time zone,
-- an 'EBirdTime' is simply a 'TimeOfDay'. Since eBird times are only provided
-- up to the minute, the 'todSec' value will always be 0.
newtype EBirdTime = EBirdTime { EBirdTime -> TimeOfDay
eBirdTime :: TimeOfDay }
  deriving (MonthOfYear -> EBirdTime -> ShowS
[EBirdTime] -> ShowS
EBirdTime -> String
(MonthOfYear -> EBirdTime -> ShowS)
-> (EBirdTime -> String)
-> ([EBirdTime] -> ShowS)
-> Show EBirdTime
forall a.
(MonthOfYear -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MonthOfYear -> EBirdTime -> ShowS
showsPrec :: MonthOfYear -> EBirdTime -> ShowS
$cshow :: EBirdTime -> String
show :: EBirdTime -> String
$cshowList :: [EBirdTime] -> ShowS
showList :: [EBirdTime] -> ShowS
Show, ReadPrec [EBirdTime]
ReadPrec EBirdTime
MonthOfYear -> ReadS EBirdTime
ReadS [EBirdTime]
(MonthOfYear -> ReadS EBirdTime)
-> ReadS [EBirdTime]
-> ReadPrec EBirdTime
-> ReadPrec [EBirdTime]
-> Read EBirdTime
forall a.
(MonthOfYear -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: MonthOfYear -> ReadS EBirdTime
readsPrec :: MonthOfYear -> ReadS EBirdTime
$creadList :: ReadS [EBirdTime]
readList :: ReadS [EBirdTime]
$creadPrec :: ReadPrec EBirdTime
readPrec :: ReadPrec EBirdTime
$creadListPrec :: ReadPrec [EBirdTime]
readListPrec :: ReadPrec [EBirdTime]
Read, EBirdTime -> EBirdTime -> Bool
(EBirdTime -> EBirdTime -> Bool)
-> (EBirdTime -> EBirdTime -> Bool) -> Eq EBirdTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EBirdTime -> EBirdTime -> Bool
== :: EBirdTime -> EBirdTime -> Bool
$c/= :: EBirdTime -> EBirdTime -> Bool
/= :: EBirdTime -> EBirdTime -> Bool
Eq, Eq EBirdTime
Eq EBirdTime =>
(EBirdTime -> EBirdTime -> Ordering)
-> (EBirdTime -> EBirdTime -> Bool)
-> (EBirdTime -> EBirdTime -> Bool)
-> (EBirdTime -> EBirdTime -> Bool)
-> (EBirdTime -> EBirdTime -> Bool)
-> (EBirdTime -> EBirdTime -> EBirdTime)
-> (EBirdTime -> EBirdTime -> EBirdTime)
-> Ord EBirdTime
EBirdTime -> EBirdTime -> Bool
EBirdTime -> EBirdTime -> Ordering
EBirdTime -> EBirdTime -> EBirdTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EBirdTime -> EBirdTime -> Ordering
compare :: EBirdTime -> EBirdTime -> Ordering
$c< :: EBirdTime -> EBirdTime -> Bool
< :: EBirdTime -> EBirdTime -> Bool
$c<= :: EBirdTime -> EBirdTime -> Bool
<= :: EBirdTime -> EBirdTime -> Bool
$c> :: EBirdTime -> EBirdTime -> Bool
> :: EBirdTime -> EBirdTime -> Bool
$c>= :: EBirdTime -> EBirdTime -> Bool
>= :: EBirdTime -> EBirdTime -> Bool
$cmax :: EBirdTime -> EBirdTime -> EBirdTime
max :: EBirdTime -> EBirdTime -> EBirdTime
$cmin :: EBirdTime -> EBirdTime -> EBirdTime
min :: EBirdTime -> EBirdTime -> EBirdTime
Ord)

-- | Dates and times that come from the eBird API are not provided with a time
-- zone. All we can do is track the 'Data.Time.Day' and 'Data.Time.TimeOfDay'
-- with a 'Data.Time.LocalTime'. Comparison of, for example,
-- 'Data.EBird.API.Observation's that happened in different time zones must therefore
-- be done carefully.
newtype EBirdDateTime = EBirdDateTime { EBirdDateTime -> LocalTime
eBirdDateTime :: LocalTime }
  deriving (MonthOfYear -> EBirdDateTime -> ShowS
[EBirdDateTime] -> ShowS
EBirdDateTime -> String
(MonthOfYear -> EBirdDateTime -> ShowS)
-> (EBirdDateTime -> String)
-> ([EBirdDateTime] -> ShowS)
-> Show EBirdDateTime
forall a.
(MonthOfYear -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: MonthOfYear -> EBirdDateTime -> ShowS
showsPrec :: MonthOfYear -> EBirdDateTime -> ShowS
$cshow :: EBirdDateTime -> String
show :: EBirdDateTime -> String
$cshowList :: [EBirdDateTime] -> ShowS
showList :: [EBirdDateTime] -> ShowS
Show, ReadPrec [EBirdDateTime]
ReadPrec EBirdDateTime
MonthOfYear -> ReadS EBirdDateTime
ReadS [EBirdDateTime]
(MonthOfYear -> ReadS EBirdDateTime)
-> ReadS [EBirdDateTime]
-> ReadPrec EBirdDateTime
-> ReadPrec [EBirdDateTime]
-> Read EBirdDateTime
forall a.
(MonthOfYear -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: MonthOfYear -> ReadS EBirdDateTime
readsPrec :: MonthOfYear -> ReadS EBirdDateTime
$creadList :: ReadS [EBirdDateTime]
readList :: ReadS [EBirdDateTime]
$creadPrec :: ReadPrec EBirdDateTime
readPrec :: ReadPrec EBirdDateTime
$creadListPrec :: ReadPrec [EBirdDateTime]
readListPrec :: ReadPrec [EBirdDateTime]
Read, EBirdDateTime -> EBirdDateTime -> Bool
(EBirdDateTime -> EBirdDateTime -> Bool)
-> (EBirdDateTime -> EBirdDateTime -> Bool) -> Eq EBirdDateTime
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: EBirdDateTime -> EBirdDateTime -> Bool
== :: EBirdDateTime -> EBirdDateTime -> Bool
$c/= :: EBirdDateTime -> EBirdDateTime -> Bool
/= :: EBirdDateTime -> EBirdDateTime -> Bool
Eq, Eq EBirdDateTime
Eq EBirdDateTime =>
(EBirdDateTime -> EBirdDateTime -> Ordering)
-> (EBirdDateTime -> EBirdDateTime -> Bool)
-> (EBirdDateTime -> EBirdDateTime -> Bool)
-> (EBirdDateTime -> EBirdDateTime -> Bool)
-> (EBirdDateTime -> EBirdDateTime -> Bool)
-> (EBirdDateTime -> EBirdDateTime -> EBirdDateTime)
-> (EBirdDateTime -> EBirdDateTime -> EBirdDateTime)
-> Ord EBirdDateTime
EBirdDateTime -> EBirdDateTime -> Bool
EBirdDateTime -> EBirdDateTime -> Ordering
EBirdDateTime -> EBirdDateTime -> EBirdDateTime
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: EBirdDateTime -> EBirdDateTime -> Ordering
compare :: EBirdDateTime -> EBirdDateTime -> Ordering
$c< :: EBirdDateTime -> EBirdDateTime -> Bool
< :: EBirdDateTime -> EBirdDateTime -> Bool
$c<= :: EBirdDateTime -> EBirdDateTime -> Bool
<= :: EBirdDateTime -> EBirdDateTime -> Bool
$c> :: EBirdDateTime -> EBirdDateTime -> Bool
> :: EBirdDateTime -> EBirdDateTime -> Bool
$c>= :: EBirdDateTime -> EBirdDateTime -> Bool
>= :: EBirdDateTime -> EBirdDateTime -> Bool
$cmax :: EBirdDateTime -> EBirdDateTime -> EBirdDateTime
max :: EBirdDateTime -> EBirdDateTime -> EBirdDateTime
$cmin :: EBirdDateTime -> EBirdDateTime -> EBirdDateTime
min :: EBirdDateTime -> EBirdDateTime -> EBirdDateTime
Ord)

-------------------------------------------------------------------------------
-- Conversions
-------------------------------------------------------------------------------

-- | Convert an 'EBirdDate' to a gregorian representation. The first element is
-- the year, the second is the month in the year (1 - 12), and the third is the
-- day in the month.
eBirdDateToGregorian :: EBirdDate -> (Integer, Integer, Integer)
eBirdDateToGregorian :: EBirdDate -> (Integer, Integer, Integer)
eBirdDateToGregorian EBirdDate{Day
eBirdDate :: EBirdDate -> Day
eBirdDate :: Day
..} =
    (Integer
y, MonthOfYear -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
m, MonthOfYear -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral MonthOfYear
d)
  where
    (Integer
y, MonthOfYear
m, MonthOfYear
d) = Day -> (Integer, MonthOfYear, MonthOfYear)
toGregorian Day
eBirdDate

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

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

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

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

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

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

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

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

-- | eBird dates are formatted as YYYY-MM-DD, with 0 padding where necessary.
instance EBirdString EBirdDate where
  toEBirdString :: EBirdDate -> Text
toEBirdString =
      String -> Text
Text.pack (String -> Text) -> (EBirdDate -> String) -> EBirdDate -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> Day -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%04Y-%02m-%02d" (Day -> String) -> (EBirdDate -> Day) -> EBirdDate -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EBirdDate -> Day
eBirdDate

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

-- | eBird times are formatted as HH:MM, with 0 padding where necessary.
instance EBirdString EBirdTime where
  toEBirdString :: EBirdTime -> Text
toEBirdString =
      String -> Text
Text.pack (String -> Text) -> (EBirdTime -> String) -> EBirdTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> TimeOfDay -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%02H:%02M" (TimeOfDay -> String)
-> (EBirdTime -> TimeOfDay) -> EBirdTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EBirdTime -> TimeOfDay
eBirdTime

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

-- | eBird datetimes are formatted as YYYY-MM-DD HH:MM, with 0 padding where
-- necessary.
instance EBirdString EBirdDateTime where
  toEBirdString :: EBirdDateTime -> Text
toEBirdString =
        String -> Text
Text.pack
      (String -> Text)
-> (EBirdDateTime -> String) -> EBirdDateTime -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeLocale -> String -> LocalTime -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
formatTime TimeLocale
defaultTimeLocale String
"%04Y-%02m-%02d %02H:%02M"
      (LocalTime -> String)
-> (EBirdDateTime -> LocalTime) -> EBirdDateTime -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EBirdDateTime -> LocalTime
eBirdDateTime

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

-------------------------------------------------------------------------------
-- attoparsec parsers
-------------------------------------------------------------------------------

-- | Parse an eBird date. Most eBird dates are formatted as YYYY-MM-DD, but the
-- 'Data.EBird.API.ChecklistFeedAPI' gives dates in a format like "19 Jul 2023". So,
-- we try parsing the first format using 'day', and then use a custom
-- 'parseTimeM' format for the latter format if that fails.
parseEBirdDate :: Parser EBirdDate
parseEBirdDate :: Parser EBirdDate
parseEBirdDate = Parser EBirdDate
tryDay Parser EBirdDate -> Parser EBirdDate -> Parser EBirdDate
forall a. Parser Text a -> Parser Text a -> Parser Text a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Parser EBirdDate
tryParseTimeM
  where
    tryDay :: Parser EBirdDate
    tryDay :: Parser EBirdDate
tryDay = Day -> EBirdDate
EBirdDate (Day -> EBirdDate) -> Parser Text Day -> Parser EBirdDate
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text Day
day

    tryParseTimeM :: Parser EBirdDate
    tryParseTimeM :: Parser EBirdDate
tryParseTimeM = do
      Text
input <- Parser Text
takeText
      Day
d <- Bool -> TimeLocale -> String -> String -> Parser Text Day
forall (m :: * -> *) t.
(MonadFail m, ParseTime t) =>
Bool -> TimeLocale -> String -> String -> m t
parseTimeM
        Bool
False
        TimeLocale
defaultTimeLocale
        String
"%e %b %Y"
        (Text -> String
Text.unpack Text
input)
      EBirdDate -> Parser EBirdDate
forall a. a -> Parser Text a
forall (m :: * -> *) a. Monad m => a -> m a
return (Day -> EBirdDate
EBirdDate Day
d)

-- | Parse an eBird time (just uses 'timeOfDay').
parseEBirdTime :: Parser EBirdTime
parseEBirdTime :: Parser EBirdTime
parseEBirdTime = TimeOfDay -> EBirdTime
EBirdTime (TimeOfDay -> EBirdTime)
-> Parser Text TimeOfDay -> Parser EBirdTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text TimeOfDay
timeOfDay

-- | Parse an eBird datetime (just uses 'localTime').
parseEBirdDateTime :: Parser EBirdDateTime
parseEBirdDateTime :: Parser EBirdDateTime
parseEBirdDateTime = LocalTime -> EBirdDateTime
EBirdDateTime (LocalTime -> EBirdDateTime)
-> Parser Text LocalTime -> Parser EBirdDateTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text LocalTime
localTime