{-# 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
  , autocompleteAlternativeText
  )
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

autocompleteAlternativeText :: AutocompleteAlternative -> Text
autocompleteAlternativeText :: AutocompleteAlternative -> Text
autocompleteAlternativeText (UserCompletion User
u Bool
_) =
    User -> Text
userUsername User
u
autocompleteAlternativeText (SpecialMention SpecialMention
MentionChannel) =
    Text
"channel"
autocompleteAlternativeText (SpecialMention SpecialMention
MentionAll) =
    Text
"all"
autocompleteAlternativeText (ChannelCompletion Bool
_ Channel
c) =
    UserText -> Text
unsafeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
c
autocompleteAlternativeText (SyntaxCompletion Text
n) =
    Text
n
autocompleteAlternativeText (CommandCompletion CompletionSource
_ Text
t Text
_ Text
_) =
    Text
t
autocompleteAlternativeText (EmojiCompletion Text
t) =
    Text
t

-- | The source of an autocompletion alternative.
data CompletionSource = Server | Client
                      deriving (CompletionSource -> CompletionSource -> Bool
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
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 = forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup (Text -> Text
T.toLower forall a b. (a -> b) -> a -> b
$ Text -> Text
trimUserSigil Text
n) [(Text, SpecialMention)]
pairs
    where
        pairs :: [(Text, SpecialMention)]
pairs = SpecialMention -> (Text, SpecialMention)
mkPair 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
":" forall a. Semigroup a => a -> a -> a
<> Text
e forall a. Semigroup a => a -> a -> a
<> Text
":"
autocompleteAlternativeReplacement (SpecialMention SpecialMention
m) =
    Text -> Text
addUserSigil forall a b. (a -> b) -> a -> b
$ SpecialMention -> Text
specialMentionName SpecialMention
m
autocompleteAlternativeReplacement (UserCompletion User
u Bool
_) =
    Text -> Text
addUserSigil forall a b. (a -> b) -> a -> b
$ User -> Text
userUsername User
u
autocompleteAlternativeReplacement (ChannelCompletion Bool
_ Channel
c) =
    Text
normalChannelSigil forall a. Semigroup a => a -> a -> a
<> (UserText -> Text
sanitizeUserText forall a b. (a -> b) -> a -> b
$ Channel -> UserText
channelName Channel
c)
autocompleteAlternativeReplacement (SyntaxCompletion Text
t) =
    Text
"```" forall a. Semigroup a => a -> a -> a
<> Text
t
autocompleteAlternativeReplacement (CommandCompletion CompletionSource
_ Text
t 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
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
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
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
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
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
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 { forall n. 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
                      , forall n. AutocompleteState n -> List n AutocompleteAlternative
_acCompletionList :: List n AutocompleteAlternative
                      -- ^ The list of alternatives that the user
                      -- selects from
                      , forall n. AutocompleteState n -> AutocompletionType
_acType :: AutocompletionType
                      -- ^ The type of data that we're completing
                      , forall n.
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 { forall n. EditState n -> Editor Text n
_esEditor :: Editor Text n
              , forall n. EditState n -> EditMode
_esEditMode :: EditMode
              , forall n. EditState n -> EphemeralEditState
_esEphemeral :: EphemeralEditState
              , forall n. EditState n -> Set Text
_esMisspellings :: Set Text
              , forall n. EditState n -> Maybe (AutocompleteState n)
_esAutocomplete :: Maybe (AutocompleteState n)
              -- ^ The autocomplete state. The autocompletion UI is
              -- showing only when this state is present.
              , forall n. EditState n -> EditMode
_esResetEditMode :: EditMode
              -- ^ The editing mode to reset to after input is handled.
              , forall n. 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.
              , forall n. EditState n -> List n AttachmentData
_esAttachmentList :: List n AttachmentData
              -- ^ The list of attachments to be uploaded with the post
              -- being edited.
              , forall n. 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.
              , forall n. 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.
              , forall n. EditState n -> Bool
_esShowReplyPrompt :: Bool
              -- ^ Whether to show the reply prompt when replying
              , forall n. EditState n -> Maybe (IO ())
_esSpellCheckTimerReset :: Maybe (IO ())
              -- ^ An action to reset the spell check timer for this
              -- editor, if a spell checker is running.
              , forall n. EditState n -> ChannelId
_esChannelId :: ChannelId
              -- ^ Channel ID associated with this edit state
              , forall n. 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 :: forall n.
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 { _esEditor :: Editor Text n
_esEditor               = forall a n.
GenericTextZipper a =>
n -> Maybe Int -> a -> Editor a n
editor n
editorName 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         = forall a. Monoid a => a
mempty
              , _esAutocomplete :: Maybe (AutocompleteState n)
_esAutocomplete         = forall a. Maybe a
Nothing
              , _esAutocompletePending :: Maybe Text
_esAutocompletePending  = forall a. Maybe a
Nothing
              , _esAttachmentList :: List n AttachmentData
_esAttachmentList       = forall (t :: * -> *) n e.
Foldable t =>
n -> t e -> Int -> GenericList n t e
list n
attachmentListName forall a. Monoid a => a
mempty Int
1
              , _esFileBrowser :: Maybe (FileBrowser n)
_esFileBrowser          = 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 { _eesMultiline :: Bool
_eesMultiline = Bool
False
                       , _eesInputHistoryPosition :: Maybe Int
_eesInputHistoryPosition = 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 = Lens' EphemeralEditState TypingUsers
eesTypingUsers 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 :: forall n. Lens' (EditState n) (FileBrowser n)
unsafeEsFileBrowser =
     forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens (\EditState n
st   -> EditState n
stforall s a. s -> Getting a s a -> a
^.forall n. Lens' (EditState n) (Maybe (FileBrowser n))
esFileBrowser forall s a. HasCallStack => s -> Getting (Endo a) s a -> a
^?! forall a a'. Traversal (Maybe a) (Maybe a') a a'
_Just)
          (\EditState n
st FileBrowser n
t -> EditState n
st forall a b. a -> (a -> b) -> b
& forall n. Lens' (EditState n) (Maybe (FileBrowser n))
esFileBrowser forall s t a b. ASetter s t a b -> b -> s -> t
.~ forall a. a -> Maybe a
Just FileBrowser n
t)