TaskBot/lib/BotCommands.hs at 2487771058fa2b1f984c5f27257956454f941f79 · MCL1303/TaskBot · GitHub

1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}

module BotCommands
    ( BotCmd (..)
    , addNote
    , countNotes
    , readCommand
    , sendMessage
    , showNew
    , showOld
    ) where

import           Control.Monad (void)
import           Data.Char (isSpace)
import           Data.Foldable (for_)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Database.Persist.Extra (Entity (..), SelectOpt (Desc, LimitTo),
                                         getKeyByValue, insertBy, insert_,
                                         selectValList, (==.))
import           Web.Telegram.API.Bot (ChatId (..), TelegramClient,
                                       sendMessageM, sendMessageRequest)

import DB (EntityField (NoteId, NoteOwner), Note (..), User (..), runDB)

data BotCmd = ShowNew | ShowOld | WrongCommand Text

countNotes :: Int
           -> TelegramClient (Int)
countNotes userId = do
    mUid <- runDB $ getKeyByValue DB.User{userTelegramId = fromIntegral userId}
    case mUid of
        Just uid -> do
            notes <- runDB $ selectValList [NoteOwner ==. uid] []
            pure $ length notes
        Nothing -> pure 0

sendMessage :: Integer
            -> Text
            -> TelegramClient ()
sendMessage chatId message = void . sendMessageM $
    sendMessageRequest (ChatId chatId) message

showNew :: Integer -- ^ ChatId for sending notes
        -> Int -- ^ UserId - who wants to show
        -> TelegramClient ()
showNew chatId userId = do
    mUid <- runDB $ getKeyByValue DB.User{userTelegramId = fromIntegral userId}
    case mUid of
        Just uid -> do
            notes <- runDB $
                selectValList [NoteOwner ==. uid] [LimitTo 3, Desc NoteId]
            for_ notes $ \Note{noteText} ->
                sendMessage chatId noteText
        Nothing ->
            sendMessage chatId "Записей нет."

showOld :: Integer -- ^ ChatId for sending notes
        -> Int -- ^ UserId - who wants to show
        -> TelegramClient ()
showOld chatId userId = do
    mUid <- runDB $ getKeyByValue DB.User{userTelegramId = fromIntegral userId}
    case mUid of
        Just uid -> do
            notes <- runDB $
                selectValList [NoteOwner ==. uid] [LimitTo 3]
            for_ notes $ \Note{noteText} ->
                sendMessage chatId noteText
        Nothing ->
            sendMessage chatId "Записей нет."

addNote :: Int -- ^ UserId - who wants to insert
        -> Text -- ^ Note to insert
        -> TelegramClient ()
addNote userId note = do
    uid <-
        runDB $
            either entityKey id <$>
            insertBy DB.User{userTelegramId = fromIntegral userId}
    runDB $ insert_ Note{noteText = note, noteOwner = uid}

readCommand :: Text -> Maybe BotCmd
readCommand messageText =
    case Text.uncons slashCommand of
        Just ('/', tTail) ->
            case Text.strip tTail of
                "show_new" -> Just ShowNew
                "show_old" -> Just ShowOld
                wrongCmd   -> Just (WrongCommand wrongCmd)
        _ -> Nothing
  where slashCommand = Text.takeWhile (not . isSpace) messageText