diff --git a/lib/XMonad/Internal/Dependency.hs b/lib/XMonad/Internal/Dependency.hs index 8101945..fa270b6 100644 --- a/lib/XMonad/Internal/Dependency.hs +++ b/lib/XMonad/Internal/Dependency.hs @@ -24,8 +24,8 @@ module XMonad.Internal.Dependency , PostPass(..) , Subfeature(..) , SubfeatureRoot - , LogLevel(..) , Msg(..) + , LogLevel(..) -- dependency tree types , Root(..) @@ -101,13 +101,17 @@ module XMonad.Internal.Dependency import Control.Monad.IO.Class import Control.Monad.Identity +import Control.Monad.Reader import Control.Monad.State +import Data.Aeson hiding (Error, Result) +import Data.Aeson.Key import Data.Bifunctor import qualified Data.HashMap.Strict as H import Data.Hashable import Data.List import Data.Maybe +import Data.Yaml import GHC.Generics (Generic) @@ -116,9 +120,11 @@ import DBus.Client import DBus.Internal import qualified DBus.Introspection as I -import System.Directory (findExecutable, readable, writable) +import System.Directory import System.Environment import System.Exit +import System.FilePath +import System.Posix.Files import XMonad.Core (X, io) import XMonad.Internal.IO @@ -135,7 +141,9 @@ import XMonad.Internal.Theme -- | Run feature evaluation(s) with the cache -- Currently there is no easy way to not use this (oh well) withCache :: FIO a -> IO a -withCache x = evalStateT x emptyCache +withCache x = do + p <- getParams + evalStateT (runReaderT x p) emptyCache -- | Execute an Always immediately executeAlways :: Always (IO a) -> FIO a @@ -254,11 +262,11 @@ data Subfeature f = Subfeature , sfLevel :: LogLevel } -type SubfeatureRoot a = Subfeature (Root a) - -- | Loglevel at which feature testing should be reported -- This is currently not used for anything important -data LogLevel = Silent | Error | Warn | Debug deriving (Eq, Show, Ord) +data LogLevel = Silent | Error | Warn | Debug deriving (Eq, Show, Ord, Generic) + +type SubfeatureRoot a = Subfeature (Root a) -- | An action and its dependencies -- May be a plain old monad or be DBus-dependent, in which case a client is @@ -399,18 +407,6 @@ data PostFail = PostFail [Msg] | PostMissing Msg -- that each repeated test without caching would be run in such close succession -- that the results will always be the same. -type FIO a = StateT Cache IO a - -data Cache = Cache - { --cIO :: forall p. Memoizable p => H.HashMap (IODependency p) (Result p) - cIO_ :: H.HashMap IODependency_ Result_ - , cDBus_ :: H.HashMap DBusDependency_ Result_ - , cFont :: H.HashMap String (Result FontBuilder) - } - --- class Memoizable a - -- cache :: a -> - emptyCache :: Cache emptyCache = Cache H.empty H.empty H.empty @@ -447,6 +443,52 @@ memoizeFont f d = do modify (\s -> s { cFont = H.insert d r (cFont s) }) return r +-------------------------------------------------------------------------------- +-- | Configuration + +type FIO a = ReaderT XParams (StateT Cache IO) a + +data XParams = XParams + { xpLogLevel :: LogLevel + } + +defParams :: XParams +defParams = XParams { xpLogLevel = Error } + +data Cache = Cache + { --cIO :: forall p. Memoizable p => H.HashMap (IODependency p) (Result p) + cIO_ :: H.HashMap IODependency_ Result_ + , cDBus_ :: H.HashMap DBusDependency_ Result_ + , cFont :: H.HashMap String (Result FontBuilder) + } + +getParams :: IO XParams +getParams = do + p <- getParamFile + maybe (return defParams) decodeYaml p + where + decodeYaml p = either (\e -> print e >> return defParams) return + =<< decodeFileEither p + +getParamFile :: IO (Maybe FilePath) +getParamFile = do + e <- lookupEnv "XDG_CONFIG_HOME" + parent <- case e of + Nothing -> fallback + Just path + | isRelative path -> fallback + | otherwise -> return path + let full = parent "xmonad.yml" + (\x -> if x then Just full else Nothing) <$> fileExist full + where + fallback = ( ".config") <$> getHomeDirectory + +instance FromJSON XParams where + parseJSON = withObject "parameters" $ \o -> XParams + <$> o .: fromString "loglevel" + +instance FromJSON LogLevel + -------------------------------------------------------------------------------- -- | Testing pipeline diff --git a/my-xmonad.cabal b/my-xmonad.cabal index a8475fe..10d9230 100644 --- a/my-xmonad.cabal +++ b/my-xmonad.cabal @@ -55,6 +55,7 @@ library , xmonad >= 0.13 , xmonad-contrib >= 0.13 , aeson >= 2.0.3.0 + , yaml >=0.11.8.0 , unordered-containers >= 0.2.16.0 , hashable >= 1.3.5.0 , xml >= 1.3.14