{-# LANGUAGE OverloadedStrings #-}
-- |
-- Module: NetSpider.Timestamp
-- Description: Timestamp type
-- Maintainer: Toshio Ito <debug.ito@gmail.com>
--
-- 
module NetSpider.Timestamp
       ( -- * The type
         Timestamp(..),
         -- * Construction
         fromEpochMillisecond,
         now,
         -- * Manipulation
         addSec,
         -- * Convert to Timestamp
         parseTimestamp,
         fromS,
         fromZonedTime,
         fromUTCTime,
         fromSystemTime,
         fromLocalTime,
         -- * Convert from Timestamp
         toTime,
         toSystemTime,
         showTimestamp,
         showEpochTime
       ) where

import Control.Applicative ((<$>), (<*>), (<*), (*>), optional, empty)
import Data.Aeson (FromJSON(..), ToJSON(..), Value(..), (.:), (.=))
import qualified Data.Aeson as Aeson
import Data.Char (isDigit)
import Data.Int (Int64)
import Data.List (sortOn)
import Data.Monoid ((<>))
import Data.Text (Text, pack, unpack)
import qualified Data.Text as Text
import Data.Time.Calendar (Day, fromGregorian)
import Data.Time.Clock (UTCTime)
import Data.Time.Clock.System (utcToSystemTime, SystemTime(..), systemToUTCTime)
import qualified Data.Time.Format as DTFormat
import Data.Time.LocalTime
  ( TimeZone(..), getZonedTime, ZonedTime(..), zonedTimeToUTC, LocalTime(LocalTime), localTimeToUTC,
    TimeOfDay(TimeOfDay), utcToLocalTime, utcToZonedTime
  )
import qualified Data.Time.LocalTime as LocalTime
import qualified Text.ParserCombinators.ReadP as P
import Text.Read (readEither)
import Text.Printf (printf)

import NetSpider.GraphML.Attribute
  ( ToAttributes(..),
    AttributeValue(..)
  )

-- | Timestamp when graph elements are observed.
data Timestamp =
  Timestamp
  { Timestamp -> Int64
epochTime :: Int64,
    -- ^ Milliseconds since the epoch. The epoch is usually the
    -- beginning of year 1970.
    Timestamp -> Maybe TimeZone
timeZone :: Maybe TimeZone
  }
  deriving (Int -> Timestamp -> ShowS
[Timestamp] -> ShowS
Timestamp -> String
(Int -> Timestamp -> ShowS)
-> (Timestamp -> String)
-> ([Timestamp] -> ShowS)
-> Show Timestamp
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Timestamp] -> ShowS
$cshowList :: [Timestamp] -> ShowS
show :: Timestamp -> String
$cshow :: Timestamp -> String
showsPrec :: Int -> Timestamp -> ShowS
$cshowsPrec :: Int -> Timestamp -> ShowS
Show,Timestamp -> Timestamp -> Bool
(Timestamp -> Timestamp -> Bool)
-> (Timestamp -> Timestamp -> Bool) -> Eq Timestamp
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Timestamp -> Timestamp -> Bool
$c/= :: Timestamp -> Timestamp -> Bool
== :: Timestamp -> Timestamp -> Bool
$c== :: Timestamp -> Timestamp -> Bool
Eq)

-- | Compare by 'epochTime' only. 'timeZone' is not used.
instance Ord Timestamp where
  compare :: Timestamp -> Timestamp -> Ordering
compare Timestamp
l Timestamp
r = Int64 -> Int64 -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (Timestamp -> Int64
epochTime Timestamp
l) (Timestamp -> Int64
epochTime Timestamp
r)


-- | It can parse JSON string or object. If the input is a JSON
-- string, it is parsed by 'parseTimestamp'.
--
-- @since 0.4.1.0
instance FromJSON Timestamp where
  parseJSON :: Value -> Parser Timestamp
parseJSON (String Text
t) = Parser Timestamp
-> (Timestamp -> Parser Timestamp)
-> Maybe Timestamp
-> Parser Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Parser Timestamp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err_msg) Timestamp -> Parser Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Timestamp -> Parser Timestamp)
-> Maybe Timestamp -> Parser Timestamp
forall a b. (a -> b) -> a -> b
$ String -> Maybe Timestamp
parseTimestamp String
ts
    where
      ts :: String
ts = Text -> String
unpack Text
t
      err_msg :: String
err_msg = String
"Invalid Timestamp string: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
ts
  parseJSON (Object Object
o) = Int64 -> Maybe TimeZone -> Timestamp
Timestamp (Int64 -> Maybe TimeZone -> Timestamp)
-> Parser Int64 -> Parser (Maybe TimeZone -> Timestamp)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
o Object -> Text -> Parser Int64
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"epoch_time") Parser (Maybe TimeZone -> Timestamp)
-> Parser (Maybe TimeZone) -> Parser Timestamp
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser (Maybe TimeZone)
parseTZ Object
o
    where
      parseTZ :: Object -> Parser (Maybe TimeZone)
