hedra-0.1: app/Main.hs

{-# LANGUAGE LambdaCase #-}

module Main (main) where

import qualified Hedra
import qualified System.Console.Haskeline as Haskeline

import Control.Applicative ((<|>))
import Control.Monad (guard, when)
import Control.Monad.IO.Class (liftIO)
import Data.Char (isDigit, isSpace)
import Data.List (dropWhileEnd)
import Data.Maybe (listToMaybe)

main :: IO ()
main =
  Haskeline.runInputT settings loop
  where
    settings :: Haskeline.Settings IO
    settings = Haskeline.setComplete Haskeline.noCompletion Haskeline.defaultSettings

    loop :: Haskeline.InputT IO ()
    loop = do
      lineMay <- Haskeline.getInputLine "hedra> "
      case lineMay of
        Just line -> do
          let trimmedLine = (dropWhile isSpace . dropWhileEnd isSpace) line
          when
            (not (null trimmedLine))
            (liftIO (processInput trimmedLine))
          loop
        Nothing ->
          pure ()

    processInput :: String -> IO ()
    processInput input =
      case parseInput input of
        Just (count, die) -> do
          putStr (input ++ ": ")
          Hedra.printRoll count die
        Nothing ->
          putStrLn "Invalid input. Valid formats: d4, 2d6, 1d100, 1d%, 4df"

parseInput :: String -> Maybe (Int, Hedra.Die)
parseInput input =
  listToMaybe $ do
    (count, afterCount) <- reads input <|> [(1, input)]
    guard (count >= 0)
    (_, afterSeparator) <- parseSeparator afterCount
    (die, _) <- parseDie afterSeparator
    pure (count, die)

parseSeparator :: String -> [((), String)]
parseSeparator = \case
  'd' : rest -> [((), rest)]
  _ -> []

parseDie :: String -> [(Hedra.Die, String)]
parseDie = \case
  "%" -> [(Hedra.Percentile, "")]
  "f" -> [(Hedra.Fudge, "")]
  digits@(_:_) | all isDigit digits ->
    case read digits of
      0 -> []
      positiveSides -> [(fromIntegral (positiveSides :: Int), "")]
  _ -> []