potrero/src/Main.hs

{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE OverloadedLists #-}
{-# LANGUAGE TypeFamilies #-}

module Main where

import qualified Control.Monad as M
import qualified Data.IORef as IO
import qualified Data.Map.Strict as Map
import           Data.Monoid ((<>))
import qualified Data.Text as Text
import qualified Data.Text.IO as Text
import qualified System.Console.Readline as Readline
import qualified System.Exit as Exit

import qualified Parser
import qualified Types


readMap :: FilePath -> IO Types.TableMap
readMap path = do
  cs <- Text.readFile path
  pure $ Map.fromList
    [ (Types.tableName t, t)
    | t <- Parser.parseTable cs
    ]

main :: IO ()
main = do
  tablesRef <- IO.newIORef =<< readMap "perilous-wilds.txt"
  Readline.setCompletionEntryFunction $ Just $ \ rs -> do
    tables <- IO.readIORef tablesRef
    pure [ Text.unpack k
         | k <- Map.keys tables
         , Text.pack rs `Text.isPrefixOf` k
         ]
  M.forever $ do
    input <- Readline.readline "\x1b[31m--> \x1b[39m"
    case input of
      Nothing -> do
        putStrLn "farewell"
        Exit.exitSuccess
      Just "" -> pure ()
      Just ":l" -> do
        tables <- IO.readIORef tablesRef
        Text.putStrLn "Available tables: "
        Text.putStrLn ("  " <> Text.unwords (Map.keys tables))
      Just ":r" ->
        IO.writeIORef tablesRef =<< readMap "perilous-wilds.txt"
      Just choice -> do
        tables <- IO.readIORef tablesRef
        let names = Text.unwords (Map.keys tables)
        Readline.addHistory choice
        case Map.lookup (Text.strip (Text.pack choice)) tables of
          Nothing -> do
            Text.putStrLn ("table not found: " <> Text.pack (show choice))
            Text.putStrLn ("  valid tables include: " <> names)
          Just t -> Types.rollTable tables t