From 8e2240c87c4d1c3ac79e40570eaa2db92ba2dbb8 Mon Sep 17 00:00:00 2001
From: Sam Tay <sam.chong.tay@gmail.com>
Date: Sun, 2 Jul 2017 17:47:21 -0400
Subject: [PATCH] Add cli opts for score, level, and restricting unicode

---
 app/Main.hs    | 76 +++++++++++++++++++++++++++++++++++++++++++++-----
 src/UI/Game.hs |  4 +--
 tetris.cabal   |  1 +
 3 files changed, 72 insertions(+), 9 deletions(-)

diff --git a/app/Main.hs b/app/Main.hs
index 912b011..7ab8a23 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -1,15 +1,77 @@
 module Main where
 
-import Tetris (Game)
+import Control.Monad (when)
+import Data.Maybe (fromMaybe)
+import Data.Monoid ((<>))
+import System.Exit (exitSuccess)
 
+import Tetris (Game(..))
 import UI.PickLevel (pickLevel)
 import UI.Game (playGame)
 
--- | TODO possibly allow a small number of CLI args,
--- like tetris --high-score
-main :: IO ()
-main = pickLevel >>= playGame >>= handleEndGame
+import Options.Applicative
 
--- | TODO possibly save high score (with 3 initials? kick it real old school?) to ~/.tetris
-handleEndGame :: Game -> IO ()
+data Opts = Opts
+  { hardDrop :: Maybe HardDropOpt
+  , level    :: Maybe Int
+  , score    :: Bool
+  } deriving (Show) -- TODO remove
+
+data HardDropOpt = AsciiOnly | CustomChars String deriving (Show) -- TODO remove
+
+opts :: Parser Opts
+opts = Opts
+  <$> optional hardDropOpt
+  <*> optional (option auto
+    (  long "level"
+    <> short 'l'
+    <> metavar "LEVEL"
+    <> help "Specify level (unspecified results in prompt)" ))
+  <*> switch
+    (  long "high-score"
+    <> help "Print high score and exit" )
+
+
+hardDropOpt :: Parser HardDropOpt
+hardDropOpt = asciiOpt <|> custOpt
+  where
+    asciiOpt = flag' AsciiOnly
+      (  long "ascii-only"
+      <> short 'a'
+      <> help "Use '[]' as hard drop preview cell instead of '◤◢'" )
+    custOpt = CustomChars <$> option twoChar
+      (  long "preview-chars"
+      <> short 'p'
+      <> metavar "CHARS"
+      <> help "Custom two character preview cell" )
+
+fullopts :: ParserInfo Opts
+fullopts = info (helper <*> opts)
+  (  fullDesc
+  <> header "tetris - the iconic game right in your terminal" )
+
+twoChar :: ReadM String
+twoChar = do
+  cs <- str
+  if length cs /= 2
+     then readerError "Preview must be two characters long"
+     else return cs
+
+hdOptStr :: HardDropOpt -> String
+hdOptStr AsciiOnly = "[]"
+hdOptStr (CustomChars s) = s
+
+main :: IO ()
+main = do
+  (Opts hd ml hs) <- execParser fullopts          -- get CLI opts/args
+  let mp = hdOptStr <$> hd                        -- determine hard drop preview cell
+  when hs (getHighScore >>= print >> exitSuccess) -- show high score and exit
+  l <- fromMaybe pickLevel (return <$> ml)        -- pick level prompt if necessary
+  g <- playGame l mp                              -- play game
+  handleEndGame (_score g)                        -- save & print score
+
+handleEndGame :: Int -> IO ()
 handleEndGame = const $ return ()
+
+getHighScore :: IO Int
+getHighScore = error "Not yet implemented"
diff --git a/src/UI/Game.hs b/src/UI/Game.hs
index be6f613..ee9bf4e 100644
--- a/src/UI/Game.hs
+++ b/src/UI/Game.hs
@@ -41,8 +41,8 @@ app = App { appDraw = drawUI
           , appAttrMap = const theMap
           }
 
-playGame :: Int -> IO Game
-playGame lvl = do
+playGame :: Int -> Maybe String -> IO Game
+playGame lvl _ = do
   let delay = levelToDelay lvl
   chan <- newBChan 10
   forkIO $ forever $ do
diff --git a/tetris.cabal b/tetris.cabal
index c4e4c90..3a0c1e6 100644
--- a/tetris.cabal
+++ b/tetris.cabal
@@ -33,6 +33,7 @@ executable tetris
   main-is:             Main.hs
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   build-depends:       base >= 4.7 && < 5
+                     , optparse-applicative
                      , tetris
   default-language:    Haskell2010