    {-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}

    -----------------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Layout.OnHost
    -- Description :  Use layouts and apply layout modifiers selectively, depending on the host.
    -- 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.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
    -- def ||| ...)@, 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 :: forall (l1 :: * -> *) a (l2 :: * -> *).
    (LayoutClass l1 a, LayoutClass l2 a) =>
    String -> l1 a -> l2 a -> OnHost l1 l2 a
    onHost String
    host = [String] -> l1 a -> l2 a -> OnHost l1 l2 a
    forall (l1 :: * -> *) a (l2 :: * -> *).
    (LayoutClass l1 a, LayoutClass l2 a) =>
    [String] -> l1 a -> l2 a -> OnHost l1 l2 a
    onHosts [String
    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 :: forall (l1 :: * -> *) a (l2 :: * -> *).
    (LayoutClass l1 a, LayoutClass l2 a) =>
    [String] -> l1 a -> l2 a -> OnHost l1 l2 a
    onHosts [String]
    hosts = [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    OnHost [String]
    hosts Bool
    False

    -- | 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 :: forall (l :: * -> *) a (lm :: * -> *).
    LayoutClass l a =>
    String
    -> (l a -> ModifiedLayout lm l a)
    -> l a
    -> OnHost (ModifiedLayout lm l) l a
    modHost String
    host = [String]
    -> (l a -> ModifiedLayout lm l a)
    -> l a
    -> OnHost (ModifiedLayout lm l) l a
    forall (l :: * -> *) a (lm :: * -> *).
    LayoutClass l a =>
    [String]
    -> (l a -> ModifiedLayout lm l a)
    -> l a
    -> OnHost (ModifiedLayout lm l) l a
    modHosts [String
    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 :: forall (l :: * -> *) a (lm :: * -> *).
    LayoutClass l a =>
    [String]
    -> (l a -> ModifiedLayout lm l a)
    -> l a
    -> OnHost (ModifiedLayout lm l) l a
    modHosts [String]
    hosts l a -> ModifiedLayout lm l a
    f l a
    l = [String]
    -> Bool
    -> ModifiedLayout lm l a
    -> l a
    -> OnHost (ModifiedLayout lm l) l a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    OnHost [String]
    hosts Bool
    False (l a -> ModifiedLayout lm l a
    f l a
    l) l a
    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 (ReadPrec [OnHost l1 l2 a]
    ReadPrec (OnHost l1 l2 a)
    Int -> ReadS (OnHost l1 l2 a)
    ReadS [OnHost l1 l2 a]
    (Int -> ReadS (OnHost l1 l2 a))
    -> ReadS [OnHost l1 l2 a]
    -> ReadPrec (OnHost l1 l2 a)
    -> ReadPrec [OnHost l1 l2 a]
    -> Read (OnHost l1 l2 a)
    forall a.
    (Int -> ReadS a)
    -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    ReadPrec [OnHost l1 l2 a]
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    ReadPrec (OnHost l1 l2 a)
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    Int -> ReadS (OnHost l1 l2 a)
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    ReadS [OnHost l1 l2 a]
    $creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    Int -> ReadS (OnHost l1 l2 a)
    readsPrec :: Int -> ReadS (OnHost l1 l2 a)
    $creadList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    ReadS [OnHost l1 l2 a]
    readList :: ReadS [OnHost l1 l2 a]
    $creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    ReadPrec (OnHost l1 l2 a)
    readPrec :: ReadPrec (OnHost l1 l2 a)
    $creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Read (l1 a), Read (l2 a)) =>
    ReadPrec [OnHost l1 l2 a]
    readListPrec :: ReadPrec [OnHost l1 l2 a]
    Read, Int -> OnHost l1 l2 a -> ShowS
    [OnHost l1 l2 a] -> ShowS
    OnHost l1 l2 a -> String
    (Int -> OnHost l1 l2 a -> ShowS)
    -> (OnHost l1 l2 a -> String)
    -> ([OnHost l1 l2 a] -> ShowS)
    -> Show (OnHost l1 l2 a)
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Show (l1 a), Show (l2 a)) =>
    Int -> OnHost l1 l2 a -> ShowS
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Show (l1 a), Show (l2 a)) =>
    [OnHost l1 l2 a] -> ShowS
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Show (l1 a), Show (l2 a)) =>
    OnHost l1 l2 a -> String
    $cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Show (l1 a), Show (l2 a)) =>
    Int -> OnHost l1 l2 a -> ShowS
    showsPrec :: Int -> OnHost l1 l2 a -> ShowS
    $cshow :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Show (l1 a), Show (l2 a)) =>
    OnHost l1 l2 a -> String
    show :: OnHost l1 l2 a -> String
    $cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    (Show (l1 a), Show (l2 a)) =>
    [OnHost l1 l2 a] -> ShowS
    showList :: [OnHost l1 l2 a] -> ShowS
    Show)

    instance (LayoutClass l1 a, LayoutClass l2 a, Show a) => LayoutClass (OnHost l1 l2) a where
        runLayout :: Workspace String (OnHost l1 l2 a) a
    -> Rectangle -> X ([(a, Rectangle)], Maybe (OnHost l1 l2 a))
    runLayout (W.Workspace String
    i p :: OnHost l1 l2 a
    p@(OnHost [String]
    hosts Bool
    _ l1 a
    lt l2 a
    lf) Maybe (Stack a)
    ms) Rectangle
    r = do
          h <- IO (Maybe String) -> X (Maybe String)
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO (Maybe String) -> X (Maybe String))
    -> IO (Maybe String) -> X (Maybe String)
    forall a b. (a -> b) -> a -> b
    $ String -> IO (Maybe String)
    getEnv String
    "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 l1 l2 a -> SomeMessage -> X (Maybe (OnHost l1 l2 a))
    handleMessage (OnHost [String]
    hosts Bool
    bool l1 a
    lt l2 a
    lf) SomeMessage
    m
            | Bool
    bool      = l1 a -> SomeMessage -> X (Maybe (l1 a))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    layout a -> SomeMessage -> X (Maybe (layout a))
    handleMessage l1 a
    lt SomeMessage
    m X (Maybe (l1 a))
    -> (Maybe (l1 a) -> X (Maybe (OnHost l1 l2 a)))
    -> X (Maybe (OnHost l1 l2 a))
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= X (Maybe (OnHost l1 l2 a))
    -> (l1 a -> X (Maybe (OnHost l1 l2 a)))
    -> Maybe (l1 a)
    -> X (Maybe (OnHost l1 l2 a))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe (OnHost l1 l2 a) -> X (Maybe (OnHost l1 l2 a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (OnHost l1 l2 a)
    forall a. Maybe a
    Nothing) (\l1 a
    nt -> Maybe (OnHost l1 l2 a) -> X (Maybe (OnHost l1 l2 a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (OnHost l1 l2 a) -> X (Maybe (OnHost l1 l2 a)))
    -> (OnHost l1 l2 a -> Maybe (OnHost l1 l2 a))
    -> OnHost l1 l2 a
    -> X (Maybe (OnHost l1 l2 a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OnHost l1 l2 a -> Maybe (OnHost l1 l2 a)
    forall a. a -> Maybe a
    Just (OnHost l1 l2 a -> X (Maybe (OnHost l1 l2 a)))
    -> OnHost l1 l2 a -> X (Maybe (OnHost l1 l2 a))
    forall a b. (a -> b) -> a -> b
    $ [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    OnHost [String]
    hosts Bool
    bool l1 a
    nt l2 a
    lf)
            | Bool
    otherwise = l2 a -> SomeMessage -> X (Maybe (l2 a))
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    layout a -> SomeMessage -> X (Maybe (layout a))
    handleMessage l2 a
    lf SomeMessage
    m X (Maybe (l2 a))
    -> (Maybe (l2 a) -> X (Maybe (OnHost l1 l2 a)))
    -> X (Maybe (OnHost l1 l2 a))
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= X (Maybe (OnHost l1 l2 a))
    -> (l2 a -> X (Maybe (OnHost l1 l2 a)))
    -> Maybe (l2 a)
    -> X (Maybe (OnHost l1 l2 a))
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (Maybe (OnHost l1 l2 a) -> X (Maybe (OnHost l1 l2 a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return Maybe (OnHost l1 l2 a)
    forall a. Maybe a
    Nothing) (Maybe (OnHost l1 l2 a) -> X (Maybe (OnHost l1 l2 a))
    forall a. a -> X a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Maybe (OnHost l1 l2 a) -> X (Maybe (OnHost l1 l2 a)))
    -> (l2 a -> Maybe (OnHost l1 l2 a))
    -> l2 a
    -> X (Maybe (OnHost l1 l2 a))
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . OnHost l1 l2 a -> Maybe (OnHost l1 l2 a)
    forall a. a -> Maybe a
    Just (OnHost l1 l2 a -> Maybe (OnHost l1 l2 a))
    -> (l2 a -> OnHost l1 l2 a) -> l2 a -> Maybe (OnHost l1 l2 a)
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    OnHost [String]
    hosts Bool
    bool l1 a
    lt)

        description :: OnHost l1 l2 a -> String
    description (OnHost [String]
    _ Bool
    True  l1 a
    l1 l2 a
    _) = l1 a -> String
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    layout a -> String
    description l1 a
    l1
        description (OnHost [String]
    _ Bool
    _     l1 a
    _ l2 a
    l2) = l2 a -> String
    forall (layout :: * -> *) a.
    LayoutClass layout a =>
    layout a -> String
    description l2 a
    l2

    -- | Construct new OnHost values with possibly modified layouts.
    mkNewOnHostT :: OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a
    mkNewOnHostT :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a
    mkNewOnHostT (OnHost [String]
    hosts Bool
    _ l1 a
    lt l2 a
    lf) Maybe (l1 a)
    mlt' =
      (\l1 a
    lt' -> [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    OnHost [String]
    hosts Bool
    True l1 a
    lt' l2 a
    lf) (l1 a -> OnHost l1 l2 a) -> l1 a -> OnHost l1 l2 a
    forall a b. (a -> b) -> a -> b
    $ l1 a -> Maybe (l1 a) -> l1 a
    forall a. a -> Maybe a -> a
    fromMaybe l1 a
    lt Maybe (l1 a)
    mlt'

    mkNewOnHostF :: OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a
    mkNewOnHostF :: forall (l1 :: * -> *) (l2 :: * -> *) a.
    OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a
    mkNewOnHostF (OnHost [String]
    hosts Bool
    _ l1 a
    lt l2 a
    lf) Maybe (l2 a)
    mlf' =
      [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    forall (l1 :: * -> *) (l2 :: * -> *) a.
    [String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
    OnHost [String]
    hosts Bool
    False l1 a
    lt (l2 a -> OnHost l1 l2 a) -> l2 a -> OnHost l1 l2 a
    forall a b. (a -> b) -> a -> b
    $ l2 a -> Maybe (l2 a) -> l2 a
    forall a. a -> Maybe a -> a
    fromMaybe l2 a
    lf Maybe (l2 a)
    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 :: String -> [String] -> Bool
    elemFQDN String
    _  []     =  Bool
    False
    elemFQDN String
    h0 (String
    h:[String]
    hs)
      | String
    h0 String -> String -> Bool
    `eqFQDN` String
    h  =  Bool
    True
      | Bool
    otherwise      =  String -> [String] -> Bool
    elemFQDN String
    h0 [String]
    hs

    -- | String equality, possibly truncating one side at a dot.
    eqFQDN :: String -> String -> Bool
    eqFQDN :: String -> String -> Bool
    eqFQDN String
    a String
    b
      | Char
    '.' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    a Bool -> Bool -> Bool
    && Char
    '.' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    b =                    String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==                    String
    b
      | Char
    '.' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    a                 = (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==                    String
    b
      |                 Char
    '.' Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` String
    b =                    String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == (Char -> Bool) -> ShowS
    forall a. (a -> Bool) -> [a] -> [a]
    takeWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '.') String
    b
      | Bool
    otherwise                    =                    String
    a String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    ==                    String
    b