packages feed

zwirn-0.2.3.1: app/zwirnmill/Session.hs

module Session where

import Brick (EventM)
import Brick.Main (halt)
import Conferer (fetch, mkConfig')
import Conferer.FromConfig (DefaultConfig (..), FromConfig (..), fetchFromConfig, (/.))
import qualified Conferer.Source.Yaml as Yaml
import Control.Monad (unless)
import Control.Monad.RWS
import Data.Maybe (fromMaybe)
import Data.Yaml (ToJSON (..), encodeFile, object, (.=))
import System.Directory.OsPath (XdgDirectory (..), createDirectoryIfMissing, doesFileExist, getXdgDirectory)
import System.OsPath (OsPath, decodeFS, decodeUtf, encodeUtf, (</>))
import UI.Config
import UI.Core (AppState (..), Name)

newtype SessionState = SessionState
  { windowState :: [WindowConfig]
  }

instance ToJSON SessionState where
  toJSON (SessionState wc) = object ["windows" .= toJSON wc]

instance FromConfig SessionState where
  fromConfig key configSource = do
    wins <- fetchFromConfig (key /. "windows") configSource
    return $ SessionState $ fromMaybe configDef wins

instance DefaultConfig SessionState where
  configDef = SessionState configDef

getStatePath :: IO OsPath
getStatePath = do
  appname <- encodeUtf "zwirnmill"
  configname <- encodeUtf "session.state"
  configDirPath <- getXdgDirectory XdgState appname
  let path = configDirPath </> configname
  createDirectoryIfMissing True configDirPath
  return path

getSessionState :: IO SessionState
getSessionState = do
  path <- getStatePath
  exists <- doesFileExist path
  unless exists encodeDefaultSessionState
  decoded <- decodeUtf path
  conf <-
    mkConfig'
      []
      [ Yaml.fromFilePath decoded
      ]
  fetch conf

encodeDefaultSessionState :: IO ()
encodeDefaultSessionState = encodeSessionState configDef

encodeSessionState :: SessionState -> IO ()
encodeSessionState ss = do
  path <- getStatePath
  strp <- decodeFS path
  encodeFile strp $ toJSON ss

saveWindowState :: EventM Name AppState ()
saveWindowState = do
  ws <- gets asWindows
  liftIO $ encodeSessionState (SessionState (configFromWindowMap ws))

quitEvent :: EventM Name AppState ()
quitEvent = saveWindowState >> halt