{-# LANGUAGE TemplateHaskell #-}
module Matterhorn.Types.EditState
  ( EditMode(..)
  , AttachmentData(..)
  , AutocompletionType(..)

  , CompletionSource(..)
  , SpecialMention(..)
  , specialMentionName
  , isSpecialMention

  , EditState(..)
  , newEditState
  , unsafeEsFileBrowser
  , esAttachmentList
  , esFileBrowser
  , esMisspellings
  , esEditMode
  , esEphemeral
  , esEditor
  , esAutocomplete
  , esAutocompletePending
  , esResetEditMode
  , esJustCompleted
  , esShowReplyPrompt
  , esSpellCheckTimerReset
  , esTeamId
  , esChannelId

  , EphemeralEditState(..)
  , defaultEphemeralEditState
  , eesMultiline
  , eesInputHistoryPosition
  , eesLastInput
  , eesTypingUsers
  , addEphemeralStateTypingUser

  , AutocompleteState(..)
  , acPreviousSearchString
  , acCompletionList
  , acCachedResponses
  , acType

  , AutocompleteAlternative(..)
  , autocompleteAlternativeReplacement
  )
where

import           Prelude ()
import           Matterhorn.Prelude

import           Brick.Widgets.Edit ( Editor, editor )
import           Brick.Widgets.List ( List, list )
import qualified Brick.Widgets.FileBrowser as FB
import qualified Data.ByteString as BS
import qualified Data.HashMap.Strict as HM
import qualified Data.Text as T
import           Lens.Micro.Platform ( Lens', makeLenses, (.~), (^?!), lens, _Just
                                     , (%~) )
import           Network.Mattermost.Types

import           Matterhorn.Types.Common
import           Matterhorn.Types.Messages ( Message, MessageType )
import           Matterhorn.Types.Users ( TypingUsers, noTypingUsers, addTypingUser
                                        , addUserSigil, trimUserSigil )
import           Matterhorn.Constants


-- | A "special" mention that does not map to a specific user, but is an
-- alias that the server uses to notify users.
data SpecialMention =
    MentionAll
    -- ^ @all: notify everyone in the channel.
    | MentionChannel
    -- ^ @channel: notify everyone in the channel.

data AutocompleteAlternative =
    UserCompletion User Bool
    -- ^ User, plus whether the user is in the channel that triggered
    -- the autocomplete
    | SpecialMention SpecialMention
    -- ^ A special mention.
    | ChannelCompletion Bool Channel
    -- ^ Channel, plus whether the user is a member of the channel
    | SyntaxCompletion Text
    -- ^ Name of a skylighting syntax definition
    | CommandCompletion CompletionSource Text Text Text
    -- ^ Source, name of a slash command, argspec, and description
    | EmojiCompletion Text
    -- ^ The text of an emoji completion

-- | The source of an autocompletion alternative.
data CompletionSource = Server | Client
                      deriving (CompletionSource -> CompletionSource -> Bool
(CompletionSource -> CompletionSource -> Bool)
-> (CompletionSource -> CompletionSource -> Bool)
-> Eq CompletionSource
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompletionSource -> CompletionSource -> Bool
$c/= :: CompletionSource -> CompletionSource -> Bool
== :: CompletionSource -> CompletionSource -> Bool
$c== :: CompletionSource -> CompletionSource -> Bool
Eq, Int -> CompletionSource -> ShowS
[CompletionSource] -> ShowS
CompletionSource -> String
(Int -> CompletionSource -> ShowS)
-> (CompletionSource -> String)
-> ([CompletionSource] -> ShowS)
-> Show CompletionSource
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompletionSource] -> ShowS
$cshowList :: [CompletionSource] -> ShowS
show :: CompletionSource -> String
$cshow :: CompletionSource -> String
showsPrec :: Int -> CompletionSource -> ShowS
$cshowsPrec :: Int -> CompletionSource -> ShowS
Show)

specialMentionName :: SpecialMention -> Text
specialMentionName :: SpecialMention -> Text
specialMentionName SpecialMention
MentionChannel = Text
"channel"
specialMentionName SpecialMention
MentionAll = Text
"all"

