Keep track of highest score and congratulate player

app/Main.hs

@@ -4,20 +4,25 @@ import Control.Monad (when)
 import Data.Maybe (fromMaybe)
 import Data.Monoid ((<>))
 import System.Exit (exitSuccess)
+import System.IO (readFile, writeFile)
+import Text.Read (readMaybe)
 
 import Tetris (Game(..))
 import UI.PickLevel (pickLevel)
 import UI.Game (playGame)
 
 import Options.Applicative
+import qualified System.Directory as D
+import System.FilePath ((</>))
+import qualified System.FilePath as F
 
 data Opts = Opts
   { hardDrop :: Maybe HardDropOpt
   , level    :: Maybe Int
   , score    :: Bool
-  } deriving (Show) -- TODO remove
+  }
 
-data HardDropOpt = AsciiOnly | CustomChars String deriving (Show) -- TODO remove
+data HardDropOpt = AsciiOnly | CustomChars String
 
 opts :: Parser Opts
 opts = Opts
@@ -31,7 +36,6 @@ opts = Opts
     (  long "high-score"
     <> help "Print high score and exit" )
 
-
 hardDropOpt :: Parser HardDropOpt
 hardDropOpt = asciiOpt <|> custOpt
   where
@@ -65,13 +69,42 @@ 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
+  when hs (getHighScore >>= printM >> 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 ()
+handleEndGame s = do
+  mhs <- getHighScore
+  case mhs of
+    Nothing -> newHighScore
+    Just hs -> if s <= hs then justShowScore else newHighScore
+  where
+    justShowScore = putStrLn $ "Your final score: " ++ show s
+    newHighScore = do
+      putStrLn $ "Congrats! You just got the new highest score: " ++ show s
+      setHighScore s
 
-getHighScore :: IO Int
-getHighScore = error "Not yet implemented"
+printM :: Show a => Maybe a -> IO ()
+printM Nothing  = putStrLn "None"
+printM (Just s) = print s
+
+getHighScore :: IO (Maybe Int)
+getHighScore = do
+  lb <- getLeaderboardFile
+  exists <- D.doesFileExist lb
+  if exists
+     then readMaybe <$> readFile lb
+     else return Nothing
+
+setHighScore :: Int -> IO ()
+setHighScore s = do
+  lb <- getLeaderboardFile
+  writeFile lb (show s)
+
+getLeaderboardFile :: IO FilePath
+getLeaderboardFile = do
+  xdg <- D.getXdgDirectory D.XdgData "tetris"
+  D.createDirectoryIfMissing True xdg
+  return (xdg </> "leaderboard")

tetris.cabal

@@ -33,6 +33,8 @@ executable tetris
   main-is:             Main.hs
   ghc-options:         -threaded -rtsopts -with-rtsopts=-N
   build-depends:       base >= 4.7 && < 5
+                     , directory
+                     , filepath
                      , optparse-applicative
                      , tetris
   default-language:    Haskell2010