{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
module XMonad.Layout.OnHost (
OnHost
,onHost
,onHosts
,modHost
,modHosts
) where
import XMonad
import qualified XMonad.StackSet as W
import XMonad.Prelude
import XMonad.Layout.LayoutModifier
import Foreign (allocaArray0)
import Foreign.C
import System.Posix.Env (getEnv)
onHost :: (LayoutClass l1 a, LayoutClass l2 a)
=> String
-> l1 a
-> l2 a
-> 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 = forall (l1 :: * -> *) a (l2 :: * -> *).
(LayoutClass l1 a, LayoutClass l2 a) =>
[String] -> l1 a -> l2 a -> OnHost l1 l2 a
onHosts [String
host]
onHosts :: (LayoutClass l1 a, LayoutClass l2 a)
=> [String]
-> l1 a
-> l2 a
-> 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 = forall (l1 :: * -> *) (l2 :: * -> *) a.
[String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
OnHost [String]
hosts Bool
False
modHost :: (LayoutClass l a)
=> String
-> (l a -> ModifiedLayout lm l a)
-> l a
-> 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 = 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]
modHosts :: (LayoutClass l a)
=> [String]
-> (l a -> ModifiedLayout lm l a)
-> l a
-> 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 = 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
data OnHost l1 l2 a = OnHost [String]
Bool
(l1 a)
(l2 a)
deriving (ReadPrec [OnHost l1 l2 a]
ReadPrec (OnHost l1 l2 a)
ReadS [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]
readListPrec :: ReadPrec [OnHost l1 l2 a]
$creadListPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read (l1 a), Read (l2 a)) =>
ReadPrec [OnHost l1 l2 a]
readPrec :: ReadPrec (OnHost l1 l2 a)
$creadPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read (l1 a), Read (l2 a)) =>
ReadPrec (OnHost l1 l2 a)
readList :: ReadS [OnHost l1 l2 a]
$creadList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read (l1 a), Read (l2 a)) =>
ReadS [OnHost l1 l2 a]
readsPrec :: Int -> ReadS (OnHost l1 l2 a)
$creadsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Read (l1 a), Read (l2 a)) =>
Int -> ReadS (OnHost l1 l2 a)
Read, Int -> OnHost l1 l2 a -> ShowS
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
showList :: [OnHost l1 l2 a] -> ShowS
$cshowList :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show (l1 a), Show (l2 a)) =>
[OnHost l1 l2 a] -> ShowS
show :: OnHost l1 l2 a -> String
$cshow :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show (l1 a), Show (l2 a)) =>
OnHost l1 l2 a -> String
showsPrec :: Int -> OnHost l1 l2 a -> ShowS
$cshowsPrec :: forall (l1 :: * -> *) (l2 :: * -> *) a.
(Show (l1 a), Show (l2 a)) =>
Int -> 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
Maybe String
h <- forall (m :: * -> *) a. MonadIO m => IO a -> m a
io forall a b. (a -> b) -> a -> b
$ String -> IO (Maybe String)
getEnv String
"HOST" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IO (Maybe String)
getHostName
if forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (String -> [String] -> Bool
`elemFQDN` [String]
hosts) Maybe String
h
then do ([(a, Rectangle)]
wrs, Maybe (l1 a)
mlt') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l1 a
lt Maybe (Stack a)
ms) Rectangle
r
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
OnHost l1 l2 a -> Maybe (l1 a) -> OnHost l1 l2 a
mkNewOnHostT OnHost l1 l2 a
p Maybe (l1 a)
mlt')
else do ([(a, Rectangle)]
wrs, Maybe (l2 a)
mlt') <- forall (layout :: * -> *) a.
LayoutClass layout a =>
Workspace String (layout a) a
-> Rectangle -> X ([(a, Rectangle)], Maybe (layout a))
runLayout (forall i l a. i -> l -> Maybe (Stack a) -> Workspace i l a
W.Workspace String
i l2 a
lf Maybe (Stack a)
ms) Rectangle
r
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
wrs, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
OnHost l1 l2 a -> Maybe (l2 a) -> OnHost l1 l2 a
mkNewOnHostF OnHost l1 l2 a
p Maybe (l2 a)
mlt')
handleMessage :: OnHost l1 l2 a -> SomeMessage -> X (Maybe (OnHost l1 l2 a))
handleMessage (OnHost [String]
hosts Bool
choice l1 a
lt l2 a
lf) SomeMessage
m
| Bool
choice = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
lt SomeMessage
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (\l1 a
nt -> forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall (l1 :: * -> *) (l2 :: * -> *) a.
[String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
OnHost [String]
hosts Bool
choice l1 a
nt l2 a
lf)
| Bool
otherwise = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
lf SomeMessage
m forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing) (forall (m :: * -> *) a. Monad m => a -> m a
return forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (l1 :: * -> *) (l2 :: * -> *) a.
[String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
OnHost [String]
hosts Bool
choice l1 a
lt)
description :: OnHost l1 l2 a -> String
description (OnHost [String]
_ Bool
True l1 a
l1 l2 a
_) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 a
l1
description (OnHost [String]
_ Bool
_ l1 a
_ l2 a
l2) = forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 a
l2
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' -> 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) forall a b. (a -> b) -> a -> b
$ 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' =
forall (l1 :: * -> *) (l2 :: * -> *) a.
[String] -> Bool -> l1 a -> l2 a -> OnHost l1 l2 a
OnHost [String]
hosts Bool
False l1 a
lt forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l2 a
lf Maybe (l2 a)
mlf'
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
eqFQDN :: String -> String -> Bool
eqFQDN :: String -> String -> Bool
eqFQDN String
a String
b
| Char
'.' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
a Bool -> Bool -> Bool
&& Char
'.' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
b = String
a forall a. Eq a => a -> a -> Bool
== String
b
| Char
'.' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
a = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') String
a forall a. Eq a => a -> a -> Bool
== String
b
| Char
'.' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
b = String
a forall a. Eq a => a -> a -> Bool
== forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') String
b
| Bool
otherwise = String
a forall a. Eq a => a -> a -> Bool
== String
b
foreign import ccall "gethostname" gethostname :: CString -> CSize -> IO CInt
getHostName :: IO (Maybe String)
getHostName :: IO (Maybe String)
getHostName = forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray0 Int
size forall a b. (a -> b) -> a -> b
$ \Ptr CChar
cstr -> do
forall a. (Eq a, Num a) => String -> IO a -> IO ()
throwErrnoIfMinus1_ String
"getHostName" forall a b. (a -> b) -> a -> b
$ Ptr CChar -> CSize -> IO CInt
gethostname Ptr CChar
cstr (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
size)
Ptr CChar -> IO String
peekCString Ptr CChar
cstr forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
String
"" -> forall a. Maybe a
Nothing
String
s -> forall a. a -> Maybe a
Just String
s
where
size :: Int
size = Int
256