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