parseTZ Object
ob = Parser TimeZone -> Parser (Maybe TimeZone)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Parser TimeZone -> Parser (Maybe TimeZone))
-> Parser TimeZone -> Parser (Maybe TimeZone)
forall a b. (a -> b) -> a -> b
$ Int -> Bool -> String -> TimeZone
TimeZone
                   (Int -> Bool -> String -> TimeZone)
-> Parser Int -> Parser (Bool -> String -> TimeZone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Object
ob Object -> Text -> Parser Int
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tz_offset_min")
                   Parser (Bool -> String -> TimeZone)
-> Parser Bool -> Parser (String -> TimeZone)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
ob Object -> Text -> Parser Bool
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tz_summer_only")
                   Parser (String -> TimeZone) -> Parser String -> Parser TimeZone
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Object
ob Object -> Text -> Parser String
forall a. FromJSON a => Object -> Text -> Parser a
.: Text
"tz_name")
  parseJSON Value
_ = Parser Timestamp
forall (f :: * -> *) a. Alternative f => f a
empty
  


-- | Convert to a JSON object.
--
-- @since 0.4.1.0
instance ToJSON Timestamp where
  toJSON :: Timestamp -> Value
toJSON Timestamp
t = [Pair] -> Value
Aeson.object ([Pair] -> Value) -> [Pair] -> Value
forall a b. (a -> b) -> a -> b
$
             [ Text
"epoch_time" Text -> Int64 -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Text -> v -> kv
.= Timestamp -> Int64
epochTime Timestamp
t
             ]
             [Pair] -> [Pair] -> [Pair]
forall a. [a] -> [a] -> [a]
++ [Pair]
tz_fields
    where
      tz_fields :: [Pair]
tz_fields = (((Text, AttributeValue) -> Pair)
-> [(Text, AttributeValue)] -> [Pair]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Text, AttributeValue) -> Pair)
 -> [(Text, AttributeValue)] -> [Pair])
