module QueryTree where
import Command
import Event
--import Font(FontStruct)
--import Fudget
--import Geometry(Line, Point, Rect, Size(..))
--import LayoutRequest(LayoutRequest)
--import Path(Path(..))
import Xrequest
--import Xtypes

queryTreeK :: Cont (K b c) (Window, Window, [Window])
queryTreeK = 
    XRequest
-> (XResponse -> Maybe (Window, Window, [Window]))
-> Cont (K b c) (Window, Window, [Window])
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
QueryTree XResponse -> Maybe (Window, Window, [Window])
gotit
  where
    gotit :: XResponse -> Maybe (Window, Window, [Window])
gotit (TreeQueried Window
r Window
p [Window]
cs) = (Window, Window, [Window]) -> Maybe (Window, Window, [Window])
forall a. a -> Maybe a
Just (Window
r,Window
p,[Window]
cs)
    gotit XResponse
_ = Maybe (Window, Window, [Window])
forall a. Maybe a
Nothing

queryTreeF :: Cont (F b c) (Window, Window, [Window])
queryTreeF = 
    XRequest
-> (XResponse -> Maybe (Window, Window, [Window]))
-> Cont (F b c) (Window, Window, [Window])
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF XRequest
QueryTree XResponse -> Maybe (Window, Window, [Window])
gotit
  where
    gotit :: XResponse -> Maybe (Window, Window, [Window])
gotit (TreeQueried Window
r Window
p [Window]
cs) = (Window, Window, [Window]) -> Maybe (Window, Window, [Window])
forall a. a -> Maybe a
Just (Window
r,Window
p,[Window]
cs)
    gotit XResponse
_ = Maybe (Window, Window, [Window])
forall a. Maybe a
Nothing

{-
(defaultRootWindowK,defaultRootWindowF) =
    (xrequestK DefaultRootWindow gotit,xrequestF DefaultRootWindow gotit)
  where
    gotit (GotDefaultRootWindow w) = Just w
    gotit _ = Nothing

Doesn't work???
-}

defaultRootWindowK :: Cont (K b c) Window
defaultRootWindowK = 
    XRequest -> (XResponse -> Maybe Window) -> Cont (K b c) Window
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (K b c) a
xrequestK XRequest
DefaultRootWindow XResponse -> Maybe Window
gotit
  where
    gotit :: XResponse -> Maybe Window
gotit (GotDefaultRootWindow Window
w) = Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w
    gotit XResponse
_ = Maybe Window
forall a. Maybe a
Nothing

defaultRootWindowF :: Cont (F b c) Window
defaultRootWindowF = 
    XRequest -> (XResponse -> Maybe Window) -> Cont (F b c) Window
forall a b c. XRequest -> (XResponse -> Maybe a) -> Cont (F b c) a
xrequestF XRequest
DefaultRootWindow XResponse -> Maybe Window
gotit
  where
    gotit :: XResponse -> Maybe Window
gotit (GotDefaultRootWindow Window
w) = Window -> Maybe Window
forall a. a -> Maybe a
Just Window
w
    gotit XResponse
_ = Maybe Window
forall a. Maybe a
Nothing