isSpecialMention :: T.Text -> Bool
isSpecialMention :: Text -> Bool
isSpecialMention Text
n = Maybe SpecialMention -> Bool
forall a. Maybe a -> Bool
isJust (Maybe SpecialMention -> Bool) -> Maybe SpecialMention -> Bool
forall a b. (a -> b) -> a -> b
$ Text -> [(Text, SpecialMention)] -> Maybe SpecialMention
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Text
trimUserSigil Text
n) [(Text, SpecialMention)]
pairs
    where
        pairs :: [(Text, SpecialMention)]
pairs = SpecialMention -> (Text, SpecialMention)
mkPair (SpecialMention -> (Text, SpecialMention))
-> [SpecialMention] -> [(Text, SpecialMention)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [SpecialMention]
mentions
        mentions :: [SpecialMention]
mentions = [ SpecialMention
MentionChannel
                   , SpecialMention
MentionAll
                   ]
        mkPair :: SpecialMention -> (Text, SpecialMention)
mkPair SpecialMention
v = (SpecialMention -> Text
specialMentionName SpecialMention
v, SpecialMention
v)

autocompleteAlternativeReplacement :: AutocompleteAlternative -> Text
autocompleteAlternativeReplacement :: AutocompleteAlternative -> Text
autocompleteAlternativeReplacement (EmojiCompletion Text
e) =
    Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
e Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"
autocompleteAlternativeReplacement (SpecialMention SpecialMention
m) =
    Text -> Text
addUserSigil (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ SpecialMention -> Text
specialMentionName SpecialMention
m
autocompleteAlternativeReplacement (UserCompletion User
u Bool
_) =
    Text -> Text
addUserSigil (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ User -> Text
userUsername User
u
autocompleteAlternativeReplacement (ChannelCompletion Bool
_ Channel
c) =
    Text
normalChannelSigil Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (UserText -> Text
sanitizeUserText (UserText -> Text) -> UserText -> Text
forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
c)
autocompleteAlternativeReplacement (SyntaxCompletion Text
t) =
    Text
"```" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
autocompleteAlternativeReplacement (CommandCompletion CompletionSource
_ Text
t Text
_ Text
_) =
    Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t

-- | The type of data that the autocompletion logic supports. We use
-- this to track the kind of completion underway in case the type of
-- completion needs to change.
data AutocompletionType =
    ACUsers
    | ACChannels
    | ACCodeBlockLanguage
    | ACEmoji
    | ACCommands
    deriving (AutocompletionType -> AutocompletionType -> Bool
(AutocompletionType -> AutocompletionType -> Bool)
-> (AutocompletionType -> AutocompletionType -> Bool)
-> Eq AutocompletionType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutocompletionType -> AutocompletionType -> Bool
$c/= :: AutocompletionType -> AutocompletionType -> Bool
== :: AutocompletionType -> AutocompletionType -> Bool
$c== :: AutocompletionType -> AutocompletionType -> Bool
Eq, Int -> AutocompletionType -> ShowS
[AutocompletionType] -> ShowS
AutocompletionType -> String
(Int -> AutocompletionType -> ShowS)
-> (AutocompletionType -> String)
-> ([AutocompletionType] -> ShowS)
-> Show AutocompletionType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AutocompletionType] -> ShowS
$cshowList :: [AutocompletionType] -> ShowS
show :: AutocompletionType -> String
$cshow :: AutocompletionType -> String
showsPrec :: Int -> AutocompletionType -> ShowS
$cshowsPrec :: Int -> AutocompletionType -> ShowS
Show)

-- | An attachment.
data AttachmentData =
    AttachmentData { AttachmentData -> FileInfo
attachmentDataFileInfo :: FB.FileInfo
                   , AttachmentData -> ByteString
attachmentDataBytes :: BS.ByteString
                   }
                   deriving (AttachmentData -> AttachmentData -> Bool
(AttachmentData -> AttachmentData -> Bool)
-> (AttachmentData -> AttachmentData -> Bool) -> Eq AttachmentData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AttachmentData -> AttachmentData -> Bool
$c/= :: AttachmentData -> AttachmentData -> Bool
== :: AttachmentData -> AttachmentData -> Bool
$c== :: AttachmentData -> AttachmentData -> Bool
Eq, Int -> AttachmentData -> ShowS
[AttachmentData] -> ShowS
AttachmentData -> String
(Int -> AttachmentData -> ShowS)
-> (AttachmentData -> String)
-> ([AttachmentData] -> ShowS)
-> Show AttachmentData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AttachmentData] -> ShowS
$cshowList :: [AttachmentData] -> ShowS
show :: AttachmentData -> String
$cshow :: AttachmentData -> String
showsPrec :: Int -> AttachmentData -> ShowS
$cshowsPrec :: Int -> AttachmentData -> ShowS
Show)

-- | The input state associated with the message editor.
data EditMode =
    NewPost
    -- ^ The input is for a new post.
    | Editing Post MessageType
    -- ^ The input is ultimately to replace the body of an existing post
    -- of the specified type.
    | Replying Message Post
    -- ^ The input is to be used as a new post in reply to the specified
    -- post.
    deriving (Int -> EditMode -> ShowS
[EditMode] -> ShowS
EditMode -> String
(Int -> EditMode -> ShowS)
-> (EditMode -> String) -> ([EditMode] -> ShowS) -> Show EditMode
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EditMode] -> ShowS
$cshowList :: [EditMode] -> ShowS
show :: EditMode -> String
$cshow :: EditMode -> String
showsPrec :: Int -> EditMode -> ShowS
$cshowsPrec :: Int -> EditMode -> ShowS
Show, EditMode -> EditMode -> Bool
(EditMode -> EditMode -> Bool)
-> (EditMode -> EditMode -> Bool) -> Eq EditMode
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EditMode -> EditMode -> Bool
$c/= :: EditMode -> EditMode -> Bool
== :: EditMode -> EditMode -> Bool
$c== :: EditMode -> EditMode -> Bool
Eq)

