{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE TypeApplications #-}

----------------------------------------------------------------------
-- |
-- Module: Web.Slack.Types
-- Description:
--
--
--
----------------------------------------------------------------------

module Web.Slack.Types
  ( Color(..)
  , UserId(..)
  , ConversationId(..)
  , TeamId(..)
  , Cursor(..)
  , SlackTimestamp(..)
  , mkSlackTimestamp
  , timestampFromText
  , SlackMessageText(..)
  )
  where

-- aeson
import Data.Aeson

-- base
import Data.Bifunctor (second)
import GHC.Generics (Generic)

-- deepseq
import Control.DeepSeq (NFData)

-- hashable
import Data.Hashable (Hashable)

-- http-api-data
import Web.HttpApiData

-- text
import Data.Text (Text)
import qualified Data.Text as T
import Data.Text.Read (rational)

-- time
import Data.Time.Clock
import Data.Time.Clock.POSIX

-- Ord to allow it to be a key of a Map
newtype Color = Color { Color -> Text
unColor :: Text }
  deriving stock (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
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
Eq Color
-> (Color -> Color -> Ordering)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Bool)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> Ord 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
$cp1Ord :: Eq Color
Ord, (forall x. Color -> Rep Color x)
-> (forall x. Rep Color x -> Color) -> Generic Color
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
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
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 -> ()
(Color -> ()) -> NFData Color
forall a. (a -> ()) -> NFData a
rnf :: Color -> ()
$crnf :: Color -> ()
NFData, Int -> Color -> Int
Color -> Int
(Int -> Color -> Int) -> (Color -> Int) -> Hashable Color
forall 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
(Value -> Parser Color)
-> (Value -> Parser [Color]) -> FromJSON 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
(Color -> Value)
-> (Color -> Encoding)
-> ([Color] -> Value)
-> ([Color] -> Encoding)
-> ToJSON Color
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
(UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool) -> Eq UserId
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
Eq UserId
-> (UserId -> UserId -> Ordering)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> Bool)
-> (UserId -> UserId -> UserId)
-> (UserId -> UserId -> UserId)
-> Ord 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
$cp1Ord :: Eq UserId
Ord, (forall x. UserId -> Rep UserId x)
-> (forall x. Rep UserId x -> UserId) -> Generic UserId
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
(Int -> UserId -> ShowS)
-> (UserId -> String) -> ([UserId] -> ShowS) -> Show UserId
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 -> ()
(UserId -> ()) -> NFData UserId
forall a. (a -> ()) -> NFData a
rnf :: UserId -> ()
$crnf :: UserId -> ()
NFData, Int -> UserId -> Int
UserId -> Int
(Int -> UserId -> Int) -> (UserId -> Int) -> Hashable UserId
forall 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
(Value -> Parser UserId)
-> (Value -> Parser [UserId]) -> FromJSON 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
(UserId -> Value)
-> (UserId -> Encoding)
-> ([UserId] -> Value)
-> ([UserId] -> Encoding)
-> ToJSON UserId
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
(UserId -> Text)
-> (UserId -> Builder)
-> (UserId -> ByteString)
-> (UserId -> Text)
-> ToHttpApiData UserId
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
(ConversationId -> ConversationId -> Bool)
-> (ConversationId -> ConversationId -> Bool) -> Eq ConversationId
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
Eq ConversationId
-> (ConversationId -> ConversationId -> Ordering)
-> (ConversationId -> ConversationId -> Bool)
-> (ConversationId -> ConversationId -> Bool)
-> (ConversationId -> ConversationId -> Bool)
-> (ConversationId -> ConversationId -> Bool)
-> (ConversationId -> ConversationId -> ConversationId)
-> (ConversationId -> ConversationId -> ConversationId)
-> Ord 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
$cp1Ord :: Eq ConversationId
Ord, (forall x. ConversationId -> Rep ConversationId x)
-> (forall x. Rep ConversationId x -> ConversationId)
-> Generic ConversationId
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
(Int -> ConversationId -> ShowS)
-> (ConversationId -> String)
-> ([ConversationId] -> ShowS)
-> Show ConversationId
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 -> ()
(ConversationId -> ()) -> NFData ConversationId
forall a. (a -> ()) -> NFData a
rnf :: ConversationId -> ()
$crnf :: ConversationId -> ()
NFData, Int -> ConversationId -> Int
ConversationId -> Int
(Int -> ConversationId -> Int)
-> (ConversationId -> Int) -> Hashable ConversationId
forall 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
(Value -> Parser ConversationId)
-> (Value -> Parser [ConversationId]) -> FromJSON 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
(ConversationId -> Value)
-> (ConversationId -> Encoding)
-> ([ConversationId] -> Value)
-> ([ConversationId] -> Encoding)
-> ToJSON ConversationId
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
(ConversationId -> Text)
-> (ConversationId -> Builder)
-> (ConversationId -> ByteString)
-> (ConversationId -> Text)
-> ToHttpApiData ConversationId
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
(TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool) -> Eq TeamId
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
Eq TeamId
-> (TeamId -> TeamId -> Ordering)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> Bool)
-> (TeamId -> TeamId -> TeamId)
-> (TeamId -> TeamId -> TeamId)
-> Ord 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
$cp1Ord :: Eq TeamId
Ord, (forall x. TeamId -> Rep TeamId x)
-> (forall x. Rep TeamId x -> TeamId) -> Generic TeamId
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
(Int -> TeamId -> ShowS)
-> (TeamId -> String) -> ([TeamId] -> ShowS) -> Show TeamId
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 -> ()
(TeamId -> ()) -> NFData TeamId
forall a. (a -> ()) -> NFData a
rnf :: TeamId -> ()
$crnf :: TeamId -> ()
NFData, Int -> TeamId -> Int
TeamId -> Int
(Int -> TeamId -> Int) -> (TeamId -> Int) -> Hashable TeamId
forall 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
(Value -> Parser TeamId)
-> (Value -> Parser [TeamId]) -> FromJSON 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
(TeamId -> Value)
-> (TeamId -> Encoding)
-> ([TeamId] -> Value)
-> ([TeamId] -> Encoding)
-> ToJSON TeamId
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
(TeamId -> Text)
-> (TeamId -> Builder)
-> (TeamId -> ByteString)
-> (TeamId -> Text)
-> ToHttpApiData TeamId
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)

