xanadu - src/Style.hs

-rw-r--r-- src/Style.hs
      1 {-# LANGUAGE OverloadedStrings #-}
      2 
      3 module Style (
      4     initStyle
      5 ) where
      6 
      7 import Control.Monad (when)
      8 import System.Directory (doesFileExist, getHomeDirectory)
      9 import System.Environment (lookupEnv)
     10 import System.FilePath ((</>))
     11 
     12 import qualified GI.Gio as Gio
     13 import qualified GI.Gtk as Gtk
     14 
     15 initStyle :: Gtk.ApplicationWindow -> IO ()
     16 initStyle win = do
     17     setTheme win
     18     addCSS win
     19 
     20 setTheme :: Gtk.ApplicationWindow -> IO ()
     21 setTheme win = do
     22     screen <- Gtk.windowGetScreen win
     23     settings <- Gtk.settingsGetForScreen screen
     24     Gtk.setSettingsGtkApplicationPreferDarkTheme settings True
     25 
     26 getConfigDir :: IO FilePath
     27 getConfigDir = do
     28     fromEnv <- lookupEnv "XDG_CONFIG_HOME"
     29     case fromEnv of
     30         Nothing -> (<> "/.config/xanadu") <$> getHomeDirectory
     31         Just "" -> (<> "/.config/xanadu") <$> getHomeDirectory
     32         Just path -> return $ path </> "/xanadu"
     33 
     34 addCSS :: Gtk.ApplicationWindow -> IO ()
     35 addCSS win = do
     36     screen <- Gtk.windowGetScreen win
     37     cssProvider <- Gtk.cssProviderNew
     38     Gtk.styleContextAddProviderForScreen screen cssProvider 800
     39 
     40     -- Default CSS
     41     Gtk.cssProviderLoadFromData cssProvider "window,iconview { background-color: transparent; }"
     42 
     43     -- Custom CSS
     44     configDir <- getConfigDir
     45     let file = configDir </> "style.css"
     46     hasFile <- doesFileExist file
     47     when hasFile $ Gtk.cssProviderLoadFromFile cssProvider =<< Gio.fileNewForPath file
     48