-> ((AttributeValue -> Value) -> (Text, AttributeValue) -> Pair)
-> (AttributeValue -> Value)
-> [(Text, AttributeValue)]
-> [Pair]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (AttributeValue -> Value) -> (Text, AttributeValue) -> Pair
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) AttributeValue -> Value
forall a. ToJSON a => a -> Value
toJSON ([(Text, AttributeValue)] -> [Pair])
-> [(Text, AttributeValue)] -> [Pair]
forall a b. (a -> b) -> a -> b
$ ((Text, AttributeValue) -> (Text, AttributeValue))
-> [(Text, AttributeValue)] -> [(Text, AttributeValue)]
forall a b. (a -> b) -> [a] -> [b]
map (Text, AttributeValue) -> (Text, AttributeValue)
forall b. (Text, b) -> (Text, b)
fixKeyPrefix ([(Text, AttributeValue)] -> [(Text, AttributeValue)])
-> [(Text, AttributeValue)] -> [(Text, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ Maybe TimeZone -> [(Text, AttributeValue)]
forall a. ToAttributes a => a -> [(Text, AttributeValue)]
toAttributes (Maybe TimeZone -> [(Text, AttributeValue)])
-> Maybe TimeZone -> [(Text, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ Timestamp -> Maybe TimeZone
timeZone Timestamp
t
      fixKeyPrefix :: (Text, b) -> (Text, b)
fixKeyPrefix (Text
k, b
v) = (Text -> Text
Text.tail Text
k, b
v)


-- | @since 0.4.1.0
instance ToAttributes Timestamp where
  toAttributes :: Timestamp -> [(Text, AttributeValue)]
toAttributes Timestamp
t =
    [ (Text
"@timestamp", Integer -> AttributeValue
AttrLong (Integer -> AttributeValue) -> Integer -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Int64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Int64 -> Integer) -> Int64 -> Integer
forall a b. (a -> b) -> a -> b
$ Timestamp -> Int64
epochTime Timestamp
t),
      (Text
"@timestamp_str", Text -> AttributeValue
AttrString (Text -> AttributeValue) -> Text -> AttributeValue
forall a b. (a -> b) -> a -> b
$ Timestamp -> Text
showTimestamp Timestamp
t)
    ] [(Text, AttributeValue)]
-> [(Text, AttributeValue)] -> [(Text, AttributeValue)]
forall a. [a] -> [a] -> [a]
++ [(Text, AttributeValue)]
timezone_attrs
    where
      timezone_attrs :: [(Text, AttributeValue)]
timezone_attrs = [(Text, AttributeValue)]
-> (TimeZone -> [(Text, AttributeValue)])
-> Maybe TimeZone
-> [(Text, AttributeValue)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] TimeZone -> [(Text, AttributeValue)]
forall a. ToAttributes a => a -> [(Text, AttributeValue)]
toAttributes (Maybe TimeZone -> [(Text, AttributeValue)])
-> Maybe TimeZone -> [(Text, AttributeValue)]
forall a b. (a -> b) -> a -> b
$ Timestamp -> Maybe TimeZone
timeZone Timestamp
t

-- | Make 'Timestamp' from milliseconds from the epoch. 'timeZone' is
-- 'Nothing'.
--
-- @since 0.2.0.0
fromEpochMillisecond :: Int64 -> Timestamp
fromEpochMillisecond :: Int64 -> Timestamp
fromEpochMillisecond Int64
msec = Int64 -> Maybe TimeZone -> Timestamp
Timestamp Int64
msec Maybe TimeZone
forall a. Maybe a
Nothing

-- | Show 'Timestamp' with a basic ISO 8601 format.
--
-- >>> showTimestamp $ fromS "2019-10-20T12:45:00"
-- "2019-10-20T12:45:00.000"
-- >>> showTimestamp $ fromS "1999-03-21T10:11Z"
-- "1999-03-21T10:11:00.000Z"
-- >>> showTimestamp $ fromS "2016-11-30T22:03:00.034+09:00"
-- "2016-11-30T22:03:00.034+09:00"
-- >>> showTimestamp $ fromS "2000-04-07T09:31-05:00"
-- "2000-04-07T09:31:00.000-05:00"
--
-- @since 0.3.1.0
showTimestamp :: Timestamp -> Text
showTimestamp :: Timestamp -> Text
showTimestamp = String -> Text
pack (String -> Text) -> (Timestamp -> String) -> Timestamp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LocalTime -> String)
-> (ZonedTime -> String) -> Either LocalTime ZonedTime -> String
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either LocalTime -> String
forall t. FormatTime t => t -> String
simpleFormat ZonedTime -> String
formatZT (Either LocalTime ZonedTime -> String)
-> (Timestamp -> Either LocalTime ZonedTime) -> Timestamp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> Either LocalTime ZonedTime
toTime
  where
    dtFormat :: DTFormat.FormatTime t => String -> t -> String
    dtFormat :: String -> t -> String
dtFormat = TimeLocale -> String -> t -> String
forall t. FormatTime t => TimeLocale -> String -> t -> String
DTFormat.formatTime TimeLocale
DTFormat.defaultTimeLocale
    simpleFormat :: DTFormat.FormatTime t => t -> String
    simpleFormat :: t -> String
simpleFormat = String -> t -> String
forall t. FormatTime t => String -> t -> String
dtFormat String
"%Y-%m-%dT%H:%M:%S.%03q"
    formatZT :: ZonedTime -> String
formatZT ZonedTime
zt = ZonedTime -> String
forall t. FormatTime t => t -> String
simpleFormat ZonedTime
zt String -> ShowS
forall a. Semigroup a => a -> a -> a
<> TimeZone -> String
formatZone (ZonedTime -> TimeZone
zonedTimeZone ZonedTime
zt)
    formatZone :: TimeZone -> String
formatZone TimeZone
z = if TimeZone -> String
timeZoneName TimeZone
z String -> String -> Bool
forall a. Eq a => a -> a -> Bool
== String
""
                   then Int -> String
forall a a.
(Semigroup a, PrintfArg a, PrintfType a, Integral a, IsString a) =>
a -> a
formatOffset (Int -> String) -> Int -> String
forall a b. (a -> b) -> a -> b
$ TimeZone -> Int
timeZoneMinutes TimeZone
z
                   else if TimeZone
z TimeZone -> TimeZone -> Bool
forall a. Eq a => a -> a -> Bool
== TimeZone
LocalTime.utc
                        then String
"Z"
                        else String -> TimeZone -> String
forall t. FormatTime t => String -> t -> String
dtFormat String
"%Z" TimeZone
z
    formatOffset :: a -> a
formatOffset a
o = a
sign a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
hour a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
":" a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
minute
      where
        sign :: a
sign = if a
o a -> a -> Bool
forall a. Ord a => a -> a -> Bool
< a
0 then a
"-" else a
"+"
        abo :: a
abo = a -> a
forall a. Num a => a -> a
abs a
o
        hour :: a
hour = String -> a -> a
forall r. PrintfType r => String -> r
printf String
"%02d" (a
abo a -> a -> a
forall a. Integral a => a -> a -> a
`div` a
60)
        minute :: a
minute = String -> a -> a
forall r. PrintfType r => String -> r
printf String
"%02d" (a
abo a -> a -> a
forall a. Integral a => a -> a -> a
`mod` a
60)

-- | Show 'epochTime' of 'Timestamp' as 'Text'.
--
-- @since 0.2.0.0
showEpochTime :: Timestamp -> Text
showEpochTime :: Timestamp -> Text
showEpochTime = String -> Text
pack (String -> Text) -> (Timestamp -> String) -> Timestamp -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> String
forall a. Show a => a -> String
show (Int64 -> String) -> (Timestamp -> Int64) -> Timestamp -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Timestamp -> Int64
epochTime

-- | Convert to 'LocalTime' (if the 'Timestamp' has no time zone) or
-- 'ZonedTime' (otherwise). If it makes the 'LocalTime' as if the time
-- zone was UTC.
--
-- @since 0.3.1.0
toTime :: Timestamp -> Either LocalTime ZonedTime
toTime :: Timestamp -> Either LocalTime ZonedTime
toTime Timestamp
ts = Either LocalTime ZonedTime
-> (TimeZone -> Either LocalTime ZonedTime)
-> Maybe TimeZone
-> Either LocalTime ZonedTime
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (LocalTime -> Either LocalTime ZonedTime
forall a b. a -> Either a b
Left LocalTime
localtime) (ZonedTime -> Either LocalTime ZonedTime
forall a b. b -> Either a b
Right (ZonedTime -> Either LocalTime ZonedTime)
-> (TimeZone -> ZonedTime)
-> TimeZone
-> Either LocalTime ZonedTime
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TimeZone -> ZonedTime
toZT) (Maybe TimeZone -> Either LocalTime ZonedTime)
-> Maybe TimeZone -> Either LocalTime ZonedTime
forall a b. (a -> b) -> a -> b
$ Timestamp -> Maybe TimeZone
timeZone Timestamp
ts
  where
    utctime :: UTCTime
utctime = SystemTime -> UTCTime
systemToUTCTime (SystemTime -> UTCTime) -> SystemTime -> UTCTime
forall a b. (a -> b) -> a -> b
$ Timestamp -> SystemTime
toSystemTime Timestamp
ts
    localtime :: LocalTime
localtime = TimeZone -> UTCTime -> LocalTime
utcToLocalTime TimeZone
LocalTime.utc UTCTime
utctime
    toZT :: TimeZone -> ZonedTime
toZT TimeZone
tz = TimeZone -> UTCTime -> ZonedTime
utcToZonedTime TimeZone
tz UTCTime
utctime

-- | Convert 'Timestamp' to 'SystemTime'. It discards 'timeZone'
-- field.
--
-- >>> toSystemTime $ fromEpochMillisecond 1043221
-- MkSystemTime {systemSeconds = 1043, systemNanoseconds = 221000000}
-- >>> toSystemTime $ fromEpochMillisecond (-192332)
-- MkSystemTime {systemSeconds = -193, systemNanoseconds = 668000000}
--
-- @since 0.3.1.0
toSystemTime :: Timestamp -> SystemTime
toSystemTime :: Timestamp -> SystemTime
toSystemTime Timestamp
ts = Int64 -> Word32 -> SystemTime
MkSystemTime Int64
sec Word32
nsec
  where
    epoch_time :: Int64
epoch_time = Timestamp -> Int64
epochTime Timestamp
ts
    sec :: Int64
sec = Int64
epoch_time Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`div` Int64
1000
    nsec :: Word32
nsec = Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64
epoch_time Int64 -> Int64 -> Int64
forall a. Integral a => a -> a -> a
`mod` Int64
1000) Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
* Word32
1000000

-- | Get the current system time.
--
-- @since 0.2.0.0
now :: IO Timestamp
now :: IO Timestamp
now = (ZonedTime -> Timestamp) -> IO ZonedTime -> IO Timestamp
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ZonedTime -> Timestamp
fromZonedTime (IO ZonedTime -> IO Timestamp) -> IO ZonedTime -> IO Timestamp
forall a b. (a -> b) -> a -> b
$ IO ZonedTime
getZonedTime

-- | @since 0.2.0.0
fromZonedTime :: ZonedTime -> Timestamp
fromZonedTime :: ZonedTime -> Timestamp
fromZonedTime ZonedTime
zt =
  (UTCTime -> Timestamp
fromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ ZonedTime -> UTCTime
zonedTimeToUTC ZonedTime
zt) { timeZone :: Maybe TimeZone
timeZone = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just (TimeZone -> Maybe TimeZone) -> TimeZone -> Maybe TimeZone
forall a b. (a -> b) -> a -> b
$ ZonedTime -> TimeZone
zonedTimeZone ZonedTime
zt }

-- | @since 0.2.0.0
fromUTCTime :: UTCTime -> Timestamp
fromUTCTime :: UTCTime -> Timestamp
fromUTCTime UTCTime
ut = (SystemTime -> Timestamp
fromSystemTime (SystemTime -> Timestamp) -> SystemTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ UTCTime -> SystemTime
utcToSystemTime UTCTime
ut) { timeZone :: Maybe TimeZone
timeZone = TimeZone -> Maybe TimeZone
forall a. a -> Maybe a
Just TimeZone
LocalTime.utc }

-- | @since 0.2.0.0
fromSystemTime :: SystemTime -> Timestamp
fromSystemTime :: SystemTime -> Timestamp
fromSystemTime SystemTime
stime = Timestamp :: Int64 -> Maybe TimeZone -> Timestamp
Timestamp { epochTime :: Int64
epochTime = Int64
epoch_time,
                                   timeZone :: Maybe TimeZone
timeZone = Maybe TimeZone
forall a. Maybe a
Nothing
                                 }
  where
    epoch_time :: Int64
epoch_time = (SystemTime -> Int64
systemSeconds SystemTime
stime Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000)
                 Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (SystemTime -> Word32
systemNanoseconds SystemTime
stime Word32 -> Word32 -> Word32
forall a. Integral a => a -> a -> a
`div` Word32
1000000)

-- | Covert 'LocalTime' to 'Timestamp' assuming it's in UTC time
-- zone. The 'timeZone' field is 'Nothing'.
--
-- @since 0.2.0.0
fromLocalTime :: LocalTime -> Timestamp
fromLocalTime :: LocalTime -> Timestamp
fromLocalTime LocalTime
lt = (UTCTime -> Timestamp
fromUTCTime (UTCTime -> Timestamp) -> UTCTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ TimeZone -> LocalTime -> UTCTime
localTimeToUTC TimeZone
LocalTime.utc LocalTime
lt) { timeZone :: Maybe TimeZone
timeZone = Maybe TimeZone
forall a. Maybe a
Nothing }

-- | Add time difference (in seconds) to the 'Timestamp'.
--
-- @since 0.2.0.0
addSec :: Int64 -> Timestamp -> Timestamp
addSec :: Int64 -> Timestamp -> Timestamp
addSec Int64
diff Timestamp
ts = Timestamp
ts { epochTime :: Int64
epochTime = (Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
+ (Int64
diff Int64 -> Int64 -> Int64
forall a. Num a => a -> a -> a
* Int64
1000)) (Int64 -> Int64) -> Int64 -> Int64
forall a b. (a -> b) -> a -> b
$ Timestamp -> Int64
epochTime Timestamp
ts }

-- | Unsafe version of 'parseTimestamp'.
--
-- @since 0.2.0.0
fromS :: String -> Timestamp
fromS :: String -> Timestamp
fromS String
s = Timestamp
-> (Timestamp -> Timestamp) -> Maybe Timestamp -> Timestamp
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Timestamp
forall a. HasCallStack => String -> a
error String
msg) Timestamp -> Timestamp
forall a. a -> a
id (Maybe Timestamp -> Timestamp) -> Maybe Timestamp -> Timestamp
forall a b. (a -> b) -> a -> b
$ String -> Maybe Timestamp
parseTimestamp String
s
  where
    msg :: String
