From edc2a7161abdfd108c66ba46f49a742089a04cf8 Mon Sep 17 00:00:00 2001
From: Adam Wick <awick@uhsure.com>
Date: Sat, 30 Apr 2016 16:15:00 -0700
Subject: [PATCH] New command line processing.

---
 bang.cabal                |  6 +--
 src/Main.hs               |  6 ++-
 src/Syntax/CommandLine.hs | 85 +++++++++++++++++++++++----------------
 3 files changed, 58 insertions(+), 39 deletions(-)

diff --git a/bang.cabal b/bang.cabal
index 513c3dc..d22afbd 100644
--- a/bang.cabal
+++ b/bang.cabal
@@ -14,9 +14,9 @@ cabal-version:       >=1.10
 
 executable bang
   main-is:             Main.hs
-  build-depends:       base       >= 4.8     && < 4.9,
-                       bytestring >= 0.10    && < 0.11,
-                       cmdargs    >= 0.10.14 && < 0.12
+  build-depends:       base                 >= 4.8     && < 4.9,
+                       bytestring           >= 0.10    && < 0.11,
+                       optparse-applicative >= 0.12.1  && < 0.14
   hs-source-dirs:      src
   build-tools:         alex, happy
   default-language:    Haskell2010
diff --git a/src/Main.hs b/src/Main.hs
index 5bf3b3e..e088424 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,8 +1,10 @@
 import Syntax.CommandLine
 
 main :: IO ()
-main = getCommand >>= \ mode ->
-  putStrLn (show mode)
+main = getCommand >>= \ cmd ->
+  case cmdCommand cmd of
+    Lex _lexOpts -> putStrLn ("LEX: " ++ show cmd)
+    Help         -> putStrLn helpString
 
 
 {-
diff --git a/src/Syntax/CommandLine.hs b/src/Syntax/CommandLine.hs
index 8bbd750..1731f06 100644
--- a/src/Syntax/CommandLine.hs
+++ b/src/Syntax/CommandLine.hs
@@ -1,47 +1,64 @@
-{-# LANGUAGE DeriveDataTypeable #-}
 module Syntax.CommandLine(
-         Bang(..), getCommand
+         BangCommand(..)
+       , BangOperation(..)
+       , LexerOptions(..)
+       , getCommand
+       , helpString
        )
  where
 
 import Data.Version(showVersion)
 import Paths_bang(version)
-import System.Console.CmdArgs hiding (verbosity)
+import Options.Applicative
+import Options.Applicative.Help
 
-data Bang = Bang {
-       verbosity :: Word
-     , files     :: [FilePath]
-     , mode      :: BangMode
+data BangCommand = BangCommand {
+       cmdVerbosity  :: Verbosity
+     , cmdOutputFile :: FilePath
+     , cmdCommand    :: BangOperation
      }
- deriving (Data, Typeable, Show, Eq)
+ deriving (Show)
 
-data BangMode = Lex | Parse
- deriving (Data, Typeable, Show, Eq)
+data Verbosity = Silent | Normal | Verbose
+ deriving (Eq, Show)
 
-lexer :: Bang
-lexer = Bang {
-         verbosity = 0  &= name "verbose" &= name "v"
-       , files     = [] &= args
-       , mode      = Lex
-       } &= name "lex"
+verboseOption :: Parser Verbosity
+verboseOption = flag Normal Silent  (short 'q' <> long "quiet")
+            <|> flag Normal Verbose (short 'v' <> long "verbose")
 
-parser :: Bang
-parser = Bang {
-         verbosity = 0  &= name "verbose" &= name "v"
-       , files     = [] &= args
-       , mode      = Parse
-       } &= name "parse"
+outputFile :: Parser FilePath
+outputFile = strOption (short 'o' <> long "output-file" <> metavar "FILE"
+                      <> help "The file to output as a result of this action."
+                      <> value "/dev/stdout" <> showDefault)
 
-bang :: Bang
-bang = modes [lexer, parser]
-  &= versionArg [explicit, name "version", summary programInfo]
-  &= summary (programInfo ++ ", " ++ copyright)
-  &= help "A nifty little compiler for a new language"
-  &= helpArg [explicit, name "help", name "h", name "?"]
-  &= program "bang"
- where
-  programInfo = "bang version " ++ showVersion version
-  copyright = "(C) 2016 Adam Wick"
+data BangOperation = Help
+                   | Lex LexerOptions
+ deriving (Show)
 
-getCommand :: IO Bang
-getCommand = cmdArgs bang
+bangOperation :: Parser BangOperation
+bangOperation = subparser $
+  command "help" (pure Help `withInfo` "Describe common commands.") <>
+  command "lex" (parseLex `withInfo` "Lex a file into its component tokens.")
+
+withInfo :: Parser a -> String -> ParserInfo a 
+withInfo opts desc = info (helper <*> opts) (progDesc desc)
+
+data LexerOptions = LexerOptions {
+       lexInputFile :: FilePath
+     }
+ deriving (Show)
+
+parseLex :: Parser BangOperation
+parseLex = Lex <$> parseLexOptions
+
+parseLexOptions :: Parser LexerOptions
+parseLexOptions = LexerOptions <$> argument str (metavar "FILE")
+
+parseOptions :: Parser BangCommand
+parseOptions = BangCommand <$> verboseOption <*> outputFile <*> bangOperation
+
+helpString :: String
+helpString = show (parserHelp (ParserPrefs "" False False True 80) parseOptions)
+
+getCommand :: IO BangCommand
+getCommand = execParser (parseOptions `withInfo` "Run a bang language action.")