Modularized HerbstluftWM in Haskell

   
   
 coding  haskell  herbstluftwm  
 desktop  
Table of Content

This article is one part of a collection. All integrated, one related to another, featured with summary. So we can compare each other quickly.

Tutorial/ Guidance/ Article:

[ Modularized Overview ]  [ BASH ]  [ Perl ]  [ Python ]  [ Ruby ]  [ PHP ]  [ Lua ]  [ Haskell ]

Source Code Directory:

[ BASH ]  [ Perl ]  [ Python ]  [ Ruby ]  [ PHP ]  [ Lua ]  [ Haskell ]

Preface

Goal: Separate Main Flow, Code, and Data.

So anyone can focus to alter special customization in Main Script, without changing the whole stuff.

Reading

Before you jump off to scripting, you might desire to read this overview.

And also this MapM_ tutorial.

It seems to be I’m not the only person who used Haskell with HerbsluftWM.

  • https://hackage.haskell.org/package/hlwm#readme

All The Source Code:

Impatient coder like me, like to open many tab on browser.

Table of Content

1: Directory Structure

Directory Structure has been explained in preface. This figure will explain how it looks in Haskell script directory.

HerbstluftWM: Directory Structure

2: Modularizing in Haskell

Module in Haskell follow rules in identifier naming. And the module filename should also follow these rules.

Declare a module

Haskell module have to explicitly define what to export. Anything exported become public in caller script. And the rest is private to module.

module MyHelper
( hc
, do_config
, set_tags_with_name
, do_panel
) where

Call a module

import MyHelper

3: System Calls

Here we wrap herbstclient system call in a function named hc.

helper.hs

hc :: String -> IO ExitCode
hc arguments = system $ "herbstclient " ++ arguments

autostart.hs

main = do
    -- Read the manual in $ man herbstluftwm
    hc "emit_hook reload"

    -- gap counter
    system $ "echo 35 > /tmp/herbstluftwm-gap"

4: Array: Tag Names and Keys

Is it just me? Or didn’t I do googling hard enough ? I cannot find a way to define array by range in just one line.

config.hs

tag_names = [1..9]
tag_keys  = [1..9] ++ [0]

HerbstluftWM: Tag Status

5: Hash: Color Schemes

Using key-value pairs, a simple data structure.

gmc.hs

colorSchemes :: [(String, String)]
colorSchemes =
    [("white",     "#ffffff")
    ,("black",     "#000000")

    ,("grey50",     "#fafafa")
    ,("grey100",    "#f5f5f5")
    ]

myColor :: String -> String
myColor key = M.findWithDefault "#ffffff" key (fromList colorSchemes)

autostart.hs

main = do
    -- background before wallpaper
    system $ "xsetroot -solid '" ++ myColor "blue500" ++ "'"

View Source File:

Table of Content
[ BASH Color ]  [ Perl Color ]  [ Python Color ]  [ Ruby Color ]  [ PHP Color ]  [ Lua Color ]  [ Haskell Color ]

6: Hash: Config

The Hash in Config is very similar with the colors above. Except that it has string concatenation all over the place.

config.hs

-- Modifier variables
s = "Shift"
c = "Control"
m = "Mod4"
a = "Mod1"

keybinds ::  [Pair]
keybinds =
  -- session
    [(m ++ "-" ++ s ++ "-q", "quit")
    ,(m ++ "-" ++ s ++ "-r", "reload")
    ,(m ++ "-" ++ s ++ "-c", "close")
    ]

This config will be utilized in main script as shown in the following code.

autostart.hs

main = do
    do_config "keybind"   keybinds
    do_config "keybind"   tagskeybinds
    do_config "mousebind" mousebinds
    do_config "attr"      attributes
    do_config "set"       sets
    do_config "rule"      rules

View Source File:

Table of Content
[ BASH Config ]  [ Perl Config ]  [ Python Config ]  [ Ruby Config ]  [ PHP Config ]  [ Lua Config ]  [ Haskell Config ]