msg = String
"Fail to parse " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
s

-- | Parse a string into 'Timestamp'. The format is like ISO8601 with
-- a little relaxation.
--
-- >>> let timeAndOffset ts = (epochTime ts, fmap timeZoneMinutes $ timeZone ts)
-- >>> fmap timeAndOffset $ parseTimestamp "2018-10-11T11:20:10"
-- Just (1539256810000,Nothing)
-- >>> fmap timeAndOffset $ parseTimestamp "2018-10-11 11:20:10"
-- Just (1539256810000,Nothing)
-- >>> fmap timeAndOffset $ parseTimestamp "2015-03-23 03:33Z"
-- Just (1427081580000,Just 0)
-- >>> fmap timeAndOffset $ parseTimestamp "1999-01-05 20:34:44.211+09:00"
-- Just (915536084211,Just 540)
-- >>> fmap timeAndOffset $ parseTimestamp "2007/08/20T22:25-07:00"
-- Just (1187673900000,Just (-420))
--
-- @since 0.2.0.0
parseTimestamp :: String -> Maybe Timestamp
parseTimestamp :: String -> Maybe Timestamp
parseTimestamp String
s = [(Timestamp, String)] -> Maybe Timestamp
forall a b. [(a, b)] -> Maybe a
toTs ([(Timestamp, String)] -> Maybe Timestamp)
-> [(Timestamp, String)] -> Maybe Timestamp
forall a b. (a -> b) -> a -> b
$ [(Timestamp, String)] -> [(Timestamp, String)]
forall a a. [(a, [a])] -> [(a, [a])]
sortByLeftover ([(Timestamp, String)] -> [(Timestamp, String)])
-> [(Timestamp, String)] -> [(Timestamp, String)]
forall a b. (a -> b) -> a -> b
$ ReadP Timestamp -> ReadS Timestamp
forall a. ReadP a -> ReadS a
P.readP_to_S ReadP Timestamp
parserTimestamp String
s
  where
    sortByLeftover :: [(a, [a])] -> [(a, [a])]