data AutocompleteState n =
    AutocompleteState { AutocompleteState n -> Text
_acPreviousSearchString :: Text
                      -- ^ The search string used for the
                      -- currently-displayed autocomplete results, for
                      -- use in deciding whether to issue another server
                      -- query
                      , AutocompleteState n -> List n AutocompleteAlternative
_acCompletionList :: List n AutocompleteAlternative
                      -- ^ The list of alternatives that the user
                      -- selects from
                      , AutocompleteState n -> AutocompletionType
_acType :: AutocompletionType
                      -- ^ The type of data that we're completing
                      , AutocompleteState n -> HashMap Text [AutocompleteAlternative]
_acCachedResponses :: HM.HashMap Text [AutocompleteAlternative]
                      -- ^ A cache of alternative lists, keyed on search
                      -- string, for use in avoiding server requests.
                      -- The idea here is that users type quickly enough
                      -- (and edit their input) that would normally lead
                      -- to rapid consecutive requests, some for the
                      -- same strings during editing, that we can avoid
                      -- that by caching them here. Note that this cache
                      -- gets destroyed whenever autocompletion is not
                      -- on, so this cache does not live very long.
                      }

-- | The 'EditState' value contains the editor widget itself as well as
-- history and metadata we need for editing-related operations.
data EditState n =
    EditState { EditState n -> Editor Text n
_esEditor :: Editor Text n
              , EditState n -> EditMode
_esEditMode :: EditMode
              , EditState n -> EphemeralEditState
_esEphemeral :: EphemeralEditState
              , EditState n -> Set Text
_esMisspellings :: Set Text
              , EditState n -> Maybe (AutocompleteState n)
_esAutocomplete :: Maybe (AutocompleteState n)
              -- ^ The autocomplete state. The autocompletion UI is
              -- showing only when this state is present.
              , EditState n -> EditMode
_esResetEditMode :: EditMode
              -- ^ The editing mode to reset to after input is handled.
              , EditState n -> Maybe Text
_esAutocompletePending :: Maybe Text
              -- ^ The search string associated with the latest
              -- in-flight autocompletion request. This is used to
              -- determine whether any (potentially late-arriving) API
              -- responses are for stale queries since the user can type
              -- more quickly than the server can get us the results,
              -- and we wouldn't want to show results associated with
              -- old editor states.
              , EditState n -> List n AttachmentData
_esAttachmentList :: List n AttachmentData
              -- ^ The list of attachments to be uploaded with the post
              -- being edited.
              , EditState n -> Maybe (FileBrowser n)
_esFileBrowser :: Maybe (FB.FileBrowser n)
              -- ^ The browser for selecting attachment files. This is
              -- a Maybe because the instantiation of the FileBrowser
              -- causes it to read and ingest the target directory, so
              -- this action is deferred until the browser is needed.
              , EditState n -> Bool
_esJustCompleted :: Bool
              -- A flag that indicates whether the most recent editing
              -- event was a tab-completion. This is used by the smart
              -- trailing space handling.
              , EditState n -> Bool
_esShowReplyPrompt :: Bool
              -- ^ Whether to show the reply prompt when replying
              , EditState n -> Maybe (IO ())
_esSpellCheckTimerReset :: Maybe (IO ())
              -- ^ An action to reset the spell check timer for this
              -- editor, if a spell checker is running.
              , EditState n -> ChannelId
_esChannelId :: ChannelId
              -- ^ Channel ID associated with this edit state
              , EditState n -> Maybe TeamId
_esTeamId :: Maybe TeamId
              -- ^ Team ID associated with this edit state (optional
              -- since not all channels are associated with teams)
              }

