Solution for Gophercises Quiz game in Haskell

Question

Here is my solution for the Quiz game exercise from https://gophercises.com/. The goal is to write a program that will read questions and their correct answers from a CSV file, ask them from a user one by one, and print the number of correct answers. The interesting part is that a user has a limited amount of time for answering questions and the quiz should stop as soon as the time limit has exceeded.

I use MissingH and parsec to parse CSV files, optparse-applicative to parse CLI options.

From a code review, I expect some general advice and answers to the following specific questions:

• Is there a way to rewrite play function without MVar's?
• How to separate quiz logic from the concurrent implementation (forking, MVar manipulation) in the play function?
• The first version of the solution was without a timer and to count the number of correct answers I used the following function:

Code for kinda beautiful count function:

count :: [IO Bool] -> IO Integer
count [] = return 0
count (act:xs) = do
  correct <- act
  fmap ((if correct then 1 else 0) +) (count xs)

With the presence of a timer, I have to use another MVar (which is an ugly solution IMHO) to hold the number of correct answers because the thread could be killed at any time. Is it possible to stop recursion somehow when the thread got killed to return the partial result?

Code for the final solution:

module Main where

import Lib

import System.IO
import Text.ParserCombinators.Parsec (parseFromFile)
import Data.CSV (csvFile)
import Control.Applicative (liftA2)
import Options.Applicative
import Data.Semigroup ((<>))
import Control.Concurrent.MVar
import Control.Exception
import Control.Concurrent (forkIO, threadDelay)
import Control.Monad (when)

data Options = Options {inputFile :: String, time :: Int}
options :: Parser Options
options = Options
  <$> strOption
    (long "csv-file" <> value "problems.csv")
  <*> option auto
    (long "time" <> value 30)

main :: IO ()
main = do
  Options {inputFile = file, time = t} <- execParser $ info options briefDesc
  result <- parseFromFile csvFile file
  case result of
    Left e -> putStrLn ("CSV parse error: " ++ show e)
    Right lines -> play lines t

play :: [[String]] -> Int -> IO ()
play lines time = do
  putStrLn $ "Total number of questions is " ++ (show . length) lines
  waitAnyKey
  done <- newEmptyMVar
  correct <- newMVar 0
  questionsT <- forkIO $ do
    askQuestions (map (\[q, a] -> ask q a) lines) done correct
    putMVar done True
  timerT <- forkIO $ do
    threadDelay $ time * 10^6
    putStrLn "\nTimes is out"
    putMVar done True
  takeMVar done
  throwTo questionsT ThreadKilled
  throwTo timerT ThreadKilled

  c <- takeMVar correct
  putStrLn $ "\nNumber of correct answers is " ++ show c

waitAnyKey :: IO ()
waitAnyKey = do
  hSetBuffering stdin NoBuffering
  putStrLn "Hit any key when you get ready"
  getChar
  putChar '\b'
  hSetBuffering stdin LineBuffering

askQuestions :: [IO Bool] -> MVar Bool -> MVar Integer -> IO ()
askQuestions [] done correct = putMVar done True
askQuestions (act:xs) done correct = do
  c <- act
  when c $ modifyMVar_ correct $ \ v -> return (v + 1)
  askQuestions xs done correct

type Question = String
type Answer = String

ask :: Question -> Answer -> IO Bool
ask q a = do
  putStr (q ++ "? ")
  hFlush stdout
  userAnswer <- getLine
  return (userAnswer == a)