----------------------------------------------------------------------

----------------------------------------------------------------------

-- |
-- Module: Web.Slack.Types
-- Description:
module Web.Slack.Types
  ( Color (..),
    UserId (..),
    ConversationId (..),
    TeamId (..),
    Cursor (..),
    SlackTimestamp (..),
    mkSlackTimestamp,
    timestampFromText,
    SlackMessageText (..),
  )
where

import Control.Monad (MonadFail (..))
import Data.Aeson
import Data.Text qualified as T
import Data.Text.Read (rational)
import Data.Time.Clock
import Data.Time.Clock.POSIX
import Web.HttpApiData
import Web.Slack.Pager.Types
import Web.Slack.Prelude

-- Ord to allow it to be a key of a Map
newtype Color = Color {Color -> Text
unColor :: Text}
  deriving stock (Color -> Color -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c== :: Color -> Color -> Bool
Eq, Eq Color
Color -> Color -> Bool
Color -> Color -> Ordering
Color -> Color -> Color
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 :: Color -> Color -> Color
$cmin :: Color -> Color -> Color
max :: Color -> Color -> Color
$cmax :: Color -> Color -> Color
>= :: Color -> Color -> Bool
$c>= :: Color -> Color -> Bool
> :: Color -> Color -> Bool
$c> :: Color -> Color -> Bool
<= :: Color -> Color -> Bool
$c<= :: Color -> Color -> Bool
< :: Color -> Color -> Bool
$c< :: Color -> Color -> Bool
compare :: Color -> Color -> Ordering
$ccompare :: Color -> Color -> Ordering
Ord, forall x. Rep Color x -> Color
forall x. Color -> Rep Color x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Color x -> Color
$cfrom :: forall x. Color -> Rep Color x
Generic, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Color] -> ShowS
$cshowList :: [Color] -> ShowS
show :: Color -> String
$cshow :: Color -> String
showsPrec :: Int -> Color -> ShowS
$cshowsPrec :: Int -> Color -> ShowS
Show)
  deriving newtype (Color -> ()
forall a. (a -> ()) -> NFData a
rnf :: Color -> ()
$crnf :: Color -> ()
NFData, Eq Color
Int -> Color -> Int
Color -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Color -> Int
$chash :: Color -> Int
hashWithSalt :: Int -> Color -> Int
$chashWithSalt :: Int -> Color -> Int
Hashable, Value -> Parser [Color]
Value -> Parser Color
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Color]
$cparseJSONList :: Value -> Parser [Color]
parseJSON :: Value -> Parser Color
$cparseJSON :: Value -> Parser Color
FromJSON, [Color] -> Encoding
[Color] -> Value
Color -> Encoding
Color -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Color] -> Encoding
$ctoEncodingList :: [Color] -> Encoding
toJSONList :: [Color] -> Value
$ctoJSONList :: [Color] -> Value
toEncoding :: Color -> Encoding
$ctoEncoding :: Color -> Encoding
toJSON :: Color -> Value
$ctoJSON :: Color -> Value
ToJSON)

