<commit_before>{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}

module Types where

import           Brick (EventM, txt, vBox, Next)
import           Brick.AttrMap (AttrMap)
import           Brick.Widgets.Edit (Editor, editor)
import           Brick.Widgets.List (List)
import           Cheapskate (Blocks)
import           Control.Concurrent.Chan (Chan)
import           Control.Concurrent.MVar (MVar)
import           Data.HashMap.Strict (HashMap)
import           Data.Time.Clock (UTCTime)
import           Data.Time.LocalTime (TimeZone)
import qualified Data.HashMap.Strict as HM
import qualified Data.Sequence as Seq
import           Data.Monoid
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform (makeLenses, (^.), (^?), ix, to, SimpleGetter)
import           Network.Mattermost
import           Network.Mattermost.Lenses
import           Network.Mattermost.WebSocket.Types
import qualified Cheapskate as C
import qualified Data.Text as T

import           Zipper (Zipper)
import           Config

import           InputHistory

data MMNames = MMNames
  { _cnChans    :: [T.Text]
  , _cnDMs      :: [T.Text]
  , _cnToChanId :: HashMap T.Text ChannelId
  , _cnUsers    :: [T.Text]
  , _cnToUserId :: HashMap T.Text UserId
  }

emptyMMNames :: MMNames
emptyMMNames = MMNames mempty mempty mempty mempty mempty

makeLenses ''MMNames

data Name = ChannelMessages ChannelId
          | MessageInput
          | NormalChannelList
          | DMChannelList
          | HelpViewport
          | ChannelSelectString
          | CompletionAlternatives
          | JoinChannelList
          deriving (Eq, Show, Ord)

-- We want to continue referring to posts by their IDs, but we don't want to
-- have to synthesize new valid IDs for messages from the client itself. To
-- that end, a PostRef can be either a PostId or a newly-generated client ID
data PostRef
  = MMId PostId
  | CLId Int
    deriving (Eq, Show)

data ClientMessageType =
    Informative
    | Error
    | DateTransition
    deriving (Eq, Show)

-- A ClientMessage is a message given to us by our client, like help text
-- or an error message.
data ClientMessage = ClientMessage
  { _cmText :: T.Text
  , _cmDate :: UTCTime
  , _cmType :: ClientMessageType
  } deriving (Eq, Show)

makeLenses ''ClientMessage

data PostType =
    NormalPost
    | Emote
    | Join
    | Leave
    | TopicChange
    deriving (Eq, Show)

data ClientPost = ClientPost
  { _cpText        :: Blocks
  , _cpUser        :: UserId
  , _cpDate        :: UTCTime
  , _cpType        :: PostType
  , _cpPending     :: Bool
  , _cpDeleted     :: Bool
  , _cpAttachments :: Seq.Seq T.Text
  , _cpPostId      :: PostId
  } deriving (Show)

makeLenses ''ClientPost

data MessageType = C ClientMessageType
                 | CP PostType
                 deriving (Eq, Show)

-- This represents any message we might want to render.
data Message = Message
  { _mText        :: Blocks
  , _mUserName    :: Maybe T.Text
  , _mDate        :: UTCTime
  , _mType        :: MessageType
  , _mPending     :: Bool
  , _mDeleted     :: Bool
  , _mAttachments :: Seq.Seq T.Text
  , _mPostId      :: Maybe PostId
  } deriving (Show)

makeLenses ''Message

getBlocks :: T.Text -> Blocks
getBlocks s = bs where C.Doc _ bs = C.markdown C.def s

postClientPostType :: Post -> PostType
postClientPostType cp =
    if | postIsEmote cp       -> Emote
       | postIsJoin  cp       -> Join
       | postIsLeave cp       -> Leave
       | postIsTopicChange cp -> TopicChange
       | otherwise            -> NormalPost

postIsTopicChange :: Post -> Bool
postIsTopicChange p =
    "updated the channel header from:" `T.isInfixOf` postMessage p

postIsEmote :: Post -> Bool
postIsEmote p =
    and [ HM.lookup "override_icon_url" (postProps p) == Just (""::T.Text)
        , HM.lookup "override_username" (postProps p) == Just ("webhook"::T.Text)
        , ("*" `T.isPrefixOf` postMessage p)
        , ("*" `T.isSuffixOf` postMessage p)
        ]

postIsJoin :: Post -> Bool
postIsJoin p = "has joined the channel" `T.isInfixOf` postMessage p

postIsLeave :: Post -> Bool
postIsLeave p = "has left the channel" `T.isInfixOf` postMessage p

unEmote :: PostType -> T.Text -> T.Text
unEmote Emote t = if "*" `T.isPrefixOf` t && "*" `T.isSuffixOf` t
                  then T.init $ T.tail t
                  else t
unEmote _ t = t

