thock-0.2.0.0: src/Thock.hs

{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TypeSynonymInstances #-}

-- | This module provides the core data and functionality for handling the game.
module Thock where

import Brick.Forms (Form)
import qualified Brick.Widgets.Edit as E
import qualified Brick.Widgets.List as L
import Control.Applicative (Applicative (liftA2))
import Control.Lens
  ( makeFieldsNoPrefix,
    makeLenses,
    (%~),
    (&),
    (?~),
    (^.),
  )
import Data.Aeson (FromJSON, ToJSON)
import Data.Char (isAlphaNum, isAscii)
import Data.Function (on)
import qualified Data.Text as T
import Data.Text.Zipper
  ( TextZipper,
    clearZipper,
    currentLine,
    cursorPosition,
    getText,
    moveLeft,
    moveRight,
    textZipper,
  )
import Data.Time (UTCTime, diffUTCTime)
import qualified Data.Vector as Vec
import GHC.Generics (Generic)
import Quotes (Quote, numChars, text)
import System.Random (Random (randoms), getStdGen)

-- | Unique identifiers to describe cursor locations
data ResourceName
  = UsernameField
  | RoomIdField
  | Ordinary
  deriving (Eq, Ord, Show)

-- | The state that tracks a player's progress
data GameState = GameState
  { -- | Current word the player is on, as well as previous and future words
    _prompt :: TextZipper T.Text,
    -- | Player input for the current word
    _input :: E.Editor T.Text ResourceName,
    -- | The quote being typed
    _quote :: Quote,
    -- | The time the game started if it has started
    _start :: Maybe UTCTime,
    -- | The last time the game was updated if it has started
    _lastUpdated :: Maybe UTCTime,
    -- | The number of keyboard strokes made
    _strokes :: Int
  }

makeLenses ''GameState

type MenuList = L.List ResourceName T.Text

newtype Username = Username {_value :: T.Text}
  deriving (Generic)

makeLenses ''Username

instance FromJSON Username

instance ToJSON Username

type RoomId = T.Text

-- | The data needed to join an online room
data RoomFormData = RoomFormData
  { _username :: Username,
    _roomId :: RoomId
  }
  deriving (Generic)

makeFieldsNoPrefix ''RoomFormData

instance FromJSON RoomFormData

instance ToJSON RoomFormData

type RoomForm a = Form a () ResourceName

-- | The current status of the game
data Game
  = MainMenu MenuList
  | OnlineSelect MenuList
  | CreateRoomMenu (RoomForm Username)
  | JoinRoomMenu (RoomForm RoomFormData)
  | Practice GameState
  | ErrorOverlay Game T.Text

makeLenses ''Game

-- | Produces the decimal amount the player has completed correctly
calculateProgress :: GameState -> Float
calculateProgress g = ((/) `on` fromIntegral) correct total
  where
    correct = numCorrectChars g
    total = g ^. (quote . numChars)

-- | Produces the total number of correct characters the player has typed
numCorrectChars :: GameState -> Int
numCorrectChars g = correctBefore + col
  where
    correctBefore = T.length . foldMap (`T.snoc` ' ') . take row $ getText tz
    (row, col) = cursorPosition tz
    tz = g ^. prompt

-- | Updates the prompt to be in sync with the user's input
movePromptCursor :: GameState -> GameState
movePromptCursor g =
  if currentWordFinished
    then g & prompt %~ moveRight & input %~ E.applyEdit clearZipper -- move onto the next word and clear the input box
    else g & prompt %~ movePromptByN moveAmount
  where
    currentWordFinished = currentInput == T.snoc currentWord ' '
    moveAmount = numCorrectCurrentWord g - col
    (_, col) = cursorPosition (g ^. prompt)
    currentInput = head $ E.getEditContents (g ^. input)
    currentWord = currentLine (g ^. prompt)

-- | Moves the prompt by n spaces right if positive and left if negative
movePromptByN :: Int -> TextZipper T.Text -> TextZipper T.Text
movePromptByN n tz
  | n < 0 = movePromptByN (n + 1) (moveLeft tz)
  | n > 0 = movePromptByN (n - 1) (moveRight tz)
  | otherwise = tz

-- | Produces the number of correct characters the player has typed in the current word
numCorrectCurrentWord :: GameState -> Int
numCorrectCurrentWord g = length . takeWhile (uncurry (==)) $ T.zip currentWord currentInput
  where
    currentWord = currentLine (g ^. prompt)
    currentInput = head $ E.getEditContents (g ^. input)

-- | Produces the number of incorrect characters the player has typed
numIncorrectChars :: GameState -> Int
numIncorrectChars g = T.length currentInput - numCorrectCurrentWord g
  where
    currentInput = head $ E.getEditContents (g ^. input)

-- | Starts the timer if it hasn't started already and sets lastUpdated to t
updateTime :: UTCTime -> GameState -> GameState
updateTime t g = g' & lastUpdated ?~ t
  where
    g' = case g ^. start of
      Nothing -> g & start ?~ t
      _ -> g

-- | Calculates typing speed in words per minute where a word is 5 characters
calculateWpm :: GameState -> Double
calculateWpm g = if s == 0 then 0 else cps * (60 / 5)
  where
    cps = fromIntegral (numCorrectChars g) / s
    s = secondsElapsed g

-- | Calculates decimal amount of correct typed / total typed characters
accuracy :: GameState -> Double
accuracy g = ((/) `on` fromIntegral) (g ^. (quote . numChars)) (g ^. strokes)

-- | The number of seconds from start to lastUpdated
secondsElapsed :: GameState -> Double
secondsElapsed g = maybe 0 realToFrac (liftA2 diffUTCTime (g ^. lastUpdated) (g ^. start))

-- | Produces true if the game is done, false otherwise
isDone :: GameState -> Bool
isDone g = numCorrectChars g == g ^. (quote . numChars)

-- | Creates an initial game with the given quote
initializeGameState :: Quote -> GameState
initializeGameState q =
  GameState
    { _prompt = textZipper (T.words (q ^. text)) Nothing,
      _input = E.editor Ordinary (Just 1) "",
      _quote = q,
      _start = Nothing,
      _lastUpdated = Nothing,
      _strokes = 0
    }

-- | Creates an initial 'Game' starting at the main menu
initialGame :: Game
initialGame = MainMenu (L.list Ordinary (Vec.fromList ["Practice", "Online"]) 2)

-- | Creates a 'Game' for the online select menu with options to create or join a room
onlineSelectState :: Game
onlineSelectState = OnlineSelect (L.list Ordinary (Vec.fromList ["Create room", "Join room"]) 2)

-- | Initializes a 'Practice' game with the given quote
startPracticeGame :: Quote -> Game
startPracticeGame q = Practice (initializeGameState q)

-- | Randomly generates an alphanumeric 'RoomId'
generateRoomId :: IO RoomId
generateRoomId = T.pack . take 10 . filter (\c -> isAscii c && isAlphaNum c) . randoms <$> getStdGen