sortByLeftover = ((a, [a]) -> Int) -> [(a, [a])] -> [(a, [a])]
forall b a. Ord b => (a -> b) -> [a] -> [a]
sortOn (((a, [a]) -> Int) -> [(a, [a])] -> [(a, [a])])
-> ((a, [a]) -> Int) -> [(a, [a])] -> [(a, [a])]
forall a b. (a -> b) -> a -> b
$ \(a
_, [a]
leftover) -> [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [a]
leftover
    toTs :: [(a, b)] -> Maybe a
toTs ((a
ret, b
_) : [(a, b)]
_) = a -> Maybe a
forall a. a -> Maybe a
Just a
ret
    toTs [] = Maybe a
forall a. Maybe a
Nothing

parserTimestamp :: P.ReadP Timestamp
parserTimestamp :: ReadP Timestamp
parserTimestamp = do
  Day
day <- ReadP Day
parserDay ReadP Day -> ReadP Char -> ReadP Day
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP Char
delim
  TimeOfDay
time <- ReadP TimeOfDay
parserTime
  Maybe TimeZone
mtz <- ReadP TimeZone -> ReadP (Maybe TimeZone)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadP TimeZone
parserUTC ReadP TimeZone -> ReadP TimeZone -> ReadP TimeZone
forall a. ReadP a -> ReadP a -> ReadP a
P.+++ ReadP TimeZone
parserOffset)
  let ltime :: LocalTime