7: Processing The Hash Config

This is the heart of this script.

This do-config function has two arguments, the herbstclient command i.e “keybind”, and hash from config.

helper.hs

do_config :: String -> [Pair] -> IO ()
do_config command pairs = do
    -- loop over a hash dictionary of tuples
    mapM_ (\(key, value) -> do 
            hc(command ++ " " ++ key ++ " " ++ value)

            -- uncomment to debug in terminal
            -- putStrLn(command ++ " " ++ key ++ " " ++ value)
          ) pairs

Reading

Anyone new in Haskell, should not get intimidated by Haskell operator. It is just foreach written in Haskell.

I also wrote a tutorial specifically for the function above. I hope this helps.

Debug Herbstclient Command

I do not remove line where I do debug when I made this script, so anyone can use it later, avoid examining blindly. Sometimes strange things happen. Just uncomment the line to see what happened.

            putStrLn(command ++ " " ++ key ++ " " ++ value)

You can see the debugging result in figure below.

HerbstluftWM: Debug Command

View Source File:

Table of Content
[ BASH Helper ]  [ Perl Helper ]  [ Python Helper ]  [ Ruby Helper ]  [ PHP Helper ]  [ Lua Helper ]  [ Haskell Helper ]

8: Setting the Tags

For clarity, I break down the process into some function.

get_indices :: [Int] -> [Int]
get_indices l = [0 .. (length l) - 1]

-- Pattern Matching
keybind_keytag :: Int -> Maybe Int -> IO ()
keybind_keytag index Nothing = do return ()
keybind_keytag index (Just key) = do
        hc("keybind Mod4-" ++ show(key) 
                ++ " use_index '" ++ show(index) ++ "'")
        hc("keybind Mod4-Shift-" ++ show(key) 
                ++ " move_index '" ++ show(index) ++ "'")
        return ()

set_tag :: Int -> IO ()
set_tag index = do
    hc("add '" ++ show(tag_names !! index) ++ "'")

    let key = tag_keys !! index
    keybind_keytag index (Just key)
    
    return ()

set_tags_with_name :: IO ()
set_tags_with_name = do
    hc("rename default '" 
        ++ show (tag_names !! 0) ++ "' 2>/dev/null || true")

    mapM_ set_tag (get_indices tag_names)
    
    return ()

Using lambda syntatic sugar and pattern matching.

helper.hs

set_tags_with_name :: IO ()
set_tags_with_name = do
    hc("rename default '" 
        ++ show (tag_names !! 0) ++ "' 2>/dev/null || true")

    mapM_ (\index -> do
            hc("add '" ++ show(tag_names !! index) ++ "'")
    
            -- uncomment to debug in terminal
            -- putStrLn $ show index

            let key = tag_keys !! index
            case (Just key) of
                Nothing   -> do return()
                Just akey -> do
                    hc("keybind Mod4-" ++ show(akey) 
                        ++ " use_index '" ++ show(index) ++ "'")
                    hc("keybind Mod4-Shift-" ++ show(akey) 
                        ++ " move_index '" ++ show(index) ++ "'")
                    return ()

        ) ([0 .. (length tag_names) - 1]) -- indices

9: Launch the Panel

The panel code is short, but the detail is long. We have to extract value from IO action

  • panelFilename: IO String.

  • listMonitors: IO [String].

do_panel :: IO ()
do_panel = do
    panel <- panelFilename
    monitors <- listMonitors
    
    mapM_ (\monitor -> do
            system(panel ++ " " ++ show(monitor) ++ " &")
          ) monitors

    return ()

panelFilename IO action:

customFilename :: String -> String
customFilename home = home ++ path     where path = "/.config/herbstluftwm/haskell/panel-lemonbar"
    where path = "/.config/herbstluftwm/bash/dzen2/panel.sh"
    