newEditState :: n -> n -> Maybe TeamId -> ChannelId -> EditMode -> Bool -> Maybe (IO ()) -> EditState n
newEditState :: n
-> n
-> Maybe TeamId
-> ChannelId
-> EditMode
-> Bool
-> Maybe (IO ())
-> EditState n
newEditState n
editorName n
attachmentListName Maybe TeamId
tId ChannelId
cId EditMode
initialEditMode Bool
showReplyPrompt Maybe (IO ())
reset =
    EditState :: forall n.
Editor Text n
-> EditMode
-> EphemeralEditState
-> Set Text
-> Maybe (AutocompleteState n)
-> EditMode
-> Maybe Text
-> List n AttachmentData
-> Maybe (FileBrowser n)
-> Bool
-> Bool
-> Maybe (IO ())
-> ChannelId
-> Maybe TeamId
-> EditState n
EditState { _esEditor :: Editor Text n
_esEditor               = n -> Maybe Int -> Text -> Editor Text n
forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor n
editorName Maybe Int
forall a. Maybe a
Nothing Text
""
              , _esEphemeral :: EphemeralEditState
_esEphemeral            = EphemeralEditState
defaultEphemeralEditState
              , _esEditMode :: EditMode
_esEditMode             = EditMode
initialEditMode
              , _esResetEditMode :: EditMode
_esResetEditMode        = EditMode
initialEditMode
              , _esMisspellings :: Set Text
_esMisspellings         = Set Text
forall a. Monoid a => a
mempty
              , _esAutocomplete :: Maybe (AutocompleteState n)
_esAutocomplete         = Maybe (AutocompleteState n)
forall a. Maybe a
Nothing
              , _esAutocompletePending :: Maybe Text
_esAutocompletePending  = Maybe Text
forall a. Maybe a
Nothing
              , _esAttachmentList :: List n AttachmentData
_esAttachmentList       = n -> Vector AttachmentData -> Int -> List n AttachmentData
forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list n
attachmentListName Vector AttachmentData
forall a. Monoid a => a
mempty Int
1
              , _esFileBrowser :: Maybe (FileBrowser n)
_esFileBrowser          = Maybe (FileBrowser n)
forall a. Maybe a
Nothing
              , _esJustCompleted :: Bool
_esJustCompleted        = Bool
False
              , _esShowReplyPrompt :: Bool
_esShowReplyPrompt      = Bool
showReplyPrompt
              , _esSpellCheckTimerReset :: Maybe (IO ())
_esSpellCheckTimerReset = Maybe (IO ())
reset
              , _esChannelId :: ChannelId
_esChannelId            = ChannelId
cId
              , _esTeamId :: Maybe TeamId
_esTeamId               = Maybe TeamId
tId
              }

