bluetile-0.5: src/Main.hs

----------------------------------------------------------------------------
-- |
-- Module      :  Main
-- Copyright   :  (c) Jan Vornberger 2009
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  jan.vornberger@informatik.uni-oldenburg.de
-- Stability   :  unstable
-- Portability :  not portable
--
-- Bluetile - full-featured tiling for the GNOME desktop environment
--
-----------------------------------------------------------------------------

module Main (main) where

import XMonad
import XMonad.Util.Run (spawnPipe)
import XMonad.Util.Replace

import BluetileDock
import Config
import ConfigParser

import System.Environment
import System.FilePath
import System.Directory
import Control.Monad

import Paths_bluetile
import Data.Version(showVersion)

-- | The entry point into bluetile. Just launch with the default
-- configuration. Compiling a custom configuration is not supported for now.
main :: IO ()
main = do
    -- process arguments
    args <- getArgs
    case args of
        []                    -> launch
        ("--resume":_)        -> launch
        ["--help"]            -> usage
        ["--list-identifiers"] -> displayIdentifiers
        ["--restart"]         -> sendRestart >> return ()
        ["--version"]         -> putStrLn ("bluetile " ++ showVersion version)
        _                     -> fail "unrecognized flags"

launch :: IO ()
launch = do
    putStrLn "Welcome to Bluetile! The window manager is now attempting to start up."
    putStrLn "Information: Two helper applications should appear (Bluetile's dock and"
    putStrLn "a greeting screen). However, even if you see these applications, the actual"
    putStrLn "window manager might still have failed to start. Make sure to check the output"
    putStrLn "below for any errors and have a look at the window decorations, to be sure,"
    putStrLn "that Bluetile started successfully. Happy tiling!"
    putStrLn ""

    -- check if configuration present
    home <- getEnv "HOME"
    let userConfig = home </> ".bluetilerc"
    dataDir <- getDataDir
    let systemConfig = dataDir </> "etc" </> "bluetilerc"
    let userConfigTemplate = dataDir </> "etc" </> "bluetilerc_user_template"

    userConfigPresent <- doesFileExist userConfig
    unless (userConfigPresent) $ copyFile userConfigTemplate userConfig

    -- read configuration
    bluetilerc <- parseConfigFile systemConfig userConfig
    let xmonadConfig = createXMonadConfig bluetilerc

    -- start docks and greeting screen
    libexecDir <- getLibexecDir
    xmonadConfig' <- case (startDockBRC bluetilerc) of
                        True -> do
                            dockHandle <- spawnPipe $ libexecDir </> "bluetiledock"
                            return xmonadConfig { logHook = logHook xmonadConfig >> bluetileDock dockHandle }
                        False -> return xmonadConfig
    spawnPipe $ libexecDir </> "bluetilegreet"

    replace
    xmonad xmonadConfig'

usage :: IO ()
usage = do
    self <- getProgName
    putStr . unlines $
        concat ["Usage: ", self, " [OPTION]"] :
        "Options:" :
        "  --help                       Print this message" :
        "  --version                    Print the version number" :
        "  --list-identifiers           Print modifiers and keys that can be used in the configuration" :
        "  --restart                    Request a running Bluetile process to restart" :
        []

sendRestart :: IO ()
sendRestart = do
    dpy <- openDisplay ""
    rw <- rootWindow dpy $ defaultScreen dpy
    a <- internAtom dpy "XMONAD_COMMAND" False
    allocaXEvent $ \e -> do
        setEventType e clientMessage
        setClientMessageEvent e rw a 32 1 currentTime
        sendEvent dpy rw False structureNotifyMask e
    sync dpy False