ltime = Day -> TimeOfDay -> LocalTime
LocalTime Day
day TimeOfDay
time
  case Maybe TimeZone
mtz of
   Maybe TimeZone
Nothing -> Timestamp -> ReadP Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> ReadP Timestamp) -> Timestamp -> ReadP Timestamp
forall a b. (a -> b) -> a -> b
$ LocalTime -> Timestamp
fromLocalTime LocalTime
ltime
   Just TimeZone
tz -> Timestamp -> ReadP Timestamp
forall (m :: * -> *) a. Monad m => a -> m a
return (Timestamp -> ReadP Timestamp) -> Timestamp -> ReadP Timestamp
forall a b. (a -> b) -> a -> b
$ ZonedTime -> Timestamp
fromZonedTime (ZonedTime -> Timestamp) -> ZonedTime -> Timestamp
forall a b. (a -> b) -> a -> b
$ LocalTime -> TimeZone -> ZonedTime
ZonedTime LocalTime
ltime TimeZone
tz
  where
    delim :: ReadP Char
delim = [ReadP Char] -> ReadP Char
forall a. [ReadP a] -> ReadP a
P.choice ([ReadP Char] -> ReadP Char) -> [ReadP Char] -> ReadP Char
forall a b. (a -> b) -> a -> b
$ (Char -> ReadP Char) -> String -> [ReadP Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ReadP Char
P.char String
" T"

parserRead :: Read a => String -> P.ReadP a
parserRead :: String -> ReadP a
parserRead String
input = (String -> ReadP a) -> (a -> ReadP a) -> Either String a -> ReadP a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either String -> ReadP a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> ReadP a) -> Either String a -> ReadP a
forall a b. (a -> b) -> a -> b
$ String -> Either String a
forall a. Read a => String -> Either String a
readEither String
input

parserDec :: Read a => P.ReadP a
parserDec :: ReadP a
parserDec = String -> ReadP a
forall a. Read a => String -> ReadP a
parserRead (String -> ReadP a) -> ReadP String -> ReadP a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit

parserFracDec :: Read a => P.ReadP a
parserFracDec :: ReadP a
parserFracDec = do
  String
int <- (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit
  String
frac <- (Maybe String -> String) -> ReadP (Maybe String) -> ReadP String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> ShowS -> Maybe String -> String
forall b a. b -> (a -> b) -> Maybe a -> b
maybe String
"" ShowS
forall a. a -> a
id) (ReadP (Maybe String) -> ReadP String)
-> ReadP (Maybe String) -> ReadP String
forall a b. (a -> b) -> a -> b
$ ReadP String -> ReadP (Maybe String)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ((:) (Char -> ShowS) -> ReadP Char -> ReadP ShowS
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> ReadP Char
P.char Char
'.' ReadP ShowS -> ReadP String -> ReadP String
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Char -> Bool) -> ReadP String
P.munch1 Char -> Bool
isDigit)
  a -> ReadP a
forall (m :: * -> *) a. Monad m => a -> m a
return (a -> ReadP a) -> a -> ReadP a
forall a b. (a -> b) -> a -> b
$ String -> a
forall a. Read a => String -> a
read (String
int String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
frac)

parserDay :: P.ReadP Day
parserDay :: ReadP Day
parserDay = Integer -> Int -> Int -> Day
fromGregorian
            (Integer -> Int -> Int -> Day)