toClientPost :: Post -> ClientPost
toClientPost p = ClientPost
  { _cpText        = getBlocks $ unEmote (postClientPostType p) $ postMessage p
  , _cpUser        = postUserId p
  , _cpDate        = postCreateAt p
  , _cpType        = postClientPostType p<commit_msg>Updated uses of PostProps to expect new richer type<commit_after>{-# LANGUAGE GADTs #-}
{-# LANGUAGE KindSignatures #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE MultiWayIf #-}

module Types where

import           Brick (EventM, txt, vBox, Next)
import           Brick.AttrMap (AttrMap)
import           Brick.Widgets.Edit (Editor, editor)
import           Brick.Widgets.List (List)
import           Cheapskate (Blocks)
import           Control.Concurrent.Chan (Chan)
import           Control.Concurrent.MVar (MVar)
import           Data.HashMap.Strict (HashMap)
import           Data.Time.Clock (UTCTime)
import           Data.Time.LocalTime (TimeZone)
import qualified Data.HashMap.Strict as HM
import qualified Data.Sequence as Seq
import           Data.Monoid
import qualified Graphics.Vty as Vty
import           Lens.Micro.Platform (makeLenses, (^.), (^?), ix, to, SimpleGetter)
import           Network.Mattermost
import           Network.Mattermost.Lenses
import           Network.Mattermost.WebSocket.Types
import qualified Cheapskate as C
import qualified Data.Text as T

import           Zipper (Zipper)
import           Config

import           InputHistory

data MMNames = MMNames
  { _cnChans    :: [T.Text]
  , _cnDMs      :: [T.Text]
  , _cnToChanId :: HashMap T.Text ChannelId
  , _cnUsers    :: [T.Text]
  , _cnToUserId :: HashMap T.Text UserId
  }

emptyMMNames :: MMNames
emptyMMNames = MMNames mempty mempty mempty mempty mempty

makeLenses ''MMNames

data Name = ChannelMessages ChannelId
          | MessageInput
          | NormalChannelList
          | DMChannelList
          | HelpViewport
          | ChannelSelectString
          | CompletionAlternatives
          | JoinChannelList
          deriving (Eq, Show, Ord)

-- We want to continue referring to posts by their IDs, but we don't want to
-- have to synthesize new valid IDs for messages from the client itself. To
-- that end, a PostRef can be either a PostId or a newly-generated client ID
data PostRef
  = MMId PostId
  | CLId Int
    deriving (Eq, Show)

data ClientMessageType =
    Informative
    | Error
    | DateTransition
    deriving (Eq, Show)

-- A ClientMessage is a message given to us by our client, like help text
-- or an error message.
data ClientMessage = ClientMessage
  { _cmText :: T.Text
  , _cmDate :: UTCTime
  , _cmType :: ClientMessageType
  } deriving (Eq, Show)

makeLenses ''ClientMessage

data PostType =
    NormalPost
    | Emote
    | Join
    | Leave
    | TopicChange
    deriving (Eq, Show)

data ClientPost = ClientPost
  { _cpText        :: Blocks
  , _cpUser        :: UserId
  , _cpDate        :: UTCTime
  , _cpType        :: PostType
  , _cpPending     :: Bool
  , _cpDeleted     :: Bool
  , _cpAttachments :: Seq.Seq T.Text
  , _cpPostId      :: PostId
  } deriving (Show)

makeLenses ''ClientPost

data MessageType = C ClientMessageType
                 | CP PostType
                 deriving (Eq, Show)

-- This represents any message we might want to render.
data Message = Message
  { _mText        :: Blocks
  , _mUserName    :: Maybe T.Text
  , _mDate        :: UTCTime
  , _mType        :: MessageType
  , _mPending     :: Bool
  , _mDeleted     :: Bool
  , _mAttachments :: Seq.Seq T.Text
  , _mPostId      :: Maybe PostId
  } deriving (Show)

makeLenses ''Message

getBlocks :: T.Text -> Blocks
getBlocks s = bs where C.Doc _ bs = C.markdown C.def s

postClientPostType :: Post -> PostType
postClientPostType cp =
    if | postIsEmote cp       -> Emote
       | postIsJoin  cp       -> Join
       | postIsLeave cp       -> Leave
       | postIsTopicChange cp -> TopicChange
       | otherwise            -> NormalPost

postIsTopicChange :: Post -> Bool
postIsTopicChange p =
    "updated the channel header from:" `T.isInfixOf` postMessage p

postIsEmote :: Post -> Bool
postIsEmote p =
    and [ p^.postPropsL.postPropsOverrideIconUrlL == Just (""::T.Text)
        , p^.postPropsL.postPropsOverrideUsernameL == Just ("webhook"::T.Text)
        , ("*" `T.isPrefixOf` postMessage p)
        , ("*" `T.isSuffixOf` postMessage p)
        ]

postIsJoin :: Post -> Bool
postIsJoin p = "has joined the channel" `T.isInfixOf` postMessage p

postIsLeave :: Post -> Bool
postIsLeave p = "has left the channel" `T.isInfixOf` postMessage p

unEmote :: PostType -> T.Text -> T.Text
unEmote Emote t = if "*" `T.isPrefixOf` t && "*" `T.isSuffixOf` t
                  then T.init $ T.tail t
                  else t
unEmote _ t = t

toClientPost :: Post -> ClientPost
toClientPost p = ClientPost
  { _cpText        = getBlocks $ unEmote (postClientPostType p) $ postMessage p
  , _cpUser        = postUserId p
  , _cpDate        = postCreateAt p
  , _cpType        = postClientPostType p
{'fraction_non_alphanumeric': 0.09031983848687705, 'fraction_numerical': 0.0, 'mean_word_length': 2.4064422728917845, 'pattern_counts': {'":': 4, '<': 3, '<?xml version=': 0, '>': 31, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 0, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '5848092', 'n_tokens_mistral': 2996, 'n_tokens_neox': 2940, 'n_words': 881}