-- Ord to allow it to be a key of a Map
newtype UserId = UserId {UserId -> Text
unUserId :: Text}
  deriving stock (UserId -> UserId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserId -> UserId -> Bool
$c/= :: UserId -> UserId -> Bool
== :: UserId -> UserId -> Bool
$c== :: UserId -> UserId -> Bool
Eq, Eq UserId
UserId -> UserId -> Bool
UserId -> UserId -> Ordering
UserId -> UserId -> UserId
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 :: UserId -> UserId -> UserId
$cmin :: UserId -> UserId -> UserId
max :: UserId -> UserId -> UserId
$cmax :: UserId -> UserId -> UserId
>= :: UserId -> UserId -> Bool
$c>= :: UserId -> UserId -> Bool
> :: UserId -> UserId -> Bool
$c> :: UserId -> UserId -> Bool
<= :: UserId -> UserId -> Bool
$c<= :: UserId -> UserId -> Bool
< :: UserId -> UserId -> Bool
$c< :: UserId -> UserId -> Bool
compare :: UserId -> UserId -> Ordering
$ccompare :: UserId -> UserId -> Ordering
Ord, forall x. Rep UserId x -> UserId
forall x. UserId -> Rep UserId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserId x -> UserId
$cfrom :: forall x. UserId -> Rep UserId x
Generic, Int -> UserId -> ShowS
[UserId] -> ShowS
UserId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserId] -> ShowS
$cshowList :: [UserId] -> ShowS
show :: UserId -> String
$cshow :: UserId -> String
showsPrec :: Int -> UserId -> ShowS
$cshowsPrec :: Int -> UserId -> ShowS
Show)
  deriving newtype (UserId -> ()
forall a. (a -> ()) -> NFData a
rnf :: UserId -> ()
$crnf :: UserId -> ()
NFData, Eq UserId
Int -> UserId -> Int
UserId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: UserId -> Int
$chash :: UserId -> Int
hashWithSalt :: Int -> UserId -> Int
$chashWithSalt :: Int -> UserId -> Int
Hashable, Value -> Parser [UserId]
Value -> Parser UserId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [UserId]
$cparseJSONList :: Value -> Parser [UserId]
parseJSON :: Value -> Parser UserId
$cparseJSON :: Value -> Parser UserId
FromJSON, [UserId] -> Encoding
[UserId] -> Value
UserId -> Encoding
UserId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [UserId] -> Encoding
$ctoEncodingList :: [UserId] -> Encoding
toJSONList :: [UserId] -> Value
$ctoJSONList :: [UserId] -> Value
toEncoding :: UserId -> Encoding
$ctoEncoding :: UserId -> Encoding
toJSON :: UserId -> Value
$ctoJSON :: UserId -> Value
ToJSON, UserId -> ByteString
UserId -> Builder
UserId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: UserId -> Text
$ctoQueryParam :: UserId -> Text
toHeader :: UserId -> ByteString
$ctoHeader :: UserId -> ByteString
toEncodedUrlPiece :: UserId -> Builder
$ctoEncodedUrlPiece :: UserId -> Builder
toUrlPiece :: UserId -> Text
$ctoUrlPiece :: UserId -> Text
ToHttpApiData)

-- | Common identifier for every type of 'Conversation'.
--   Unique to the team which the conversation belongs to.
-- Ord to allow it to be a key of a Map
newtype ConversationId = ConversationId {ConversationId -> Text
unConversationId :: Text}
  deriving stock (ConversationId -> ConversationId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConversationId -> ConversationId -> Bool
$c/= :: ConversationId -> ConversationId -> Bool
== :: ConversationId -> ConversationId -> Bool
$c== :: ConversationId -> ConversationId -> Bool
Eq, Eq ConversationId
ConversationId -> ConversationId -> Bool
ConversationId -> ConversationId -> Ordering
ConversationId -> ConversationId -> ConversationId
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 :: ConversationId -> ConversationId -> ConversationId
$cmin :: ConversationId -> ConversationId -> ConversationId
max :: ConversationId -> ConversationId -> ConversationId
$cmax :: ConversationId -> ConversationId -> ConversationId
>= :: ConversationId -> ConversationId -> Bool
$c>= :: ConversationId -> ConversationId -> Bool
> :: ConversationId -> ConversationId -> Bool
$c> :: ConversationId -> ConversationId -> Bool
<= :: ConversationId -> ConversationId -> Bool
$c<= :: ConversationId -> ConversationId -> Bool
< :: ConversationId -> ConversationId -> Bool
$c< :: ConversationId -> ConversationId -> Bool
compare :: ConversationId -> ConversationId -> Ordering
$ccompare :: ConversationId -> ConversationId -> Ordering
Ord, forall x. Rep ConversationId x -> ConversationId
forall x. ConversationId -> Rep ConversationId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ConversationId x -> ConversationId
$cfrom :: forall x. ConversationId -> Rep ConversationId x
Generic, Int -> ConversationId -> ShowS
[ConversationId] -> ShowS
ConversationId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConversationId] -> ShowS
$cshowList :: [ConversationId] -> ShowS
show :: ConversationId -> String
$cshow :: ConversationId -> String
showsPrec :: Int -> ConversationId -> ShowS
$cshowsPrec :: Int -> ConversationId -> ShowS
Show)
  deriving newtype (ConversationId -> ()
forall a. (a -> ()) -> NFData a
rnf :: ConversationId -> ()
$crnf :: ConversationId -> ()
NFData, Eq ConversationId
Int -> ConversationId -> Int
ConversationId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: ConversationId -> Int
$chash :: ConversationId -> Int
hashWithSalt :: Int -> ConversationId -> Int
$chashWithSalt :: Int -> ConversationId -> Int
Hashable, Value -> Parser [ConversationId]
Value -> Parser ConversationId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [ConversationId]
$cparseJSONList :: Value -> Parser [ConversationId]
parseJSON :: Value -> Parser ConversationId
$cparseJSON :: Value -> Parser ConversationId
FromJSON, [ConversationId] -> Encoding
[ConversationId] -> Value
ConversationId -> Encoding
ConversationId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [ConversationId] -> Encoding
$ctoEncodingList :: [ConversationId] -> Encoding
toJSONList :: [ConversationId] -> Value
$ctoJSONList :: [ConversationId] -> Value
toEncoding :: ConversationId -> Encoding
$ctoEncoding :: ConversationId -> Encoding
toJSON :: ConversationId -> Value
$ctoJSON :: ConversationId -> Value
ToJSON, ConversationId -> ByteString
ConversationId -> Builder
ConversationId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: ConversationId -> Text
$ctoQueryParam :: ConversationId -> Text
toHeader :: ConversationId -> ByteString
$ctoHeader :: ConversationId -> ByteString
toEncodedUrlPiece :: ConversationId -> Builder
$ctoEncodedUrlPiece :: ConversationId -> Builder
toUrlPiece :: ConversationId -> Text
$ctoUrlPiece :: ConversationId -> Text
ToHttpApiData)