-> ReadP Integer -> ReadP (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (ReadP Integer
forall a. Read a => ReadP a
parserDec ReadP Integer -> ReadP Char -> ReadP Integer
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP Char
delim)
            ReadP (Int -> Int -> Day) -> ReadP Int -> ReadP (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadP Int
forall a. Read a => ReadP a
parserDec ReadP Int -> ReadP Char -> ReadP Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP Char
delim)
            ReadP (Int -> Day) -> ReadP Int -> ReadP Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP Int
forall a. Read a => ReadP a
parserDec
  where
    delim :: ReadP Char
delim = [ReadP Char] -> ReadP Char
forall a. [ReadP a] -> ReadP a
P.choice ([ReadP Char] -> ReadP Char) -> [ReadP Char] -> ReadP Char
forall a b. (a -> b) -> a -> b
$ (Char -> ReadP Char) -> String -> [ReadP Char]
forall a b. (a -> b) -> [a] -> [b]
map Char -> ReadP Char
P.char String
"-/"

parserTime :: P.ReadP TimeOfDay
parserTime :: ReadP TimeOfDay
parserTime = Int -> Int -> Pico -> TimeOfDay
TimeOfDay
             (Int -> Int -> Pico -> TimeOfDay)
-> ReadP Int -> ReadP (Int -> Pico -> TimeOfDay)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP Int
forall a. Read a => ReadP a
parserDec
             ReadP (Int -> Pico -> TimeOfDay)
-> ReadP Int -> ReadP (Pico -> TimeOfDay)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadP Char
delim ReadP Char -> ReadP Int -> ReadP Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP Int
forall a. Read a => ReadP a
parserDec)
             ReadP (Pico -> TimeOfDay) -> ReadP Pico -> ReadP TimeOfDay
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ((ReadP Char
delim ReadP Char -> ReadP Pico -> ReadP Pico
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ReadP Pico
forall a. Read a => ReadP a
parserFracDec) ReadP Pico -> ReadP Pico -> ReadP Pico
forall a. ReadP a -> ReadP a -> ReadP a
P.<++ Pico -> ReadP Pico
forall (f :: * -> *) a. Applicative f => a -> f a
pure Pico
0)
  where
    delim :: ReadP Char
delim = Char -> ReadP Char
P.char Char
':'


parserUTC :: P.ReadP TimeZone
parserUTC :: ReadP TimeZone
parserUTC = do
  Char
s <- ReadP Char
P.get
  case Char
s of
   Char
'Z' -> TimeZone -> ReadP TimeZone
forall (m :: * -> *) a. Monad m => a -> m a
return TimeZone
LocalTime.utc
   Char
c -> String -> ReadP TimeZone
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Not a UTC symbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)

data OffsetSign = OffsetPlus
                | OffsetMinus
                deriving (Int -> OffsetSign -> ShowS
[OffsetSign] -> ShowS
OffsetSign -> String
(Int -> OffsetSign -> ShowS)
-> (OffsetSign -> String)
-> ([OffsetSign] -> ShowS)
-> Show OffsetSign
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OffsetSign] -> ShowS
$cshowList :: [OffsetSign] -> ShowS
show :: OffsetSign -> String
$cshow :: OffsetSign -> String
showsPrec :: Int -> OffsetSign -> ShowS
$cshowsPrec :: Int -> OffsetSign -> ShowS
Show,OffsetSign -> OffsetSign -> Bool
(OffsetSign -> OffsetSign -> Bool)
-> (OffsetSign -> OffsetSign -> Bool) -> Eq OffsetSign
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OffsetSign -> OffsetSign -> Bool
$c/= :: OffsetSign -> OffsetSign -> Bool
== :: OffsetSign -> OffsetSign -> Bool
$c== :: OffsetSign -> OffsetSign -> Bool
Eq,Eq OffsetSign
Eq OffsetSign
-> (OffsetSign -> OffsetSign -> Ordering)
-> (OffsetSign -> OffsetSign -> Bool)
-> (OffsetSign -> OffsetSign -> Bool)
-> (OffsetSign -> OffsetSign -> Bool)
-> (OffsetSign -> OffsetSign -> Bool)
-> (OffsetSign -> OffsetSign -> OffsetSign)
-> (OffsetSign -> OffsetSign -> OffsetSign)
-> Ord OffsetSign
OffsetSign -> OffsetSign -> Bool
OffsetSign -> OffsetSign -> Ordering
OffsetSign -> OffsetSign -> OffsetSign
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
min :: OffsetSign -> OffsetSign -> OffsetSign
$cmin :: OffsetSign -> OffsetSign -> OffsetSign
max :: OffsetSign -> OffsetSign -> OffsetSign
$cmax :: OffsetSign -> OffsetSign -> OffsetSign
>= :: OffsetSign -> OffsetSign -> Bool
$c>= :: OffsetSign -> OffsetSign -> Bool
> :: OffsetSign -> OffsetSign -> Bool
$c> :: OffsetSign -> OffsetSign -> Bool
<= :: OffsetSign -> OffsetSign -> Bool
$c<= :: OffsetSign -> OffsetSign -> Bool
< :: OffsetSign -> OffsetSign -> Bool
$c< :: OffsetSign -> OffsetSign -> Bool
compare :: OffsetSign -> OffsetSign -> Ordering
$ccompare :: OffsetSign -> OffsetSign -> Ordering
$cp1Ord :: Eq OffsetSign
Ord,Int -> OffsetSign
OffsetSign -> Int
OffsetSign -> [OffsetSign]
OffsetSign -> OffsetSign
OffsetSign -> OffsetSign -> [OffsetSign]
OffsetSign -> OffsetSign -> OffsetSign -> [OffsetSign]
(OffsetSign -> OffsetSign)
-> (OffsetSign -> OffsetSign)
-> (Int -> OffsetSign)
-> (OffsetSign -> Int)
-> (OffsetSign -> [OffsetSign])
-> (OffsetSign -> OffsetSign -> [OffsetSign])
-> (OffsetSign -> OffsetSign -> [OffsetSign])
-> (OffsetSign -> OffsetSign -> OffsetSign -> [OffsetSign])
-> Enum OffsetSign
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: OffsetSign -> OffsetSign -> OffsetSign -> [OffsetSign]
$cenumFromThenTo :: OffsetSign -> OffsetSign -> OffsetSign -> [OffsetSign]
enumFromTo :: OffsetSign -> OffsetSign -> [OffsetSign]
$cenumFromTo :: OffsetSign -> OffsetSign -> [OffsetSign]
enumFromThen :: OffsetSign -> OffsetSign -> [OffsetSign]
$cenumFromThen :: OffsetSign -> OffsetSign -> [OffsetSign]
enumFrom :: OffsetSign -> [OffsetSign]
$cenumFrom :: OffsetSign -> [OffsetSign]
fromEnum :: OffsetSign -> Int
$cfromEnum :: OffsetSign -> Int
toEnum :: Int -> OffsetSign
$ctoEnum :: Int -> OffsetSign
pred :: OffsetSign -> OffsetSign
$cpred :: OffsetSign -> OffsetSign
succ :: OffsetSign -> OffsetSign
$csucc :: OffsetSign -> OffsetSign
Enum,OffsetSign
OffsetSign -> OffsetSign -> Bounded OffsetSign
forall a. a -> a -> Bounded a
maxBound :: OffsetSign
$cmaxBound :: OffsetSign
minBound :: OffsetSign
$cminBound :: OffsetSign
Bounded)

