diff options
Diffstat (limited to 'src')
| -rw-r--r-- | src/Main.hs | 5 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Keys.hs | 16 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Keys/Wml.hs | 8 | ||||
| -rw-r--r-- | src/Rahm/Desktop/Logger.hs | 48 | ||||
| -rw-r--r-- | src/Rahm/Desktop/MouseMotion.hs | 4 |
5 files changed, 49 insertions, 32 deletions
diff --git a/src/Main.hs b/src/Main.hs index 5c1a4e0..17f6207 100644 --- a/src/Main.hs +++ b/src/Main.hs @@ -29,6 +29,7 @@ import qualified XMonad as X import qualified XMonad.StackSet as W main = do + putStrLn "Welcome To RDE!" -- Execute some commands. homeDir <- getHomeDirectory @@ -80,8 +81,8 @@ main = do changeHook :: Location -> Location -> X () -changeHook l1 l2 = do - logs $ printf "Change %s -> %s" (show l1) (show l2) +changeHook l1 l2 = + logs Info "Change %s -> %s" (show l1) (show l2) doCenterFloat :: ManageHook doCenterFloat = diff --git a/src/Rahm/Desktop/Keys.hs b/src/Rahm/Desktop/Keys.hs index a453df1..c8abbf0 100644 --- a/src/Rahm/Desktop/Keys.hs +++ b/src/Rahm/Desktop/Keys.hs @@ -172,7 +172,7 @@ keymap = runKeys $ do -- things all for BS security theater, but I guess there might be some way -- to do this via XTest? shiftMod $ forAllWindows $ \w -> do - logs $ "Try send to " ++ show w + logs Info "Try send to %s" (show w) sendKey (0, xK_a) w justMod $ @@ -185,7 +185,7 @@ keymap = runKeys $ do justMod $ doc "Print this documentation." $ - logs (documentation (keymap config)) + (logs Info "%s" (documentation (keymap config)) :: X ()) bind xK_F10 $ do justMod playPauseDoc @@ -221,7 +221,7 @@ keymap = runKeys $ do withScreen W.shift idx altgrMod $ - logs "Test altgr" + (logs Info "Test altgr" :: X ()) bind xK_bracketright $ do justMod $ @@ -391,7 +391,7 @@ keymap = runKeys $ do bind xK_q $ (justMod -|- noMod) $ doc "EXPERIMENTAL: Move mouse to control media." $ - mouseRotateMotion (logs "CW") (logs "CCW") + mouseRotateMotion (logs Info "CW") (logs Info "CCW") bind xK_r $ do justMod $ doc "Run a command via Rofi" runDMenu @@ -516,7 +516,7 @@ keymap = runKeys $ do doc "Go to the prior window in the history" historyBack bind xK_t $ do - (justMod -|- noMod) $ logs "Test Log" + (justMod -|- noMod) $ (logs Info "Test Log" :: X ()) -- bind xK_n $ do -- (justMod -|- noMod) $ @@ -845,7 +845,7 @@ windowSpecificBindings config = do bind xK_F2 $ -- Experimental. - noMod $ logs "This is a test" + noMod $ (logs Info "This is a test" :: X ()) -- Add a binding to xev as a test. configureIf (title =? "Event Tester") $ @@ -878,9 +878,9 @@ windowBindings xconfig = map <- execWriterT $ windowSpecificBindings xconfig w <- ask - liftX $ logs $ printf "For Window: %s" (show w) + liftX $ logs Info "For Window: %s" (show w) forM_ (Map.toList map) $ \(key, action) -> do - liftX $ logs $ printf " -- remap: %s" (show key) + liftX $ logs Info " -- remap: %s" (show key) remapKey key action applyKeys :: XConfig l -> IO (XConfig l) diff --git a/src/Rahm/Desktop/Keys/Wml.hs b/src/Rahm/Desktop/Keys/Wml.hs index 7659a7d..dd82922 100644 --- a/src/Rahm/Desktop/Keys/Wml.hs +++ b/src/Rahm/Desktop/Keys/Wml.hs @@ -107,12 +107,12 @@ alternateWorkspace :: Workspace alternateWorkspace = Workspace { moveLocationToWorkspaceFn = \l@(Location _ maybeWin) -> do - logs $ "Moving Location: " ++ show l + logs Info "Moving Location: %s" (show l) case maybeWin of Nothing -> return () Just win -> do alter <- getAlternateWorkspace win - logs $ printf "Moving %s to %s" (show win) (show alter) + logs Info "Moving %s to %s" (show win) (show alter) mapM_ (moveLocationToWorkspace l) alter , gotoWorkspaceFn = do @@ -297,7 +297,7 @@ readNextLocationSet = mapM windowLocation =<< MaybeT askWindowId (_, _, "%") -> fromMaybeTX $ do ret <- mapM windowLocation =<< lift (withWindowSet (return . sortOn Down . W.allWindows)) - lift $ logs $ "allWindows " ++ intercalate "\n" (map show ret) + lift $ logs Info "allWindows %s" (intercalate "\n" (map show ret)) return ret (_, _, s) | s == "\t" || s == "@" || s == "\n" -> (mt . windowsInWorkspace . workspaceName) =<< readNextWorkspace @@ -329,7 +329,7 @@ readNextLocationSet = return $ filter (`elem` l2) l1 (mask, keysym, _) -> do macro <- (MaybeT . fromX) (Map.lookup (mask, keysym) . windowsetMacros <$> XS.get) - lift $ fromX $ logs $ "Executing Macro: " ++ show macro + lift $ fromX $ logs Info "Executing Macro: %s" (show macro) fromMaybeTX $ locationSetForKeysT macro where mt :: (KeyFeeder m) => X a -> MaybeT m a diff --git a/src/Rahm/Desktop/Logger.hs b/src/Rahm/Desktop/Logger.hs index c73942f..3da70d1 100644 --- a/src/Rahm/Desktop/Logger.hs +++ b/src/Rahm/Desktop/Logger.hs @@ -1,32 +1,48 @@ module Rahm.Desktop.Logger where +import Control.Monad (when) import XMonad import qualified XMonad.Util.ExtensibleState as XS import System.IO import Rahm.Desktop.NoPersist +import Text.Printf + +data LogLevel = Trace | Debug | Info | Warn | Error | Fatal + deriving (Show, Read, Ord, Eq, Enum) newtype LoggerState = LoggerState { - logHandle :: Maybe (NoPersist Handle) - } + logLevel :: LogLevel + } deriving (Show, Read, Eq) instance ExtensionClass LoggerState where - initialValue = LoggerState Nothing + initialValue = LoggerState Info + extensionType = PersistentExtension + +class (PrintfType (Printf t)) => LoggerType t where + type EndResult t :: * + type Printf t :: * + + gp :: (String -> EndResult t) -> Printf t -> t + +instance (PrintfArg a, LoggerType b) => LoggerType (a -> b) where + type EndResult (a -> b) = EndResult b + type Printf (a -> b) = a -> Printf b + + gp f g a = gp f (g a) -logs :: String -> X () -logs s = do - LoggerState handle' <- XS.get +instance (a ~ ()) => LoggerType (X a) where + type EndResult (X a) = X () + type Printf (X a) = String - handle <- - case handle' of - Nothing -> do - handle <- io $ openFile "/tmp/xmonad.log" AppendMode - XS.put $ LoggerState $ Just $ NoPersist handle - return handle + gp fn str = fn str - Just (NoPersist h) -> return h +logs :: (LoggerType r, EndResult r ~ X ()) => LogLevel -> String -> r +logs ll fmt = gp (\s -> do + LoggerState ll' <- XS.get + when (ll >= ll') $ + io $ putStrLn ("[" ++ show ll ++ "] " ++ s)) (printf fmt) - io $ do - hPutStrLn handle s - hFlush handle +test :: X () +test = logs Info "Test %s" diff --git a/src/Rahm/Desktop/MouseMotion.hs b/src/Rahm/Desktop/MouseMotion.hs index b5e8874..cacb52f 100644 --- a/src/Rahm/Desktop/MouseMotion.hs +++ b/src/Rahm/Desktop/MouseMotion.hs @@ -39,7 +39,7 @@ motion = MouseMotionM $ do ev <- nextMotionOrButton case ev of Right button -> do - logs ("Button " ++ show button) + logs Info "Button %s" (show button) return Nothing Left motion -> return (Just $ uncurry V2 motion) @@ -93,4 +93,4 @@ mouseRotateMotion clockWise counterClockwise = execMouseMotionM doMouse where doMouse = forever $ do v <- motion - liftMouseMotionM $ logs $ "Motion: " ++ show v + liftMouseMotionM $ logs Info "Motion: %s" (show v) |