Browse Source

Types.Posts: explicit export list

This change also stops exporting non-lens record accessors so that
we use our API consistently, and in tandem with that, cases where
such accessors were needed now use new exported constructors (e.g.
mkAttachment).
Jonathan Daugherty 2 years ago
parent
commit
0f5680a734
5 changed files with 70 additions and 29 deletions
  1. 2
    12
      src/State/Common.hs
  2. 10
    10
      src/Types.hs
  3. 3
    3
      src/Types/Messages.hs
  4. 54
    3
      src/Types/Posts.hs
  5. 1
    1
      test/Message_QCA.hs

+ 2
- 12
src/State/Common.hs View File

@@ -5,7 +5,7 @@ import           Prelude.Compat
5 5
 
6 6
 import qualified Control.Concurrent.STM as STM
7 7
 import           Control.Exception (try)
8
-import           Control.Monad.IO.Class (MonadIO, liftIO)
8
+import           Control.Monad.IO.Class (liftIO)
9 9
 import qualified Data.Foldable as F
10 10
 import qualified Data.HashMap.Strict as HM
11 11
 import qualified Data.Map.Strict as Map
@@ -13,7 +13,6 @@ import           Data.Monoid ((<>))
13 13
 import qualified Data.Sequence as Seq
14 14
 import qualified Data.Set as Set
15 15
 import qualified Data.Text as T
16
-import           Data.Time.Clock (getCurrentTime)
17 16
 import           Lens.Micro.Platform
18 17
 import           System.Hclip (setClipboard, ClipboardException(..))
19 18
 
@@ -253,11 +252,7 @@ asyncFetchAttachments p = do
253 252
     info <- mmGetFileInfo session fId
254 253
     let scheme = "https://"
255 254
         attUrl = scheme <> host <> urlForFile fId
256
-        attachment = Attachment
257
-                       { _attachmentName   = fileInfoName info
258
-                       , _attachmentURL    = attUrl
259
-                       , _attachmentFileId = fId
260
-                       }
255
+        attachment = mkAttachment (fileInfoName info) attUrl fId
261 256
         addAttachment m
262 257
           | m^.mPostId == Just pId =
263 258
             m & mAttachments %~ (attachment Seq.<|)
@@ -265,12 +260,6 @@ asyncFetchAttachments p = do
265 260
     return $
266 261
       csChannel(cId).ccContents.cdMessages.traversed %= addAttachment
267 262
 
268
-newClientMessage :: (MonadIO m) => ClientMessageType -> T.Text -> m ClientMessage
269
-newClientMessage ty msg = do
270
-  now <- liftIO getCurrentTime
271
-  return (ClientMessage msg now ty)
272
-
273 263
 -- | Add a 'ClientMessage' to the current channel's message list
274 264
 addClientMessage :: ClientMessage -> MH ()
275 265
 addClientMessage msg = do

+ 10
- 10
src/Types.hs View File

@@ -493,22 +493,22 @@ getUsernameForUserId st uId = _uiName <$> findUserById uId (st^.csUsers)
493 493
 
494 494
 clientPostToMessage :: ChatState -> ClientPost -> Message
495 495
 clientPostToMessage st cp = Message
