Main.hs

import           Control.Monad.IO.Class (liftIO)
import           Data.Text (Text)
import qualified Data.Text as Text
import           Telegram.Bot.API (Chat (..), ChatType (..), Message (..),
                                   ParseMode (Markdown), Update (..),
                                   defaultTelegramClientEnv)
import           Telegram.Bot.Simple (BotApp (..), BotM, Eff, getEnvToken,
                                      reply, replyMessageParseMode, startBot_,
                                      toReplyMessage, withEffect)
import           Telegram.Bot.Simple.Debug (traceBotDefault)
import           Text.Printf (printf)

import           Scoreboard (Report (..), loadStudents, scoreReport)

main :: IO ()
main = do
  token <- getEnvToken "TELEGRAM_BOT_TOKEN"
  env <- defaultTelegramClientEnv token
  startBot_ (traceBotDefault bot) env

data Model = EmptyModel
  deriving Show

newtype Action = ReportFor Text
  deriving Show

bot :: BotApp Model (Maybe Action)
bot = BotApp{botInitialModel = EmptyModel, botAction, botHandler, botJobs = []}
  where
    botAction :: Update -> Model -> Maybe (Maybe Action)
    botAction update EmptyModel = Just <$> parseAction update

    botHandler :: Maybe Action -> Model -> Eff (Maybe Action) Model
    botHandler maction model =
      case maction of
        Nothing     -> pure model
        Just action -> withEffect (Nothing <$ handleAction action) model

authenticate :: Update -> Maybe Text
authenticate Update{updateMessage} =
  case updateMessage of
    Just Message{messageChat = Chat{chatType = ChatTypePrivate, chatUsername}}
      ->
        chatUsername
    _ -> Nothing

parseAction :: Update -> Maybe Action
parseAction update = do
  user <- authenticate update
  pure $ ReportFor user

handleAction :: Action -> BotM ()
handleAction (ReportFor user) = do
  students <- liftIO loadStudents
  let mReport = scoreReport students user
  let text = maybe "no data" (Text.pack . showReport) mReport
  let message = (toReplyMessage text){replyMessageParseMode = Just Markdown}
  reply message

showReport :: Report -> String
showReport Report{score, totalScore, quantile} =
  unlines
    [ "ДЗ:"
    , "```"
    , unwords $ map show2 [1..10 :: Int]
    , unwords $ map show2 score
    , "```"
    , "Сумма за ДЗ: " <> show totalScore
    , ""
    , "Рейтинг: " <> printf "%.0f%%" quantile
    ]
  where
    show2 = printf "%2d"

Scoreboard.hs

module Scoreboard
  ( Report (..), Student (..), scoreReport, loadStudents
  ) where

import qualified Data.ByteString.Char8 as BS
import qualified Data.ByteString.Lazy as BSL
import           Data.Char (ord)
import           Data.Csv (FromNamedRecord, decDelimiter, parseNamedRecord,
                           (.:))
import qualified Data.Csv as Csv
import           Data.Foldable (toList)
import           Data.List (genericLength, partition)
import           Data.Map.Strict ((!?))
import qualified Data.Map.Strict as Map
import           Data.Maybe (fromMaybe)
import           Data.Text (Text)
import           Data.Text.Encoding (encodeUtf8)
import           Data.Traversable (for)
import           Text.Read (readMaybe)

data Student = Student
  { name     :: Text
  , telegram :: Maybe Text
  , score    :: [Int]
  , valid    :: Bool
  }
  deriving (Show)

instance FromNamedRecord Student where
  parseNamedRecord rec = do
    valid    <- (/= '-') <$> rec .: "valid"
    name     <- rec .: encodeUtf8 "Студент"
    telegram <- rec .: "Telegram"
    score    <-
      for [1..10 :: Int] \i ->
        fromMaybe 0 . readMaybe <$> rec .: BS.pack (show i)
    pure Student{..}

data Report = Report{score :: [Int], totalScore :: Int, quantile :: Double}

scoreReport :: [Student] -> Text -> Maybe Report
scoreReport students =
  \user -> do
    Student{score = theScore} <- studentsByTelegram !? user
    let (studentsLt, _studentsGe) =
          partition (\Student{score} -> sum score < sum theScore) students
        studentsEq =
          filter (\Student{score} -> sum score == sum theScore) _studentsGe
    pure
      Report
        { score = theScore
        , totalScore = sum theScore
        , quantile =
            100
            * (genericLength studentsLt + genericLength studentsEq / 2)
            / genericLength students
        }
  where
    studentsByTelegram =
      Map.fromList
        [(user, student) | student@Student{telegram = Just user} <- students]

loadStudents :: IO [Student]
loadStudents =
  do
    content <- BSL.readFile "students.tsv"
    let decodeResult = Csv.decodeByNameWith tsv content
    case decodeResult of
      Left err              -> fail err
      Right (_header, rows) -> pure $ toList rows
  where
    tsv = Csv.defaultDecodeOptions{decDelimiter = fromIntegral $ ord '\t'}