module Hbro.Boot (hbro) where -- {{{ Imports import Hbro.Config as Config import Hbro.Core as Core import Hbro.Dyre as Dyre import Hbro.Error import Hbro.Gui as Gui import Hbro.Hooks as Hooks import Hbro.IPC as IPC (routine) import Hbro.K as K import Hbro.Options as Options import Hbro.Signals as Signals import Hbro.Logger import Hbro.Prelude import Hbro.Webkit.WebSettings as Settings import Control.Concurrent.Async.Lifted import Control.Lens hiding((??)) import Control.Monad.Reader hiding(guard, mapM_, msum, when) import Filesystem import Graphics.UI.Gtk.General.General as Gtk import Paths_hbro import System.Posix.Signals import System.ZMQ4.Monadic (runZMQ) -- }}} -- | Main function to call in the configuration file (cf file @Hbro/Main.hs@). hbro :: K () -> IO () hbro setup = void . runMaybeT $ do options <- parseOptions Dyre.wrap (options^.dyreModeL) (\x -> withAsyncBound guiThread (mainThread x)) (setup, options) -- | Gtk main loop thread. guiThread :: IO () guiThread = do async $ do installHandler sigINT (Catch onInterrupt) Nothing installHandler sigTERM (Catch onInterrupt) Nothing initGUI >> mainGUI debugM "hbro.main" "GUI thread correctly exited." where onInterrupt = logInterrupt >> gAsync mainQuit logInterrupt = infoM "hbro.main" "Received interrupt signal." mainThread :: (ControlIO m) => (K (), CliOptions) -> Async (StM IO ()) -> m () mainThread (customSetup, options) uiThread = logErrors_ $ do -- Signals signals <- Signals.initialize hooks <- Hooks.initialize -- GUI uiFiles <- getUIFiles options gui <- asum $ map Gui.initialize uiFiles attachGuiSignals gui signals -- K monad globalStatus <- K.init gui hooks signals -- IPC socketURI <- getSocketURI options io . (`runReaderT` globalStatus) . runExceptT $ do resetKeyBindings Settings.resetAll lift customSetup debugM "hbro.boot" . ("Start-up configuration: \n" ++) . describe =<< Config.get id logErrors_ $ maybe goHome load (options^.startURIL) io . withAsyncList (Hooks.routines globalStatus signals hooks) $ \_ -> do withAsync (runZMQ $ IPC.routine socketURI (signals^._ipcSignals)) $ \_ -> wait uiThread debugM "hbro.main" "All threads correctly exited." -- | Return the list of available UI files (from configuration and package) getUIFiles :: (BaseIO m) => CliOptions -> m [FilePath] getUIFiles options = do fileFromConfig <- getAppConfigDirectory "hbro" >/> "ui.xml" fileFromPackage <- fpFromText . pack <$> (io $ getDataFileName "examples/ui.xml") return $ catMaybes [options^.uiFileL, Just fileFromConfig, Just fileFromPackage]