Add command-line arguments and refactor some basic commands

potrero.cabal

@@ -10,10 +10,11 @@ cabal-version: >=1.14
 executable potrero
   hs-source-dirs: src
   main-is: Main.hs
-  other-modules: Types
-                 Parser
+  other-modules: Potrero.Opts
+                 Potrero.Types
+                 Potrero.Parser
   default-language: Haskell2010
-  ghc-options: -Wall
+  ghc-options: -Wall -Werror
   build-depends: base >=4.7 && <5
                , containers
                , random

src/Main.hs

@@ -2,11 +2,10 @@
 {-# LANGUAGE OverloadedLists #-}
 {-# LANGUAGE TypeFamilies #-}
 
-module Main where
+module Main (main) where
 
 import qualified Control.Exception as Exn
 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
@@ -15,8 +14,9 @@ import qualified System.Console.Readline as Readline
 import qualified System.Environment as Env
 import qualified System.Exit as Exit
 
-import qualified Parser
-import qualified Types
+import qualified Potrero.Opts as Opts
+import qualified Potrero.Parser as Parser
+import qualified Potrero.Types as Types
 
 
 readMap :: FilePath -> IO Types.TableMap
@@ -30,46 +30,67 @@ readMap path = do
 main :: IO ()
 main = do
   args <- Env.getArgs
-  let filename = case args of
-        path:_ -> path
-        _      -> "perilous-wilds.txt"
-  tablesRef <- IO.newIORef =<< readMap filename
-  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 ":q" -> 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 filename
-
-      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 >>= showValueAndRolls)
-              `Exn.catch` handleBadTable
+  case Opts.getConfig args of
+    Left err -> do
+      putStrLn err
+      putStrLn Opts.usage
+      Exit.exitFailure
+    Right config
+      | Opts.configMode config == Opts.ShowHelp ->
+        putStrLn Opts.usage
+      | Opts.configMode config == Opts.ShowVersion ->
+        putStrLn Opts.version
+      | otherwise -> do
+        maps <- mapM readMap (Opts.configFiles config)
+        runRepl (Map.unions maps) config
+
+setCompletion :: Types.TableMap -> IO ()
+setCompletion tables =
+  Readline.setCompletionEntryFunction $ Just $ \rs ->
+  pure [ Text.unpack k
+       | k <- Map.keys tables
+       , Text.pack rs `Text.isPrefixOf` k
+       ]
+
+runRepl :: Types.TableMap -> Opts.Config -> IO ()
+runRepl tables config = do
+  setCompletion tables
+  let printFunc = case Opts.configShowRolls config of
+        False -> showValue
+        True  -> showValueAndRolls
+
+  input <- Readline.readline "\x1b[31m--> \x1b[39m"
+  case input of
+    Nothing -> do
+      putStrLn "farewell"
+      Exit.exitSuccess
+    Just ":q" -> do
+      putStrLn "farewell"
+      Exit.exitSuccess
+
+    Just "" -> runRepl tables config
+
+    Just ":l" -> do
+      Text.putStrLn "Available tables: "
+      Text.putStrLn ("  " <> Text.unwords (Map.keys tables))
+      runRepl tables config
+
+    Just ":r" -> do
+      maps <- mapM readMap (Opts.configFiles config)
+      putStrLn ("reloaded: " <> unwords (Opts.configFiles config))
+      runRepl (Map.unions maps) config
+
+    Just choice -> do
+      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 >>= printFunc)
+          `Exn.catch` handleBadTable
+      runRepl tables config
 
 handleBadTable :: Types.BadTable -> IO ()
 handleBadTable bt = do

src/Potrero/Opts.hs

@@ -0,0 +1,56 @@
+module Potrero.Opts
+  ( Config(..)
+  , Mode(..)
+  , getConfig
+
+  , usage
+  , version
+  ) where
+
+import qualified System.Console.GetOpt as Opt
+
+data Mode
+  = ShowHelp
+  | ShowVersion
+  | REPL
+    deriving (Eq, Show)
+
+data Config = Config
+  { configFiles     :: [FilePath]
+  , configShowRolls :: Bool
+  , configMode      :: Mode
+  } deriving (Eq, Show)
+
+defaultConfig :: Config
+defaultConfig = Config
+  { configFiles     = []
+  , configShowRolls = False
+  , configMode      = REPL
+  }
+
+opts :: [Opt.OptDescr (Config -> Config)]
+opts =
+  [ Opt.Option ['s'] ["show-rolls"]
+    (Opt.NoArg (\ conf -> conf { configShowRolls = True }))
+    "show the exact roll results"
+  , Opt.Option ['h'] ["help"]
+    (Opt.NoArg (\ conf -> conf { configMode = ShowHelp }))
+    "show this help text"
+  , Opt.Option ['v'] ["version"]
+    (Opt.NoArg (\ conf -> conf { configMode = ShowVersion }))
+    "show the version"
+  ]
+
+usage :: String
+usage = Opt.usageInfo "potrero" opts
+
+version :: String
+version = "potrero, version 0.1"
+
+getConfig :: [String] -> Either String Config
+getConfig args =
+  let (fs, files, errors) = Opt.getOpt Opt.Permute opts args
+      conf = foldr ($) defaultConfig fs
+  in case errors of
+    [] -> pure conf { configFiles = files }
+    _  -> Left (unlines errors)

src/Parser.hs

@@ -1,11 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Parser where
+module Potrero.Parser where
 
-import           Data.Char as Char
+import qualified Data.Char as Char
 import qualified Data.Text as Text
 
-import Types
+import           Potrero.Types
 
 data LineType
   = TableDecl Int Text.Text

src/Types.hs

@@ -1,6 +1,6 @@
 {-# LANGUAGE OverloadedStrings #-}
 
-module Types where
+module Potrero.Types where
 
 import qualified Control.Exception as Exn
 import qualified Data.Map.Strict as Map