newtype Cursor = Cursor { Cursor -> Text
unCursor :: Text }
  deriving stock (Cursor -> Cursor -> Bool
(Cursor -> Cursor -> Bool)
-> (Cursor -> Cursor -> Bool) -> Eq Cursor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Cursor -> Cursor -> Bool
$c/= :: Cursor -> Cursor -> Bool
== :: Cursor -> Cursor -> Bool
$c== :: Cursor -> Cursor -> Bool
Eq, (forall x. Cursor -> Rep Cursor x)
-> (forall x. Rep Cursor x -> Cursor) -> Generic Cursor
forall x. Rep Cursor x -> Cursor
forall x. Cursor -> Rep Cursor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Cursor x -> Cursor
$cfrom :: forall x. Cursor -> Rep Cursor x
Generic, Int -> Cursor -> ShowS
[Cursor] -> ShowS
Cursor -> String
(Int -> Cursor -> ShowS)
-> (Cursor -> String) -> ([Cursor] -> ShowS) -> Show Cursor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Cursor] -> ShowS
$cshowList :: [Cursor] -> ShowS
show :: Cursor -> String
$cshow :: Cursor -> String
showsPrec :: Int -> Cursor -> ShowS
$cshowsPrec :: Int -> Cursor -> ShowS
Show)
  deriving newtype (Cursor -> ()
(Cursor -> ()) -> NFData Cursor
forall a. (a -> ()) -> NFData a
rnf :: Cursor -> ()
$crnf :: Cursor -> ()
NFData, Int -> Cursor -> Int
Cursor -> Int
(Int -> Cursor -> Int) -> (Cursor -> Int) -> Hashable Cursor
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Cursor -> Int
$chash :: Cursor -> Int
hashWithSalt :: Int -> Cursor -> Int
$chashWithSalt :: Int -> Cursor -> Int
Hashable, Value -> Parser [Cursor]
Value -> Parser Cursor
(Value -> Parser Cursor)
-> (Value -> Parser [Cursor]) -> FromJSON Cursor
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Cursor]
$cparseJSONList :: Value -> Parser [Cursor]
parseJSON :: Value -> Parser Cursor
$cparseJSON :: Value -> Parser Cursor
FromJSON, [Cursor] -> Encoding
[Cursor] -> Value
Cursor -> Encoding
Cursor -> Value
(Cursor -> Value)
-> (Cursor -> Encoding)
-> ([Cursor] -> Value)
-> ([Cursor] -> Encoding)
-> ToJSON Cursor
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Cursor] -> Encoding
$ctoEncodingList :: [Cursor] -> Encoding
toJSONList :: [Cursor] -> Value
$ctoJSONList :: [Cursor] -> Value
toEncoding :: Cursor -> Encoding
$ctoEncoding :: Cursor -> Encoding
toJSON :: Cursor -> Value
$ctoJSON :: Cursor -> Value
ToJSON, Cursor -> ByteString
Cursor -> Builder
Cursor -> Text
(Cursor -> Text)
-> (Cursor -> Builder)
-> (Cursor -> ByteString)
-> (Cursor -> Text)
-> ToHttpApiData Cursor
forall a.
(a -> Text)
-> (a -> Builder)
-> (a -> ByteString)
-> (a -> Text)
-> ToHttpApiData a
toQueryParam :: Cursor -> Text
$ctoQueryParam :: Cursor -> Text
toHeader :: Cursor -> ByteString
$ctoHeader :: Cursor -> ByteString
toEncodedUrlPiece :: Cursor -> Builder
$ctoEncodedUrlPiece :: Cursor -> Builder
toUrlPiece :: Cursor -> Text
$ctoUrlPiece :: Cursor -> 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
(SlackMessageText -> SlackMessageText -> Bool)
-> (SlackMessageText -> SlackMessageText -> Bool)
-> Eq SlackMessageText
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
Eq SlackMessageText
-> (SlackMessageText -> SlackMessageText -> Ordering)
-> (SlackMessageText -> SlackMessageText -> Bool)
-> (SlackMessageText -> SlackMessageText -> Bool)
-> (SlackMessageText -> SlackMessageText -> Bool)
-> (SlackMessageText -> SlackMessageText -> Bool)
-> (SlackMessageText -> SlackMessageText -> SlackMessageText)
-> (SlackMessageText -> SlackMessageText -> SlackMessageText)
-> Ord 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
$cp1Ord :: Eq SlackMessageText
Ord, (forall x. SlackMessageText -> Rep SlackMessageText x)
-> (forall x. Rep SlackMessageText x -> SlackMessageText)
-> Generic SlackMessageText
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
(Int -> SlackMessageText -> ShowS)
-> (SlackMessageText -> String)
-> ([SlackMessageText] -> ShowS)
-> Show SlackMessageText
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 -> ()
(SlackMessageText -> ()) -> NFData SlackMessageText
forall a. (a -> ()) -> NFData a
rnf :: SlackMessageText -> ()
$crnf :: SlackMessageText -> ()
NFData, Int -> SlackMessageText -> Int
SlackMessageText -> Int
(Int -> SlackMessageText -> Int)
-> (SlackMessageText -> Int) -> Hashable SlackMessageText
forall 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
(Value -> Parser SlackMessageText)
-> (Value -> Parser [SlackMessageText])
-> FromJSON 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
(SlackMessageText -> Value)
-> (SlackMessageText -> Encoding)
-> ([SlackMessageText] -> Value)
-> ([SlackMessageText] -> Encoding)
-> ToJSON SlackMessageText
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
(SlackTimestamp -> SlackTimestamp -> Bool)
-> (SlackTimestamp -> SlackTimestamp -> Bool) -> Eq SlackTimestamp
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
(Int -> SlackTimestamp -> ShowS)
-> (SlackTimestamp -> String)
-> ([SlackTimestamp] -> ShowS)
-> Show SlackTimestamp
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. SlackTimestamp -> Rep SlackTimestamp x)
-> (forall x. Rep SlackTimestamp x -> SlackTimestamp)
-> Generic SlackTimestamp
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) = UTCTime -> UTCTime -> Ordering
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
forall a a.
(Eq a, IsString a, IsString a) =>
(POSIXTime, a) -> Either a SlackTimestamp
f ((POSIXTime, Text) -> Either String SlackTimestamp)
-> Either String (POSIXTime, Text) -> Either String SlackTimestamp
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Reader POSIXTime
forall a. Fractional a => Reader a
rational Text
t
 where
  f :: (POSIXTime, a) -> Either a SlackTimestamp
