{-# LANGUAGE FlexibleContexts, FlexibleInstances, MultiParamTypeClasses, UndecidableInstances, PatternGuards, ScopedTypeVariables #-}
module XMonad.Layout.LayoutBuilderP {-# DEPRECATED "Use XMonad.Layout.LayoutBuilder instead" #-} (
LayoutP (..),
layoutP, layoutAll,
B.relBox, B.absBox,
Predicate (..), Proxy(..),
) where
import XMonad
import XMonad.Prelude hiding (Const)
import qualified XMonad.StackSet as W
import XMonad.Util.WindowProperties
import qualified XMonad.Layout.LayoutBuilder as B
class Predicate p w where
alwaysTrue :: Proxy w -> p
checkPredicate :: p -> w -> X Bool
data Proxy a = Proxy
data LayoutP p l1 l2 a =
LayoutP (Maybe a) (Maybe a) p B.SubBox (Maybe B.SubBox) (l1 a) (Maybe (l2 a))
deriving (Int -> LayoutP p l1 l2 a -> ShowS
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutP p l1 l2 a -> ShowS
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutP p l1 l2 a] -> ShowS
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutP p l1 l2 a -> String
showList :: [LayoutP p l1 l2 a] -> ShowS
$cshowList :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
[LayoutP p l1 l2 a] -> ShowS
show :: LayoutP p l1 l2 a -> String
$cshow :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
LayoutP p l1 l2 a -> String
showsPrec :: Int -> LayoutP p l1 l2 a -> ShowS
$cshowsPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Show a, Show p, Show (l1 a), Show (l2 a)) =>
Int -> LayoutP p l1 l2 a -> ShowS
Show,ReadPrec [LayoutP p l1 l2 a]
ReadPrec (LayoutP p l1 l2 a)
ReadS [LayoutP p l1 l2 a]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutP p l1 l2 a]
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutP p l1 l2 a)
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutP p l1 l2 a)
forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutP p l1 l2 a]
readListPrec :: ReadPrec [LayoutP p l1 l2 a]
$creadListPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec [LayoutP p l1 l2 a]
readPrec :: ReadPrec (LayoutP p l1 l2 a)
$creadPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadPrec (LayoutP p l1 l2 a)
readList :: ReadS [LayoutP p l1 l2 a]
$creadList :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
ReadS [LayoutP p l1 l2 a]
readsPrec :: Int -> ReadS (LayoutP p l1 l2 a)
$creadsPrec :: forall p (l1 :: * -> *) (l2 :: * -> *) a.
(Read a, Read p, Read (l1 a), Read (l2 a)) =>
Int -> ReadS (LayoutP p l1 l2 a)
Read)
{-# DEPRECATED layoutP "Use XMonad.Layout.LayoutBuilder.layoutP instead." #-}
layoutP :: (Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a, LayoutClass l3 a, Predicate p a) =>
p
-> B.SubBox
-> Maybe B.SubBox
-> l1 a
-> LayoutP p l2 l3 a
-> LayoutP p l1 (LayoutP p l2 l3) a
layoutP :: forall a (l1 :: * -> *) (l2 :: * -> *) (l3 :: * -> *) p.
(Read a, Eq a, LayoutClass l1 a, LayoutClass l2 a,
LayoutClass l3 a, Predicate p a) =>
p
-> SubBox
-> Maybe SubBox
-> l1 a
-> LayoutP p l2 l3 a
-> LayoutP p l1 (LayoutP p l2 l3) a
layoutP p
prop SubBox
box Maybe SubBox
mbox l1 a
sub LayoutP p l2 l3 a
next = forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP forall a. Maybe a
Nothing forall a. Maybe a
Nothing p
prop SubBox
box Maybe SubBox
mbox l1 a
sub (forall a. a -> Maybe a
Just LayoutP p l2 l3 a
next)
{-# DEPRECATED layoutAll "Use XMonad.Layout.LayoutBuilder.layoutAll instead." #-}
layoutAll :: forall l1 p a. (Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
B.SubBox
-> l1 a
-> LayoutP p l1 Full a
layoutAll :: forall (l1 :: * -> *) p a.
(Read a, Eq a, LayoutClass l1 a, Predicate p a) =>
SubBox -> l1 a -> LayoutP p l1 Full a
layoutAll SubBox
box l1 a
sub =
let a :: p
a = forall p w. Predicate p w => Proxy w -> p
alwaysTrue (forall a. Proxy a
Proxy :: Proxy a)
in forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP forall a. Maybe a
Nothing forall a. Maybe a
Nothing p
a SubBox
box forall a. Maybe a
Nothing l1 a
sub forall a. Maybe a
Nothing
instance (LayoutClass l1 w, LayoutClass l2 w, Predicate p w, Show w, Read w, Eq w, Typeable w, Show p, Typeable p) =>
LayoutClass (LayoutP p l1 l2) w where
runLayout :: Workspace String (LayoutP p l1 l2 w) w
-> Rectangle -> X ([(w, Rectangle)], Maybe (LayoutP p l1 l2 w))
runLayout (W.Workspace String
_ (LayoutP Maybe w
subf Maybe w
nextf p
prop SubBox
box Maybe SubBox
mbox l1 w
sub Maybe (l2 w)
next) Maybe (Stack w)
s) Rectangle
rect
= do (Maybe (Stack w)
subs,Maybe (Stack w)
nexts,Maybe w
subf',Maybe w
nextf') <- forall p w.
(Predicate p w, Eq w) =>
Maybe (Stack w)
-> p
-> Maybe w
-> Maybe w
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
splitStack Maybe (Stack w)
s p
prop Maybe w
subf Maybe w
nextf
let selBox :: SubBox
selBox = if forall a. Maybe a -> Bool
isJust Maybe w
nextf'
then SubBox
box
else forall a. a -> Maybe a -> a
fromMaybe SubBox
box Maybe SubBox
mbox
([(w, Rectangle)]
sublist,l1 w
sub') <- forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], layout a)
handle l1 w
sub Maybe (Stack w)
subs forall a b. (a -> b) -> a -> b
$ SubBox -> Rectangle -> Rectangle
calcArea SubBox
selBox Rectangle
rect
([(w, Rectangle)]
nextlist,Maybe (l2 w)
next') <- case Maybe (l2 w)
next of Maybe (l2 w)
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([],forall a. Maybe a
Nothing)
Just l2 w
n -> do ([(w, Rectangle)]
res,l2 w
l) <- forall {layout :: * -> *} {a}.
LayoutClass layout a =>
layout a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], layout a)
handle l2 w
n Maybe (Stack w)
nexts Rectangle
rect
forall (m :: * -> *) a. Monad m => a -> m a
return ([(w, Rectangle)]
res,forall a. a -> Maybe a
Just l2 w
l)
forall (m :: * -> *) a. Monad m => a -> m a
return ([(w, Rectangle)]
sublistforall a. [a] -> [a] -> [a]
++[(w, Rectangle)]
nextlist, forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe w
subf' Maybe w
nextf' p
prop SubBox
box Maybe SubBox
mbox l1 w
sub' Maybe (l2 w)
next' )
where
handle :: layout a
-> Maybe (Stack a) -> Rectangle -> X ([(a, Rectangle)], layout a)
handle layout a
l Maybe (Stack a)
s' Rectangle
r = do ([(a, Rectangle)]
res,Maybe (layout a)
ml) <- 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
"" layout a
l Maybe (Stack a)
s') Rectangle
r
let l' :: layout a
l' = forall a. a -> Maybe a -> a
fromMaybe layout a
l Maybe (layout a)
ml
forall (m :: * -> *) a. Monad m => a -> m a
return ([(a, Rectangle)]
res,layout a
l')
handleMessage :: LayoutP p l1 l2 w -> SomeMessage -> X (Maybe (LayoutP p l1 l2 w))
handleMessage LayoutP p l1 l2 w
l SomeMessage
m
| Just (IncMasterN Int
_) <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus LayoutP p l1 l2 w
l SomeMessage
m
| Just Resize
Shrink <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus LayoutP p l1 l2 w
l SomeMessage
m
| Just Resize
Expand <- forall m. Message m => SomeMessage -> Maybe m
fromMessage SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus LayoutP p l1 l2 w
l SomeMessage
m
| Bool
otherwise = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth LayoutP p l1 l2 w
l SomeMessage
m
description :: LayoutP p l1 l2 w -> String
description (LayoutP Maybe w
_ Maybe w
_ p
_ SubBox
_ Maybe SubBox
_ l1 w
sub (Just l2 w
next)) = String
"layoutP "forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 w
sub forall a. [a] -> [a] -> [a]
++String
" "forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l2 w
next
description (LayoutP Maybe w
_ Maybe w
_ p
_ SubBox
_ Maybe SubBox
_ l1 w
sub Maybe (l2 w)
Nothing) = String
"layoutP "forall a. [a] -> [a] -> [a]
++ forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> String
description l1 w
sub
sendSub :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub (LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next) SomeMessage
m =
do Maybe (l1 a)
sub' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
sub SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub'
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox (forall a. a -> Maybe a -> a
fromMaybe l1 a
sub Maybe (l1 a)
sub') Maybe (l2 a)
next
else forall a. Maybe a
Nothing
sendBoth :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendBoth l :: LayoutP p l1 l2 a
l@(LayoutP Maybe a
_ Maybe a
_ p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
m = forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub LayoutP p l1 l2 a
l SomeMessage
m
sendBoth (LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub (Just l2 a
next)) SomeMessage
m =
do Maybe (l1 a)
sub' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l1 a
sub SomeMessage
m
Maybe (l2 a)
next' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
next SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe (l1 a)
sub' Bool -> Bool -> Bool
|| forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox (forall a. a -> Maybe a -> a
fromMaybe l1 a
sub Maybe (l1 a)
sub') (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a -> a
fromMaybe l2 a
next Maybe (l2 a)
next')
else forall a. Maybe a
Nothing
sendNext :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext (LayoutP Maybe a
_ Maybe a
_ p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
Nothing) SomeMessage
_ = forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
sendNext (LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub (Just l2 a
next)) SomeMessage
m =
do Maybe (l2 a)
next' <- forall (layout :: * -> *) a.
LayoutClass layout a =>
layout a -> SomeMessage -> X (Maybe (layout a))
handleMessage l2 a
next SomeMessage
m
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if forall a. Maybe a -> Bool
isJust Maybe (l2 a)
next'
then forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall p (l1 :: * -> *) (l2 :: * -> *) a.
Maybe a
-> Maybe a
-> p
-> SubBox
-> Maybe SubBox
-> l1 a
-> Maybe (l2 a)
-> LayoutP p l1 l2 a
LayoutP Maybe a
subf Maybe a
nextf p
prop SubBox
box Maybe SubBox
mbox l1 a
sub Maybe (l2 a)
next'
else forall a. Maybe a
Nothing
sendFocus :: (LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a, Typeable a, Predicate p a)
=> LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus :: forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendFocus l :: LayoutP p l1 l2 a
l@(LayoutP Maybe a
subf Maybe a
_ p
_ SubBox
_ Maybe SubBox
_ l1 a
_ Maybe (l2 a)
_) SomeMessage
m = do Bool
foc <- forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
subf
if Bool
foc then forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendSub LayoutP p l1 l2 a
l SomeMessage
m
else forall (l1 :: * -> *) a (l2 :: * -> *) p.
(LayoutClass l1 a, LayoutClass l2 a, Read a, Show a, Eq a,
Typeable a, Predicate p a) =>
LayoutP p l1 l2 a -> SomeMessage -> X (Maybe (LayoutP p l1 l2 a))
sendNext LayoutP p l1 l2 a
l SomeMessage
m
isFocus :: (Show a) => Maybe a -> X Bool
isFocus :: forall a. Show a => Maybe a -> X Bool
isFocus Maybe a
Nothing = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
isFocus (Just a
w) = do Maybe (Stack Dimension)
ms <- forall i l a. Workspace i l a -> Maybe (Stack a)
W.stack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. Screen i l a sid sd -> Workspace i l a
W.workspace forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall i l a sid sd. StackSet i l a sid sd -> Screen i l a sid sd
W.current forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets XState
-> StackSet
String (Layout Dimension) Dimension ScreenId ScreenDetail
windowset
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (\Stack Dimension
s -> forall a. Show a => a -> String
show a
w forall a. Eq a => a -> a -> Bool
== forall a. Show a => a -> String
show (forall a. Stack a -> a
W.focus Stack Dimension
s)) Maybe (Stack Dimension)
ms
splitBy :: (Predicate p w) => p -> [w] -> X ([w], [w])
splitBy :: forall p w. Predicate p w => p -> [w] -> X ([w], [w])
splitBy p
prop = forall (t :: * -> *) (m :: * -> *) b a.
(Foldable t, Monad m) =>
(b -> a -> m b) -> b -> t a -> m b
foldM forall {a}. Predicate p a => ([a], [a]) -> a -> X ([a], [a])
step ([], [])
where
step :: ([a], [a]) -> a -> X ([a], [a])
step ([a]
good, [a]
bad) a
w = do
Bool
ok <- forall p w. Predicate p w => p -> w -> X Bool
checkPredicate p
prop a
w
forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ if Bool
ok
then (a
wforall a. a -> [a] -> [a]
:[a]
good, [a]
bad)
else ([a]
good, a
wforall a. a -> [a] -> [a]
:[a]
bad)
splitStack :: (Predicate p w, Eq w) => Maybe (W.Stack w) -> p -> Maybe w -> Maybe w -> X (Maybe (W.Stack w),Maybe (W.Stack w),Maybe w,Maybe w)
splitStack :: forall p w.
(Predicate p w, Eq w) =>
Maybe (Stack w)
-> p
-> Maybe w
-> Maybe w
-> X (Maybe (Stack w), Maybe (Stack w), Maybe w, Maybe w)
splitStack Maybe (Stack w)
Nothing p
_ Maybe w
_ Maybe w
_ = forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. Maybe a
Nothing,forall a. Maybe a
Nothing,forall a. Maybe a
Nothing,forall a. Maybe a
Nothing)
splitStack (Just Stack w
s) p
prop Maybe w
subf Maybe w
nextf = do
let ws :: [w]
ws = forall a. Stack a -> [a]
W.integrate Stack w
s
([w]
good, [w]
other) <- forall p w. Predicate p w => p -> [w] -> X ([w], [w])
splitBy p
prop [w]
ws
let subf' :: Maybe w
subf' = [w] -> Maybe w -> Maybe w
foc [w]
good Maybe w
subf
nextf' :: Maybe w
nextf' = [w] -> Maybe w -> Maybe w
foc [w]
other Maybe w
nextf
forall (m :: * -> *) a. Monad m => a -> m a
return ( forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' Maybe w
subf' [w]
good
, forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' Maybe w
nextf' [w]
other
, Maybe w
subf'
, Maybe w
nextf'
)
where
foc :: [w] -> Maybe w -> Maybe w
foc [] Maybe w
_ = forall a. Maybe a
Nothing
foc [w]
l Maybe w
f
| forall a. Stack a -> a
W.focus Stack w
s forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [w]
l = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. Stack a -> a
W.focus Stack w
s
| forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [w]
l) Maybe w
f = Maybe w
f
| Bool
otherwise = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a. [a] -> a
head [w]
l
calcArea :: B.SubBox -> Rectangle -> Rectangle
calcArea :: SubBox -> Rectangle -> Rectangle
calcArea (B.SubBox SubMeasure
xpos SubMeasure
ypos SubMeasure
width SubMeasure
height) Rectangle
rect = Position -> Position -> Dimension -> Dimension -> Rectangle
Rectangle (Rectangle -> Position
rect_x Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
xpos') (Rectangle -> Position
rect_y Rectangle
rect forall a. Num a => a -> a -> a
+ forall a b. (Integral a, Num b) => a -> b
fromIntegral Dimension
ypos') Dimension
width' Dimension
height'
where
xpos' :: Dimension
xpos' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
xpos forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect
ypos' :: Dimension
ypos' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
False SubMeasure
ypos forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect
width' :: Dimension
width' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
width forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_width Rectangle
rect forall a. Num a => a -> a -> a
- Dimension
xpos'
height' :: Dimension
height' = forall {a} {b}. (Integral a, Num b) => Bool -> SubMeasure -> a -> b
calc Bool
True SubMeasure
height forall a b. (a -> b) -> a -> b
$ Rectangle -> Dimension
rect_height Rectangle
rect forall a. Num a => a -> a -> a
- Dimension
ypos'
calc :: Bool -> SubMeasure -> a -> b
calc Bool
zneg SubMeasure
val a
tot = forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
min (forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot) forall a b. (a -> b) -> a -> b
$ forall a. Ord a => a -> a -> a
max Int
0 forall a b. (a -> b) -> a -> b
$
case SubMeasure
val of B.Rel Rational
v -> forall a b. (RealFrac a, Integral b) => a -> b
floor forall a b. (a -> b) -> a -> b
$ Rational
v forall a. Num a => a -> a -> a
* forall a b. (Integral a, Num b) => a -> b
fromIntegral a
tot
B.Abs Int
v -> if Int
vforall a. Ord a => a -> a -> Bool
<Int
0 Bool -> Bool -> Bool
|| (Bool
zneg Bool -> Bool -> Bool
&& Int
vforall a. Eq a => a -> a -> Bool
==Int
0)
then forall a b. (Integral a, Num b) => a -> b
fromIntegral a
totforall a. Num a => a -> a -> a
+Int
v
else Int
v
differentiate' :: Eq q => Maybe q -> [q] -> Maybe (W.Stack q)
differentiate' :: forall q. Eq q => Maybe q -> [q] -> Maybe (Stack q)
differentiate' Maybe q
_ [] = forall a. Maybe a
Nothing
differentiate' Maybe q
Nothing [q]
w = forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
w
differentiate' (Just q
f) [q]
w
| q
f forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [q]
w = forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ W.Stack { focus :: q
W.focus = q
f
, up :: [q]
W.up = forall a. [a] -> [a]
reverse forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=q
f) [q]
w
, down :: [q]
W.down = forall a. [a] -> [a]
tail forall a b. (a -> b) -> a -> b
$ forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/=q
f) [q]
w
}
| Bool
otherwise = forall a. [a] -> Maybe (Stack a)
W.differentiate [q]
w
instance Predicate Property Window where
alwaysTrue :: Proxy Dimension -> Property
alwaysTrue Proxy Dimension
_ = Bool -> Property
Const Bool
True
checkPredicate :: Property -> Dimension -> X Bool
checkPredicate = Property -> Dimension -> X Bool
hasProperty