-- Ord to allow it to be a key of a Map
newtype TeamId = TeamId {TeamId -> Text
unTeamId :: Text}
  deriving stock (TeamId -> TeamId -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TeamId -> TeamId -> Bool
$c/= :: TeamId -> TeamId -> Bool
== :: TeamId -> TeamId -> Bool
$c== :: TeamId -> TeamId -> Bool
Eq, Eq TeamId
TeamId -> TeamId -> Bool
TeamId -> TeamId -> Ordering
TeamId -> TeamId -> TeamId
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 :: TeamId -> TeamId -> TeamId
$cmin :: TeamId -> TeamId -> TeamId
max :: TeamId -> TeamId -> TeamId
$cmax :: TeamId -> TeamId -> TeamId
>= :: TeamId -> TeamId -> Bool
$c>= :: TeamId -> TeamId -> Bool
> :: TeamId -> TeamId -> Bool
$c> :: TeamId -> TeamId -> Bool
<= :: TeamId -> TeamId -> Bool
$c<= :: TeamId -> TeamId -> Bool
< :: TeamId -> TeamId -> Bool
$c< :: TeamId -> TeamId -> Bool
compare :: TeamId -> TeamId -> Ordering
$ccompare :: TeamId -> TeamId -> Ordering
Ord, forall x. Rep TeamId x -> TeamId
forall x. TeamId -> Rep TeamId x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TeamId x -> TeamId
$cfrom :: forall x. TeamId -> Rep TeamId x
Generic, Int -> TeamId -> ShowS
[TeamId] -> ShowS
TeamId -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TeamId] -> ShowS
$cshowList :: [TeamId] -> ShowS
show :: TeamId -> String
$cshow :: TeamId -> String
showsPrec :: Int -> TeamId -> ShowS
$cshowsPrec :: Int -> TeamId -> ShowS
Show)
  deriving newtype (TeamId -> ()
forall a. (a -> ()) -> NFData a
rnf :: TeamId -> ()
$crnf :: TeamId -> ()
NFData, Eq TeamId
Int -> TeamId -> Int
TeamId -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: TeamId -> Int
$chash :: TeamId -> Int
hashWithSalt :: Int -> TeamId -> Int
$chashWithSalt :: Int -> TeamId -> Int
Hashable, Value -> Parser [TeamId]
Value -> Parser TeamId
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [TeamId]
$cparseJSONList :: Value -> Parser [TeamId]
parseJSON :: Value -> Parser TeamId
$cparseJSON :: Value -> Parser TeamId
FromJSON, [TeamId] -> Encoding
[TeamId] -> Value
TeamId -> Encoding
TeamId -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [TeamId] -> Encoding
$ctoEncodingList :: [TeamId] -> Encoding
toJSONList :: [TeamId] -> Value
$ctoJSONList :: [TeamId] -> Value
toEncoding :: TeamId -> Encoding
$ctoEncoding :: TeamId -> Encoding
toJSON :: TeamId -> Value
$ctoJSON :: TeamId -> Value
ToJSON, TeamId -> ByteString
TeamId -> Builder
TeamId -> Text
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: TeamId -> Text
$ctoQueryParam :: TeamId -> Text
toHeader :: TeamId -> ByteString
$ctoHeader :: TeamId -> ByteString
toEncodedUrlPiece :: TeamId -> Builder
$ctoEncodedUrlPiece :: TeamId -> Builder
toUrlPiece :: TeamId -> Text
$ctoUrlPiece :: TeamId -> Text
ToHttpApiData)