parserOffset :: P.ReadP TimeZone
parserOffset :: ReadP TimeZone
parserOffset = OffsetSign -> Int -> Int -> TimeZone
offsetToTz (OffsetSign -> Int -> Int -> TimeZone)
-> ReadP OffsetSign -> ReadP (Int -> Int -> TimeZone)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadP OffsetSign
osign ReadP (Int -> Int -> TimeZone)
-> ReadP Int -> ReadP (Int -> TimeZone)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ReadP Int
forall a. Read a => ReadP a
parserDec ReadP Int -> ReadP (Maybe Char) -> ReadP Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ReadP (Maybe Char)
delim) ReadP (Int -> TimeZone) -> ReadP Int -> ReadP TimeZone
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadP Int
forall a. Read a => ReadP a
parserDec
  where
    osign :: ReadP OffsetSign
osign = do
      Char
s <- ReadP Char
P.get
      case Char
s of
       Char
'+' -> OffsetSign -> ReadP OffsetSign
forall (m :: * -> *) a. Monad m => a -> m a
return OffsetSign
OffsetPlus
       Char
'-' -> OffsetSign -> ReadP OffsetSign
forall (m :: * -> *) a. Monad m => a -> m a
return OffsetSign
OffsetMinus
       Char
c -> String -> ReadP OffsetSign
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Not a sign symbol: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Char -> String
forall a. Show a => a -> String
show Char
c)
    delim :: ReadP (Maybe Char)
delim = ReadP Char -> ReadP (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ReadP Char -> ReadP (Maybe Char))
-> ReadP Char -> ReadP (Maybe Char)
forall a b. (a -> b) -> a -> b
$ Char -> ReadP Char
P.char Char
':'

offsetToTz :: OffsetSign -> Int -> Int -> TimeZone
offsetToTz :: OffsetSign -> Int -> Int -> TimeZone
offsetToTz OffsetSign
osign Int
h Int
m = TimeZone :: Int -> Bool -> String -> TimeZone
TimeZone { timeZoneMinutes :: Int
timeZoneMinutes = Int
intsign Int -> Int -> Int
forall a. Num a => a -> a -> a
* (Int
h Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
60 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
m),
                                  timeZoneSummerOnly :: Bool
timeZoneSummerOnly = Bool
False,
                                  timeZoneName :: String
timeZoneName = String
""
                                }
  where
    intsign :: Int
intsign = case OffsetSign
osign of
      OffsetSign
OffsetPlus -> Int
1
      OffsetSign
OffsetMinus -> -Int
1