content: {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
  
  -----------------------------------------------------------------------------
  -- |
  -- Module      :  XMonad.Layout.OnHost
  -- Copyright   :  (c) Brandon S Allbery, Brent Yorgey
  -- License     :  BSD-style (see LICENSE)
  --
  -- Maintainer  :  <allbery.b@gmail.com>
  -- Stability   :  unstable
  -- Portability :  unportable
  --
  -- Configure layouts on a per-host basis: use layouts and apply
  -- layout modifiers selectively, depending on the host.  Heavily based on
  -- "XMonad.Layout.PerWorkspace" by Brent Yorgey.
  -----------------------------------------------------------------------------
  
  module XMonad.Layout.OnHost (-- * Usage
                               -- $usage
                               OnHost
                              ,onHost
                              ,onHosts
                              ,modHost
                              ,modHosts
                              ) where
  
  import           XMonad
  import qualified XMonad.StackSet              as W
  
  import           XMonad.Layout.LayoutModifier
  
  import           Data.Maybe                        (fromMaybe)
  import           System.Posix.Env                  (getEnv)
  
  -- $usage
  -- You can use this module by importing it into your ~\/.xmonad\/xmonad.hs file:
  --
  -- > import XMonad.Layout.OnHost
  --
  -- and modifying your 'layoutHook' as follows (for example):
  --
  -- > layoutHook = modHost "baz" m1 $            -- apply layout modifier m1 to all layouts on host "baz"
  -- >              onHost "foo" l1 $             -- layout l1 will be used on host "foo".
  -- >              onHosts ["bar","quux"] l2 $   -- layout l2 will be used on hosts "bar" and "quux".
  -- >              l3                            -- layout l3 will be used on all other hosts.
  --
  -- Note that @l1@, @l2@, and @l3@ can be arbitrarily complicated
  -- layouts, e.g. @(Full ||| smartBorders $ tabbed shrinkText
  -- defaultTConf ||| ...)@, and @m1@ can be any layout modifier, i.e. a
  -- function of type @(l a -> ModifiedLayout lm l a)@.
  --
  -- In another scenario, suppose you wanted to have layouts A, B, and C
  -- available on all hosts, except that on host foo you want
  -- layout D instead of C.  You could do that as follows:
  --
  -- > layoutHook = A ||| B ||| onHost "foo" D C
  --
  -- Note that we rely on '$HOST' being set in the environment, as is true on most
  -- modern systems; if it's not, you may want to use a wrapper around xmonad or
  -- perhaps use 'System.Posix.Env.setEnv' (or 'putEnv') to set it in 'main'.
  -- This is to avoid dragging in the network package as an xmonad dependency.
  -- If '$HOST' is not defined, it will behave as if the host name never matches.
  --
  -- Also note that '$HOST' is usually a fully qualified domain name, not a short name.
  -- If you use a short name, this code will try to truncate $HOST to match; this may
  -- prove too magical, though, and may change in the future.
  
  -- | Specify one layout to use on a particular host, and another
  --   to use on all others.  The second layout can be another call to
  --   'onHost', and so on.
  onHost :: (LayoutClass l1 a, LayoutClass l2 a)
         => String -- ^ the name of the host to match
         -> (l1 a) -- ^ layout to use on the matched host
         -> (l2 a) -- ^ layout to use everywhere else
         -> OnHost l1 l2 a
  onHost host = onHosts [host]
  
  -- | Specify one layout to use on a particular set of hosts, and
  --   another to use on all other hosts.
  onHosts :: (LayoutClass l1 a, LayoutClass l2 a)
          => [String] -- ^ names of hosts to match
          -> (l1 a)   -- ^ layout to use on matched hosts
          -> (l2 a)   -- ^ layout to use everywhere else
          -> OnHost l1 l2 a
  onHosts hosts l1 l2 = OnHost hosts False l1 l2
  
  -- | Specify a layout modifier to apply on a particular host; layouts
  --   on all other hosts will remain unmodified.
  modHost :: (LayoutClass l a)
          => String                          -- ^ name of the host to match
          -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching host
          -> l a                             -- ^ the base layout
          -> OnHost (ModifiedLayout lm l) l a
  modHost host = modHosts [host]
  
  -- | Specify a layout modifier to apply on a particular set of
  --   hosts; layouts on all other hosts will remain
  --   unmodified.
  modHosts :: (LayoutClass l a)
           => [String]                        -- ^ names of the hosts to match
           -> (l a -> ModifiedLayout lm l a)  -- ^ the modifier to apply on the matching hosts
           -> l a                             -- ^ the base layout
           -> OnHost (ModifiedLayout lm l) l a
  modHosts hosts f l = OnHost hosts False (f l) l
  
  -- | Structure for representing a host-specific layout along with
  --   a layout for all other hosts. We store the names of hosts
  --   to be matched, and the two layouts. We save the layout choice in
  --   the Bool, to be used to implement description.
  data OnHost l1 l2 a = OnHost [String]
                               Bool
                               (l1 a)
                               (l2 a)
      deriving (Read, Show)
  
  instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where
      runLayout (W.Workspace i p@(OnHost hosts _ lt lf) ms) r = do
        h <- io $ getEnv "HOST"
        if maybe False (`elemFQDN` hosts) h
          then do (wrs, mlt') <- runLayout (W.Workspace i lt ms) r
                  return (wrs, Just $ mkNewOnHostT p mlt')
          else do (wrs, mlt') <- runLayout (W.Workspace i lf ms) r
                  return (wrs, Just $ mkNewOnHostF p mlt')
  
      handleMessage (OnHost hosts bool lt lf) m
          | bool      = handleMessage lt m >>= maybe (return Nothing) (\nt -> return . Just $ OnHost hosts bool nt lf)
          | otherwise = handleMessage lf m >>= maybe (return Nothing) (\nf -> return . Just $ OnHost hosts bool lt nf)
  
      description (OnHost _ True  l1 _) = description l1
      description (OnHost _ _     _ l2) = description l2
  
  -- | Construct new OnHost values with possibly modified layouts.
  mkNewOnHostT :: OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a
  mkNewOnHostT (OnHost hosts _ lt lf) mlt' =
    (\lt' -> OnHost hosts True lt' lf) $ fromMaybe lt mlt'
  
  mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a
  mkNewOnHostF (OnHost hosts _ lt lf) mlf' =
    (\lf' -> OnHost hosts False lt lf') $ fromMaybe lf mlf'
  
  -- | 'Data.List.elem' except that if one side has a dot and the other doesn't, we truncate
  --   the one that does at the dot.
  elemFQDN           :: String -> [String] -> Bool
  elemFQDN _  []     =  False
  elemFQDN h0 (h:hs)
    | h0 `eqFQDN` h  =  True
    | otherwise      =  elemFQDN h0 hs
  
  -- | String equality, possibly truncating one side at a dot.
  eqFQDN :: String -> String -> Bool
  eqFQDN a b
    | '.' `elem` a && '.' `elem` b =                    a ==                    b
    | '.' `elem` a                 = takeWhile (/= '.') a ==                    b
    |                 '.' `elem` b =                    a == takeWhile (/= '.') b
    | otherwise                    =                    a ==                    b
  