-- | Message text in the format returned by Slack,
-- see https://api.slack.com/docs/message-formatting
-- Consider using 'messageToHtml' for displaying.
newtype SlackMessageText = SlackMessageText {SlackMessageText -> Text
unSlackMessageText :: Text}
  deriving stock (SlackMessageText -> SlackMessageText -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlackMessageText -> SlackMessageText -> Bool
$c/= :: SlackMessageText -> SlackMessageText -> Bool
== :: SlackMessageText -> SlackMessageText -> Bool
$c== :: SlackMessageText -> SlackMessageText -> Bool
Eq, Eq SlackMessageText
SlackMessageText -> SlackMessageText -> Bool
SlackMessageText -> SlackMessageText -> Ordering
SlackMessageText -> SlackMessageText -> SlackMessageText
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 :: SlackMessageText -> SlackMessageText -> SlackMessageText
$cmin :: SlackMessageText -> SlackMessageText -> SlackMessageText
max :: SlackMessageText -> SlackMessageText -> SlackMessageText
$cmax :: SlackMessageText -> SlackMessageText -> SlackMessageText
>= :: SlackMessageText -> SlackMessageText -> Bool
$c>= :: SlackMessageText -> SlackMessageText -> Bool
> :: SlackMessageText -> SlackMessageText -> Bool
$c> :: SlackMessageText -> SlackMessageText -> Bool
<= :: SlackMessageText -> SlackMessageText -> Bool
$c<= :: SlackMessageText -> SlackMessageText -> Bool
< :: SlackMessageText -> SlackMessageText -> Bool
$c< :: SlackMessageText -> SlackMessageText -> Bool
compare :: SlackMessageText -> SlackMessageText -> Ordering
$ccompare :: SlackMessageText -> SlackMessageText -> Ordering
Ord, forall x. Rep SlackMessageText x -> SlackMessageText
forall x. SlackMessageText -> Rep SlackMessageText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SlackMessageText x -> SlackMessageText
$cfrom :: forall x. SlackMessageText -> Rep SlackMessageText x
Generic, Int -> SlackMessageText -> ShowS
[SlackMessageText] -> ShowS
SlackMessageText -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlackMessageText] -> ShowS
$cshowList :: [SlackMessageText] -> ShowS
show :: SlackMessageText -> String
$cshow :: SlackMessageText -> String
showsPrec :: Int -> SlackMessageText -> ShowS
$cshowsPrec :: Int -> SlackMessageText -> ShowS
Show)
  deriving newtype (SlackMessageText -> ()
forall a. (a -> ()) -> NFData a
rnf :: SlackMessageText -> ()
$crnf :: SlackMessageText -> ()
NFData, Eq SlackMessageText
Int -> SlackMessageText -> Int
SlackMessageText -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: SlackMessageText -> Int
$chash :: SlackMessageText -> Int
hashWithSalt :: Int -> SlackMessageText -> Int
$chashWithSalt :: Int -> SlackMessageText -> Int
Hashable, Value -> Parser [SlackMessageText]
Value -> Parser SlackMessageText
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [SlackMessageText]
$cparseJSONList :: Value -> Parser [SlackMessageText]
parseJSON :: Value -> Parser SlackMessageText
$cparseJSON :: Value -> Parser SlackMessageText
FromJSON, [SlackMessageText] -> Encoding
[SlackMessageText] -> Value
SlackMessageText -> Encoding
SlackMessageText -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [SlackMessageText] -> Encoding
$ctoEncodingList :: [SlackMessageText] -> Encoding
toJSONList :: [SlackMessageText] -> Value
$ctoJSONList :: [SlackMessageText] -> Value
toEncoding :: SlackMessageText -> Encoding
$ctoEncoding :: SlackMessageText -> Encoding
toJSON :: SlackMessageText -> Value
$ctoJSON :: SlackMessageText -> Value
ToJSON)

