{-# LANGUAGE TypeSynonymInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  XMonad.Util.WindowPropertiesRE
-- Copyright   :  (c) 2011 Ilya Portnov <portnov84@rambler.ru>
-- License     :  BSD3-style (see LICENSE)
--
-- Maintainer  :  Ilya Portnov <portnov84@rambler.ru>
-- Stability   :  unstable
-- Portability :  unportable
--
-- Similar to XMonad.Util.WindowProperties, but uses posix regular expressions matching
-- instead of exact match.
--
-----------------------------------------------------------------------------
module XMonad.Util.WindowPropertiesRE
  (PropertyRE (..),
   (~?),
   propertyToQueryRE, hasPropertyRE
  ) where

import Text.Regex.Posix ((=~))

import XMonad

import XMonad.Actions.TagWindows
import XMonad.Util.WindowProperties
import XMonad.Layout.LayoutBuilder

-- | A wrapper for X.U.WindowProperties.Property.
-- Checks using regular expression.
data PropertyRE = RE Property
  deriving (Int -> PropertyRE -> ShowS
[PropertyRE] -> ShowS
PropertyRE -> String
(Int -> PropertyRE -> ShowS)
-> (PropertyRE -> String)
-> ([PropertyRE] -> ShowS)
-> Show PropertyRE
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PropertyRE -> ShowS
showsPrec :: Int -> PropertyRE -> ShowS
$cshow :: PropertyRE -> String
show :: PropertyRE -> String
$cshowList :: [PropertyRE] -> ShowS
showList :: [PropertyRE] -> ShowS
Show,ReadPrec [PropertyRE]
ReadPrec PropertyRE
Int -> ReadS PropertyRE
ReadS [PropertyRE]
(Int -> ReadS PropertyRE)
-> ReadS [PropertyRE]
-> ReadPrec PropertyRE
-> ReadPrec [PropertyRE]
-> Read PropertyRE
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS PropertyRE
readsPrec :: Int -> ReadS PropertyRE
$creadList :: ReadS [PropertyRE]
readList :: ReadS [PropertyRE]
$creadPrec :: ReadPrec PropertyRE
readPrec :: ReadPrec PropertyRE
$creadListPrec :: ReadPrec [PropertyRE]
readListPrec :: ReadPrec [PropertyRE]
Read,Typeable)

-- | Regular expressions matching for ManageHooks
(~?) :: (Functor f) => f String -> String -> f Bool
f String
q ~? :: forall (f :: * -> *). Functor f => f String -> String -> f Bool
~? String
x = (String -> Bool) -> f String -> f Bool
forall a b. (a -> b) -> f a -> f b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
x) f String
q

-- | Similar to XMonad.Util.WindowProperties.propertyToQuery, 
-- but uses regexp match instead of exact match
propertyToQueryRE :: Property -> Query Bool
propertyToQueryRE :: Property -> Query Bool
propertyToQueryRE (Title String
s) = Query String
title Query String -> String -> Query Bool
forall (f :: * -> *). Functor f => f String -> String -> f Bool
~? String
s
propertyToQueryRE (Resource String
s) = Query String
resource Query String -> String -> Query Bool
forall (f :: * -> *). Functor f => f String -> String -> f Bool
~? String
s
propertyToQueryRE (ClassName String
s) = Query String
className Query String -> String -> Query Bool
forall (f :: * -> *). Functor f => f String -> String -> f Bool
~? String
s
propertyToQueryRE (Role String
s) = String -> Query String
stringProperty String
"WM_WINDOW_ROLE" Query String -> String -> Query Bool
forall (f :: * -> *). Functor f => f String -> String -> f Bool
~? String
s
propertyToQueryRE (Machine String
s) = String -> Query String
stringProperty String
"WM_CLIENT_MACHINE" Query String -> String -> Query Bool
forall (f :: * -> *). Functor f => f String -> String -> f Bool
~? String
s
propertyToQueryRE (And Property
p1 Property
p2) = Property -> Query Bool
propertyToQueryRE Property
p1 Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<&&> Property -> Query Bool
propertyToQueryRE Property
p2
propertyToQueryRE (Or Property
p1 Property
p2) = Property -> Query Bool
propertyToQueryRE Property
p1 Query Bool -> Query Bool -> Query Bool
forall (m :: * -> *). Monad m => m Bool -> m Bool -> m Bool
<||> Property -> Query Bool
propertyToQueryRE Property
p2
propertyToQueryRE (Not Property
p) = Bool -> Bool
not (Bool -> Bool) -> Query Bool -> Query Bool
forall a b. (a -> b) -> Query a -> Query b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Property -> Query Bool
propertyToQueryRE Property
p
propertyToQueryRE (Const Bool
b) = Bool -> Query Bool
forall a. a -> Query a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
b
propertyToQueryRE (Tagged String
s) = Query Window
forall r (m :: * -> *). MonadReader r m => m r
ask Query Window -> (Window -> Query Bool) -> Query Bool
forall a b. Query a -> (a -> Query b) -> Query b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Window
w -> X Bool -> Query Bool
forall a. X a -> Query a
liftX ((String -> Bool) -> [String] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (String -> String -> Bool
forall source source1 target.
(RegexMaker Regex CompOption ExecOption source,
 RegexContext Regex source1 target) =>
source1 -> source -> target
=~ String
s) ([String] -> Bool) -> X [String] -> X Bool
forall a b. (a -> b) -> X a -> X b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
`fmap` Window -> X [String]
getTags Window
w)

-- | Does given window have this property?
hasPropertyRE :: PropertyRE -> Window -> X Bool
hasPropertyRE :: PropertyRE -> Window -> X Bool
hasPropertyRE (RE Property
p) Window
w = Query Bool -> Window -> X Bool
forall a. Query a -> Window -> X a
runQuery (Property -> Query Bool
propertyToQueryRE Property
p) Window
w

instance Predicate PropertyRE Window where
  alwaysTrue :: Proxy Window -> PropertyRE
alwaysTrue Proxy Window
_ = Property -> PropertyRE
RE (Bool -> Property
Const Bool
True)
  checkPredicate :: PropertyRE -> Window -> X Bool
checkPredicate = PropertyRE -> Window -> X Bool
hasPropertyRE