data EphemeralEditState =
    EphemeralEditState { EphemeralEditState -> Bool
_eesMultiline :: Bool
                       -- ^ Whether the editor is in multiline mode
                       , EphemeralEditState -> Maybe Int
_eesInputHistoryPosition :: Maybe Int
                       -- ^ The input history position, if any
                       , EphemeralEditState -> (Text, EditMode)
_eesLastInput :: (T.Text, EditMode)
                       -- ^ The input entered into the text editor last
                       -- time the user was focused on the channel
                       -- associated with this state.
                       , EphemeralEditState -> TypingUsers
_eesTypingUsers :: TypingUsers
                       }

defaultEphemeralEditState :: EphemeralEditState
defaultEphemeralEditState :: EphemeralEditState
defaultEphemeralEditState =
    EphemeralEditState :: Bool
-> Maybe Int
-> (Text, EditMode)
-> TypingUsers
-> EphemeralEditState
EphemeralEditState { _eesMultiline :: Bool
_eesMultiline = Bool
False
                       , _eesInputHistoryPosition :: Maybe Int
_eesInputHistoryPosition = Maybe Int
forall a. Maybe a
Nothing
                       , _eesLastInput :: (Text, EditMode)
_eesLastInput = (Text
"", EditMode
NewPost)
                       , _eesTypingUsers :: TypingUsers
_eesTypingUsers = TypingUsers
noTypingUsers
                       }

makeLenses ''EphemeralEditState

-- | Add user to the list of users in this state who are currently typing.
addEphemeralStateTypingUser :: UserId -> UTCTime -> EphemeralEditState -> EphemeralEditState
addEphemeralStateTypingUser :: UserId -> UTCTime -> EphemeralEditState -> EphemeralEditState
addEphemeralStateTypingUser UserId
uId UTCTime
ts = (TypingUsers -> Identity TypingUsers)
-> EphemeralEditState -> Identity EphemeralEditState
Lens' EphemeralEditState TypingUsers
eesTypingUsers ((TypingUsers -> Identity TypingUsers)
 -> EphemeralEditState -> Identity EphemeralEditState)
-> (TypingUsers -> TypingUsers)
-> EphemeralEditState
-> EphemeralEditState
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ (UserId -> UTCTime -> TypingUsers -> TypingUsers
addTypingUser UserId
uId UTCTime
ts)

makeLenses ''EditState
makeLenses ''AutocompleteState

unsafeEsFileBrowser :: Lens' (EditState n) (FB.FileBrowser n)
unsafeEsFileBrowser :: (FileBrowser n -> f (FileBrowser n))
-> EditState n -> f (EditState n)
unsafeEsFileBrowser =
     (EditState n -> FileBrowser n)
-> (EditState n -> FileBrowser n -> EditState n)
-> Lens (EditState n) (EditState n) (FileBrowser n) (FileBrowser n)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\EditState n
st   -> EditState n
stEditState n
-> Getting
     (Maybe (FileBrowser n)) (EditState n) (Maybe (FileBrowser n))
-> Maybe (FileBrowser n)
forall s a. s -> Getting a s a -> a
^.Getting
  (Maybe (FileBrowser n)) (EditState n) (Maybe (FileBrowser n))
forall n. Lens' (EditState n) (Maybe (FileBrowser n))
esFileBrowser Maybe (FileBrowser n)
-> Getting
     (Endo (FileBrowser n)) (Maybe (FileBrowser n)) (FileBrowser n)
-> FileBrowser n
forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! Getting
  (Endo (FileBrowser n)) (Maybe (FileBrowser n)) (FileBrowser n)
forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just)
          (\EditState n
st FileBrowser n
t -> EditState n
st EditState n -> (EditState n -> EditState n) -> EditState n
forall a b. a -> (a -> b) -> b
& (Maybe (FileBrowser n) -> Identity (Maybe (FileBrowser n)))
-> EditState n -> Identity (EditState n)
forall n. Lens' (EditState n) (Maybe (FileBrowser n))
esFileBrowser ((Maybe (FileBrowser n) -> Identity (Maybe (FileBrowser n)))
 -> EditState n -> Identity (EditState n))
-> Maybe (FileBrowser n) -> EditState n -> EditState n
forall s t a b. ASetter s t a b -> b -> s -> t
.~ FileBrowser n -> Maybe (FileBrowser n)
forall a. a -> Maybe a
Just FileBrowser n
t)