496
-  { _mText          = _cpText cp
497
-  , _mUserName      = case _cpUserOverride cp of
496
+  { _mText          = cp^.cpText
497
+  , _mUserName      = case cp^.cpUserOverride of
498 498
     Just n
499
-      | _cpType cp == NormalPost -> Just (n <> "[BOT]")
500
-    _ -> getUsernameForUserId st =<< _cpUser cp
501
-  , _mDate          = _cpDate cp
502
-  , _mType          = CP $ _cpType cp
503
-  , _mPending       = _cpPending cp
504
-  , _mDeleted       = _cpDeleted cp
505
-  , _mAttachments   = _cpAttachments cp
499
+      | cp^.cpType == NormalPost -> Just (n <> "[BOT]")
500
+    _ -> getUsernameForUserId st =<< cp^.cpUser
501
+  , _mDate          = cp^.cpDate
502
+  , _mType          = CP $ cp^.cpType
503
+  , _mPending       = cp^.cpPending
504
+  , _mDeleted       = cp^.cpDeleted
505
+  , _mAttachments   = cp^.cpAttachments
506 506
   , _mInReplyToMsg  =
507 507
     case cp^.cpInReplyToPost of
508 508
       Nothing  -> NotAReply
509 509
       Just pId -> InReplyTo pId
510 510
   , _mPostId        = Just $ cp^.cpPostId
511
-  , _mReactions     = _cpReactions cp
511
+  , _mReactions     = cp^.cpReactions
512 512
   , _mOriginalPost  = Just $ cp^.cpOriginalPost
513 513
   , _mFlagged       = False
514 514
   , _mChannelId     = Just $ cp^.cpChannelId

+ 3
- 3
src/Types/Messages.hs View File

@@ -97,10 +97,10 @@ data ReplyState =
97 97
 -- | Convert a 'ClientMessage' to a 'Message'
98 98
 clientMessageToMessage :: ClientMessage -> Message
99 99
 clientMessageToMessage cm = Message
100
-  { _mText          = getBlocks (_cmText cm)
100
+  { _mText          = getBlocks (cm^.cmText)
101 101
   , _mUserName      = Nothing
102
-  , _mDate          = _cmDate cm
103
-  , _mType          = C $ _cmType cm
102
+  , _mDate          = cm^.cmDate
103
+  , _mType          = C $ cm^.cmType
104 104
   , _mPending       = False
105 105
   , _mDeleted       = False
106 106
   , _mAttachments   = Seq.empty

+ 54
- 3
src/Types/Posts.hs View File

@@ -1,15 +1,57 @@
1 1
 {-# LANGUAGE MultiWayIf #-}
2 2
 {-# LANGUAGE TemplateHaskell #-}
3
-
4
-module Types.Posts where
3
+module Types.Posts
4
+  ( ClientMessage
5
+  , newClientMessage
6
+  , cmDate
7
+  , cmType
8
+  , cmText
9
+
10
+  , ClientMessageType(..)
11
+
12
+  , Attachment
13
+  , mkAttachment
14
+  , attachmentName
15
+  , attachmentFileId
16
+  , attachmentURL
17
+
18
+  , ClientPostType(..)
19
+
20
+  , ClientPost
21
+  , toClientPost
22
+  , cpUserOverride
23
+  , cpUser
24
+  , cpText
25
+  , cpType
26
+  , cpReactions
27
+  , cpPending
28
+  , cpOriginalPost
29
+  , cpInReplyToPost
30
+  , cpDate
31
+  , cpChannelId
32
+  , cpAttachments
33
+  , cpDeleted
34
+  , cpPostId
35
+
36
+  , unEmote
37
+
38
+  , postIsLeave
39
+  , postIsJoin
40
+  , postIsTopicChange
41
+  , postIsEmote
42
+
43
+  , getBlocks
44
+  )
45
+where
5 46
 
6 47
 import           Cheapskate (Blocks)
7 48
 import qualified Cheapskate as C
49
+import           Control.Monad.IO.Class (MonadIO, liftIO)
8 50
 import qualified Data.Map.Strict as Map
9 51
 import           Data.Monoid ((<>))
10 52
 import qualified Data.Sequence as Seq
11 53
 import qualified Data.Text as T
12
-import           Data.Time.Clock (UTCTime)
54
+import           Data.Time.Clock (UTCTime, getCurrentTime)
13 55
 import           Lens.Micro.Platform ((^.), makeLenses)
14 56
 import           Network.Mattermost
15 57
 import           Network.Mattermost.Lenses
@@ -24,6 +66,12 @@ data ClientMessage = ClientMessage
24 66
   , _cmType :: ClientMessageType
25 67
   } deriving (Eq, Show)
26 68
 
69
+-- | Create a new 'ClientMessage' value
70
+newClientMessage :: (MonadIO m) => ClientMessageType -> T.Text -> m ClientMessage
71
+newClientMessage ty msg = do
72
+  now <- liftIO getCurrentTime
73
+  return (ClientMessage msg now ty)
74
+
27 75
 -- | We format 'ClientMessage' values differently depending on
28 76
 --   their 'ClientMessageType'
29 77
 data ClientMessageType =
@@ -66,6 +114,9 @@ data Attachment = Attachment
66 114
   , _attachmentFileId :: FileId
67 115
   } deriving (Eq, Show)
68 116
 
117
+mkAttachment :: T.Text -> T.Text -> FileId -> Attachment
118
+mkAttachment = Attachment
119
+
69 120
 -- | A Mattermost 'Post' value can represent either a normal
70 121
 --   chat message or one of several special events.
71 122
 data ClientPostType =

+ 1
- 1
test/Message_QCA.hs View File

@@ -99,7 +99,7 @@ genReplyState = oneof [ return NotAReply
99 99
                       ]
100 100
 
101 101
 genAttachment :: Gen Attachment
102
-genAttachment = Attachment
102
+genAttachment = mkAttachment
103 103
                 <$> genText
104 104
                 <*> genText
105 105
                 <*> genFileId

Loading…
Cancel
Save