data SlackTimestamp = SlackTimestamp
  { SlackTimestamp -> Text
slackTimestampTs :: Text
  , SlackTimestamp -> UTCTime
slackTimestampTime :: UTCTime
  }
  deriving stock (SlackTimestamp -> SlackTimestamp -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SlackTimestamp -> SlackTimestamp -> Bool
$c/= :: SlackTimestamp -> SlackTimestamp -> Bool
== :: SlackTimestamp -> SlackTimestamp -> Bool
$c== :: SlackTimestamp -> SlackTimestamp -> Bool
Eq, Int -> SlackTimestamp -> ShowS
[SlackTimestamp] -> ShowS
SlackTimestamp -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SlackTimestamp] -> ShowS
$cshowList :: [SlackTimestamp] -> ShowS
show :: SlackTimestamp -> String
$cshow :: SlackTimestamp -> String
showsPrec :: Int -> SlackTimestamp -> ShowS
$cshowsPrec :: Int -> SlackTimestamp -> ShowS
Show, forall x. Rep SlackTimestamp x -> SlackTimestamp
forall x. SlackTimestamp -> Rep SlackTimestamp x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SlackTimestamp x -> SlackTimestamp
$cfrom :: forall x. SlackTimestamp -> Rep SlackTimestamp x
Generic)

instance NFData SlackTimestamp

instance Ord SlackTimestamp where
  compare :: SlackTimestamp -> SlackTimestamp -> Ordering
compare (SlackTimestamp Text
_ UTCTime
a) (SlackTimestamp Text
_ UTCTime
b) = forall a. Ord a => a -> a -> Ordering
compare UTCTime
a UTCTime
b

-- | Convert timestamp texts e.g. "1595719220.011100" into 'SlackTimestamp'
timestampFromText :: Text -> Either String SlackTimestamp
timestampFromText :: Text -> Either String SlackTimestamp
timestampFromText Text
t = (POSIXTime, Text) -> Either String SlackTimestamp
f forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Fractional a => Reader a
rational Text
t
  where
    f :: (POSIXTime, Text) -> Either String SlackTimestamp
f (POSIXTime
posixTime, Text
"") =
      forall a b. b -> Either a b
Right forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> UTCTime -> SlackTimestamp
SlackTimestamp Text
t forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posixTime
    f (POSIXTime
_, Text
_left) = forall a b. a -> Either a b
Left String
"Unexpected text left after timestamp"

mkSlackTimestamp :: UTCTime -> SlackTimestamp
mkSlackTimestamp :: UTCTime -> SlackTimestamp
mkSlackTimestamp UTCTime
utctime = Text -> UTCTime -> SlackTimestamp
SlackTimestamp (Text -> Text
take6DigitsAfterPoint forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (forall a. Show a => a -> String
show Pico
unixts)) UTCTime
utctime
  where
    unixts :: Pico
unixts = POSIXTime -> Pico
nominalDiffTimeToSeconds forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utctime
    take6DigitsAfterPoint :: Text -> Text
take6DigitsAfterPoint = forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry forall a. Semigroup a => a -> a -> a
(<>) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Text -> Text
T.take Int
7) forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
'.')

instance ToHttpApiData SlackTimestamp where
  toQueryParam :: SlackTimestamp -> Text
toQueryParam (SlackTimestamp Text
contents UTCTime
_) = Text
contents

instance FromJSON SlackTimestamp where
  parseJSON :: Value -> Parser SlackTimestamp
parseJSON =
    forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Slack ts" forall a b. (a -> b) -> a -> b
$
      forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (m :: * -> *) a. MonadFail m => String -> m a
fail forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (String
"Invalid Slack ts: " forall m. Monoid m => m -> m -> m
++)) forall (f :: * -> *) a. Applicative f => a -> f a
pure
        forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> Either String SlackTimestamp
timestampFromText

instance ToJSON SlackTimestamp where
  toJSON :: SlackTimestamp -> Value
toJSON = Text -> Value
String forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SlackTimestamp -> Text
slackTimestampTs