hexmino-0.1.0.0: src/Score.hs
module Score where
import Text.Printf (printf)
import Data.List (intercalate, sort)
import Data.Char (isLetter)
import qualified System.Directory as Dir
import System.FilePath ((</>))
data Score = Score {player :: String, level :: Level, time :: Float} deriving (Show, Read, Eq)
data Level = Beginner | Average | Expert deriving (Show, Read, Eq, Enum, Bounded)
type Leaderboard = [Score]
instance Ord Score where
compare sc1 sc2
| level sc1 /= level sc2 = compare (level sc1) (level sc2)
| otherwise = compare (time sc1) (time sc2)
instance Ord Level where
compare lv1 lv2 = compare (fromEnum lv2) (fromEnum lv1)
-- creation
readPlayer :: IO Score
readPlayer = do
dataDir <- dataDirectory
let filePath = dataDir </> "player"
exists <- Dir.doesFileExist filePath
if exists then
read <$> readFile filePath
else
return $ Score {player = "PAS", level = Beginner, time = 0}
readTopTen :: IO Leaderboard
readTopTen = take 10 <$> readLeaderboard
-- manipulation
clearTime :: Score -> Score
clearTime score = score {time = 0}
delFromName :: Score -> Score
delFromName score = score {player = init $ player score}
addToName :: Char -> Score -> Score
addToName c score
| isLetter c = score {player = take 2 (player score) ++ [c]}
| otherwise = score
submit :: Score -> IO Leaderboard
submit score = do
dataDir <- dataDirectory
let playerPath = dataDir </> "player"
leaderPath = dataDir </> "leaderboard"
newLeaderPath = dataDir </> "leaderboard.new"
writeFile playerPath . show $ clearTime score
leaders <- readLeaderboard
let newLeaders = sort (score:leaders)
writeFile newLeaderPath . unlines $ map show newLeaders
Dir.renameFile newLeaderPath leaderPath
return $ take 10 newLeaders
-- persistency
dataDirectory :: IO FilePath
dataDirectory = do
dataDir <- Dir.getXdgDirectory Dir.XdgData "hexmino"
Dir.createDirectoryIfMissing True dataDir
return dataDir
readLeaderboard :: IO Leaderboard
readLeaderboard = do
dataDir <- dataDirectory
let filePath = dataDir </> "leaderboard"
exists <- Dir.doesFileExist filePath
if exists then do
info <- readFile filePath
let (name:lvl:_) = words info
map read . lines <$> readFile filePath
else
return [Score {player = "PAS", level = Expert, time = 2520}]
-- stepping
step :: Float -> Score -> Score
step secs score = score {time = secs + time score}
-- utility
display :: Score -> String
display score = unwords [
player score,
secsToString $ time score,
levelShort $ level score
]
levelNum :: Score -> Int
levelNum = (1+) . fromEnum . level
toNextLevel :: Score -> Score
toNextLevel score
| level score == maxBound = score
| otherwise = score {level = succ $ level score}
toPreviousLevel :: Score -> Score
toPreviousLevel score
| level score == minBound = score
| otherwise = score {level = pred $ level score}
levelShort :: Level -> String
levelShort lvl = case lvl of
Beginner -> "B"
Average -> "A"
Expert -> "X"
showTime :: Score -> String
showTime = secsToString . time
secsToString :: Float -> String
secsToString secs = intercalate "/" vals
where
s = floor secs :: Int
vals = map (printf "%02d" . (`mod` 60)) [s `div` 3600, s `div` 60, s]
isMinLevel :: Level -> Bool
isMinLevel lvl = lvl == minBound
isMaxLevel :: Level -> Bool
isMaxLevel lvl = lvl == maxBound