diff options
Diffstat (limited to 'lib/Phi/X11')
| -rw-r--r-- | lib/Phi/X11/AtomList.hs | 7 | ||||
| -rw-r--r-- | lib/Phi/X11/Atoms.hs | 3 | ||||
| -rw-r--r-- | lib/Phi/X11/Util.hs | 16 |
3 files changed, 12 insertions, 14 deletions
diff --git a/lib/Phi/X11/AtomList.hs b/lib/Phi/X11/AtomList.hs index 0ab3372..cad753a 100644 --- a/lib/Phi/X11/AtomList.hs +++ b/lib/Phi/X11/AtomList.hs @@ -6,8 +6,7 @@ module Phi.X11.AtomList ( atoms import Language.Haskell.TH -import Graphics.XHB.Connection -import Graphics.XHB.Connection.Open +import Graphics.XHB atoms :: [String] atoms = [ "ATOM" @@ -51,7 +50,7 @@ atoms = [ "ATOM" , "_XROOTMAP_ID" ] --- the expression must have the type (Connection -> String) +-- the expression must have the type (ConnectionClass c => c -> String) specialAtoms :: [(String, Q Exp)] -specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . screen . displayInfo|]) +specialAtoms = [ ("_NET_SYSTEM_TRAY_SCREEN", [|("_NET_SYSTEM_TRAY_S" ++) . show . connectionScreen|]) ] diff --git a/lib/Phi/X11/Atoms.hs b/lib/Phi/X11/Atoms.hs index 16945bf..6e69b37 100644 --- a/lib/Phi/X11/Atoms.hs +++ b/lib/Phi/X11/Atoms.hs @@ -10,7 +10,6 @@ import Data.List import Language.Haskell.TH import Graphics.XHB -import Graphics.XHB.Connection import Graphics.XHB.Gen.Xproto import Phi.X11.AtomList @@ -22,7 +21,7 @@ $(let atomsName = mkName "Atoms" in return [DataD [] atomsName [] [RecC atomsName fields] []] ) -initAtoms :: Connection -> IO Atoms +initAtoms :: ConnectionClass c => c -> IO Atoms initAtoms conn = $(do normalAtomNames <- mapM (\atom -> do diff --git a/lib/Phi/X11/Util.hs b/lib/Phi/X11/Util.hs index e1daba5..07eb1cf 100644 --- a/lib/Phi/X11/Util.hs +++ b/lib/Phi/X11/Util.hs @@ -29,7 +29,7 @@ import Graphics.XHB.Gen.Xproto import System.IO.Unsafe -getReply' :: ConnectionClass c r => String -> r a -> IO a +getReply' :: String -> Receipt a -> IO a getReply' m = getReply >=> return . fromRight where fromRight (Left _) = error m @@ -60,17 +60,17 @@ castToCChar input = unsafePerformIO $ with input $ \ptr -> peekArray (sizeOf input) (castPtr ptr) -changeProperty8 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO () +changeProperty8 :: ConnectionClass c => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word8] -> IO () changeProperty8 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 8 (genericLength propdata) propdata -changeProperty16 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO () +changeProperty16 :: ConnectionClass c => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word16] -> IO () changeProperty16 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 16 (genericLength propdata) (castWord16to8 propdata) -changeProperty32 :: ConnectionClass c r => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO () +changeProperty32 :: ConnectionClass c => c -> PropMode -> WINDOW -> ATOM -> ATOM -> [Word32] -> IO () changeProperty32 conn mode win prop proptype propdata = changeProperty conn $ MkChangeProperty mode win prop proptype 32 (genericLength propdata) (castWord32to8 propdata) -getProperty' :: ConnectionClass c r => Word8 -> c -> WINDOW -> ATOM -> IO (Maybe [Word8]) +getProperty' :: ConnectionClass c => Word8 -> c -> WINDOW -> ATOM -> IO (Maybe [Word8]) getProperty' format conn win prop = do reply <- getProperty conn (MkGetProperty False win prop (fromXid xidNone) 0 4) >>= getReply case reply of @@ -84,13 +84,13 @@ getProperty' format conn win prop = do Right (MkGetPropertyReply {format_GetPropertyReply = format'}) | format' /= format -> return Nothing Right (MkGetPropertyReply {value_GetPropertyReply = value}) -> return $ Just value -getProperty8 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word8]) +getProperty8 :: ConnectionClass c => c -> WINDOW -> ATOM -> IO (Maybe [Word8]) getProperty8 = getProperty' 8 -getProperty16 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word16]) +getProperty16 :: ConnectionClass c => c -> WINDOW -> ATOM -> IO (Maybe [Word16]) getProperty16 conn win prop = getProperty' 16 conn win prop >>= return . fmap castWord8to16 -getProperty32 :: ConnectionClass c r => c -> WINDOW -> ATOM -> IO (Maybe [Word32]) +getProperty32 :: ConnectionClass c => c -> WINDOW -> ATOM -> IO (Maybe [Word32]) getProperty32 conn win prop = getProperty' 32 conn win prop >>= return . fmap castWord8to32 |