f (POSIXTime
posixTime, a
"") =
    SlackTimestamp -> Either a SlackTimestamp
forall a b. b -> Either a b
Right (SlackTimestamp -> Either a SlackTimestamp)
-> (UTCTime -> SlackTimestamp)
-> UTCTime
-> Either a SlackTimestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> UTCTime -> SlackTimestamp
SlackTimestamp Text
t (UTCTime -> Either a SlackTimestamp)
-> UTCTime -> Either a SlackTimestamp
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
posixTime
  f (POSIXTime
_, a
_left) = a -> Either a SlackTimestamp
forall a b. a -> Either a b
Left a
"Unexpected text left after timestamp"

mkSlackTimestamp :: UTCTime -> SlackTimestamp
mkSlackTimestamp :: UTCTime -> SlackTimestamp
mkSlackTimestamp UTCTime
utctime = Text -> UTCTime -> SlackTimestamp
SlackTimestamp (Text -> Text
take6DigitsAfterPoint (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ String -> Text
T.pack (Pico -> String
forall a. Show a => a -> String
show Pico
unixts)) UTCTime
utctime
 where
  unixts :: Pico
unixts = POSIXTime -> Pico
nominalDiffTimeToSeconds (POSIXTime -> Pico) -> POSIXTime -> Pico
forall a b. (a -> b) -> a -> b
$ UTCTime -> POSIXTime
utcTimeToPOSIXSeconds UTCTime
utctime
  take6DigitsAfterPoint :: Text -> Text
take6DigitsAfterPoint = (Text -> Text -> Text) -> (Text, Text) -> Text
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
(<>) ((Text, Text) -> Text) -> (Text -> (Text, Text)) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Text) -> (Text, Text) -> (Text, Text)
forall (p :: * -> * -> *) b c a.
Bifunctor p =>
(b -> c) -> p a b -> p a c
second (Int -> Text -> Text
T.take Int
7) ((Text, Text) -> (Text, Text))
-> (Text -> (Text, Text)) -> Text -> (Text, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> (Text, Text)
T.break (Char -> Char -> Bool
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 = String
-> (Text -> Parser SlackTimestamp)
-> Value
-> Parser SlackTimestamp
forall a. String -> (Text -> Parser a) -> Value -> Parser a
withText String
"Slack ts"
    ((Text -> Parser SlackTimestamp) -> Value -> Parser SlackTimestamp)
-> (Text -> Parser SlackTimestamp)
-> Value
-> Parser SlackTimestamp
forall a b. (a -> b) -> a -> b
$ (String -> Parser SlackTimestamp)
-> (SlackTimestamp -> Parser SlackTimestamp)
-> Either String SlackTimestamp
-> Parser SlackTimestamp
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> Parser SlackTimestamp
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser SlackTimestamp)
-> ShowS -> String -> Parser SlackTimestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String
"Invalid Slack ts: " String -> ShowS
forall a. [a] -> [a] -> [a]
++)) SlackTimestamp -> Parser SlackTimestamp
forall (f :: * -> *) a. Applicative f => a -> f a
pure
    (Either String SlackTimestamp -> Parser SlackTimestamp)
-> (Text -> Either String SlackTimestamp)
-> Text
-> Parser SlackTimestamp
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either String SlackTimestamp
timestampFromText

instance ToJSON SlackTimestamp where
  toJSON :: SlackTimestamp -> Value
toJSON = Text -> Value
String (Text -> Value)
-> (SlackTimestamp -> Text) -> SlackTimestamp -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SlackTimestamp -> Text
slackTimestampTs