panelFilename :: IO String
panelFilename = do
    home <- getHomeDirectory
    let file = customFilename home

    isExist <- doesFileExist file
    permission <- getPermissions file
    let exec_ok = executable permission
    
    -- need to check for executable permission also
    let panel = if(isExist && exec_ok)
            then file    
            else "/etc/xdg/herbstluftwm/panel.sh"
    
    -- uncomment to debug in terminal
    -- putStrLn panel
    
    return panel

listMonitors IO action:

listMonitors :: IO [String]
listMonitors = do
    (_, Just pipeout, _, _) <- 
        createProcess (proc "herbstclient" ["list_monitors"])
        { std_out = CreatePipe } 

    (_, Just cutout, _, ph)  <- 
        createProcess (proc "cut" ["-d:", "-f1"]) 
        { std_in = UseHandle pipeout, std_out = CreatePipe }
        
    raw <- hGetContents cutout   
    _ <- waitForProcess ph

    -- uncomment to debug in terminal     
    -- putStrLn raw
    let monitors = lines raw  -- or splitOn instead

    return monitors

Yes it is very long compared with BASH/Perl/Python counterpart.

10: Run Baby Run

This is the last part. It is intended to be modified. Everyone has their own personal preferences.

startup.hs

startup_run :: IO ()
startup_run = do
    -- no need to use silent, as the std_err redirected
    let args = ["new_attr", "bool", "my_not_first_autostart"]
    
    (_, _, Just pipeerr, ph) <- 
        createProcess (proc "herbstclient" args)
        { std_err = CreatePipe } 

    capture_err <- hGetContents pipeerr   
    exitcode <- waitForProcess ph

    -- The test may use against, either exitcode or capture_err    
    when (exitcode == ExitSuccess) $ do
     -- non windowed app
        system $ "compton &"
        system $ "dunst &"
        system $ "parcellite &"
        system $ "nitrogen --restore &"
        system $ "mpd &"

     -- windowed app
        system $ "xfce4-terminal &"
        system $ "sleep 1 && firefox &"
        system $ "sleep 2 && geany &"
        system $ "sleep 2 && thunar &"

        return ()

Specific Haskell Advantge

Since the standard eror is redirected, We can use either exitcodo or standard error, to determine whether the application should be launch or not.

View Source File:

Table of Content
[ BASH Startup ]  [ Perl Startup ]  [ Python Startup ]  [ Ruby Startup ]  [ PHP Startup ]  [ Lua Startup ]  [ Haskell Startup ]

11: Putting It All Together

The last part is going to main script and putting it all back together.

Now the flow is clear

Header Part: autostart.hs

import System.Process

import MyGMC
import MyConfig
import MyHelper
import MyStartup

Procedural Part: autostart.hs

main = do
    -- background before wallpaper
    system $ "xsetroot -solid '" ++ myColor "blue500" ++ "'"

    -- Read the manual in $ man herbstluftwm
    hc "emit_hook reload"

    -- gap counter
    system $ "echo 35 > /tmp/herbstluftwm-gap"
    
    -- do not repaint until unlock
    hc "lock"

    -- standard
    hc "keyunbind --all"
    hc "mouseunbind --all"
    hc "unrule -F"

    set_tags_with_name

    -- do hash config
    do_config "keybind"   keybinds
    do_config "keybind"   tagskeybinds
    do_config "mousebind" mousebinds
    do_config "attr"      attributes
    do_config "set"       sets
    do_config "rule"      rules

    -- unlock, just to be sure
    hc "unlock"

    -- launch statusbar panel (e.g. dzen2 or lemonbar)
    do_panel

    -- load on startup
    startup_run

View Source File:

Table of Content
[ BASH autostart ]  [ Perl autostart ]  [ Python autostart ]  [ Ruby autostart ]  [ PHP autostart ]  [ Lua autostart ]  [ Haskell autostart ]

Coming up Next

After the Window Manager, comes the Panel.

Happy Configuring.