commit
49b909e4b1
|
@ -22,6 +22,7 @@ description: Please see the README on GitHub at <https://github.com/jlam
|
||||||
dependencies:
|
dependencies:
|
||||||
- base >= 4.7 && < 5
|
- base >= 4.7 && < 5
|
||||||
- aeson >= 1.4.4.0 && < 1.5
|
- aeson >= 1.4.4.0 && < 1.5
|
||||||
|
- easy-file >= 0.2.2 && < 0.3
|
||||||
- extra >= 1.6.17 && < 1.7
|
- extra >= 1.6.17 && < 1.7
|
||||||
- microlens-th >= 0.4.2.3 && < 0.5
|
- microlens-th >= 0.4.2.3 && < 0.5
|
||||||
- ncurses >= 0.2.16 && < 0.3
|
- ncurses >= 0.2.16 && < 0.3
|
||||||
|
|
|
@ -19,15 +19,23 @@ along with this program. If not, see <https://www.gnu.org/licenses/>.
|
||||||
|
|
||||||
-}
|
-}
|
||||||
|
|
||||||
|
{-# LANGUAGE ScopedTypeVariables #-}
|
||||||
|
|
||||||
module Mtlstats (initState, mainLoop) where
|
module Mtlstats (initState, mainLoop) where
|
||||||
|
|
||||||
|
import Control.Exception (IOException, catch)
|
||||||
import Control.Monad (void)
|
import Control.Monad (void)
|
||||||
import Control.Monad.Extra (whenM)
|
import Control.Monad.Extra (whenM)
|
||||||
|
import Control.Monad.IO.Class (liftIO)
|
||||||
import Control.Monad.Trans.Class (lift)
|
import Control.Monad.Trans.Class (lift)
|
||||||
import Control.Monad.Trans.State (get, gets)
|
import Control.Monad.Trans.State (get, gets)
|
||||||
import Data.Maybe (fromJust)
|
import Data.Aeson (decodeFileStrict)
|
||||||
|
import Data.Maybe (fromJust, fromMaybe)
|
||||||
|
import Lens.Micro ((&), (.~))
|
||||||
|
import System.EasyFile (getAppUserDataDirectory, (</>))
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
|
import Mtlstats.Config
|
||||||
import Mtlstats.Control
|
import Mtlstats.Control
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
|
|
||||||
|
@ -36,7 +44,15 @@ initState :: C.Curses ProgState
|
||||||
initState = do
|
initState = do
|
||||||
C.setEcho False
|
C.setEcho False
|
||||||
void $ C.setCursorMode C.CursorInvisible
|
void $ C.setCursorMode C.CursorInvisible
|
||||||
return newProgState
|
db <- liftIO $ do
|
||||||
|
dir <- getAppUserDataDirectory appName
|
||||||
|
let dbFile = dir </> dbFname
|
||||||
|
fromMaybe newDatabase <$> catch
|
||||||
|
(decodeFileStrict dbFile)
|
||||||
|
(\(_ :: IOException) -> return Nothing)
|
||||||
|
return
|
||||||
|
$ newProgState
|
||||||
|
& database .~ db
|
||||||
|
|
||||||
-- | Main program loop
|
-- | Main program loop
|
||||||
mainLoop :: Action ()
|
mainLoop :: Action ()
|
||||||
|
|
|
@ -28,3 +28,11 @@ myTeam = "MONTREAL"
|
||||||
-- | The maximum number of function keys
|
-- | The maximum number of function keys
|
||||||
maxFunKeys :: Int
|
maxFunKeys :: Int
|
||||||
maxFunKeys = 9
|
maxFunKeys = 9
|
||||||
|
|
||||||
|
-- | The application name
|
||||||
|
appName :: String
|
||||||
|
appName = "mtlstats"
|
||||||
|
|
||||||
|
-- | The database filename
|
||||||
|
dbFname :: String
|
||||||
|
dbFname = "database.json"
|
||||||
|
|
|
@ -30,12 +30,21 @@ module Mtlstats.Menu (
|
||||||
gameTypeMenu
|
gameTypeMenu
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Control.Monad.Trans.State (modify)
|
import Control.Monad.IO.Class (liftIO)
|
||||||
|
import Control.Monad.Trans.State (gets, modify)
|
||||||
|
import Data.Aeson (encodeFile)
|
||||||
import Data.Char (toUpper)
|
import Data.Char (toUpper)
|
||||||
import Lens.Micro ((^.), (.~), (?~))
|
import Lens.Micro ((^.), (.~), (?~))
|
||||||
|
import Lens.Micro.Extras (view)
|
||||||
|
import System.EasyFile
|
||||||
|
( createDirectoryIfMissing
|
||||||
|
, getAppUserDataDirectory
|
||||||
|
, (</>)
|
||||||
|
)
|
||||||
import qualified UI.NCurses as C
|
import qualified UI.NCurses as C
|
||||||
|
|
||||||
import Mtlstats.Actions
|
import Mtlstats.Actions
|
||||||
|
import Mtlstats.Config
|
||||||
import Mtlstats.Types
|
import Mtlstats.Types
|
||||||
import Mtlstats.Types.Menu
|
import Mtlstats.Types.Menu
|
||||||
|
|
||||||
|
@ -62,7 +71,13 @@ mainMenu = Menu "*** MAIN MENU ***" True
|
||||||
modify startNewGame >> return True
|
modify startNewGame >> return True
|
||||||
, MenuItem '3' "Create Player" $
|
, MenuItem '3' "Create Player" $
|
||||||
modify createPlayer >> return True
|
modify createPlayer >> return True
|
||||||
, MenuItem '4' "Exit" $
|
, MenuItem '4' "Exit" $ do
|
||||||
|
db <- gets $ view database
|
||||||
|
liftIO $ do
|
||||||
|
dir <- getAppUserDataDirectory appName
|
||||||
|
let dbFile = dir </> dbFname
|
||||||
|
createDirectoryIfMissing True dir
|
||||||
|
encodeFile dbFile db
|
||||||
return False
|
return False
|
||||||
]
|
]
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user