1 files changed, 22 insertions, 10 deletions
diff --git a/lib/Phi/X11/Atoms.hs b/lib/Phi/X11/Atoms.hs
index acbae64..0a8f66a 100644
--- a/lib/Phi/X11/Atoms.hs
+++ b/lib/Phi/X11/Atoms.hs
@@ -5,36 +5,48 @@ module Phi.X11.Atoms ( Atoms(..)
                      ) where
 
 import Control.Monad
+import Data.Char
+import Data.List
+
 import Language.Haskell.TH
-import Graphics.X11
+import Graphics.XHB
+import Graphics.XHB.Gen.Xproto
 
 import Phi.X11.AtomList
 
 
 $(let atomsName = mkName "Atoms"
       atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) $ atoms ++ (map fst specialAtoms)
-      fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames
+      fields = map (\(_, name) -> (name, IsStrict, ConT ''ATOM)) atomNames
   in return [DataD [] atomsName [] [RecC atomsName fields] []]
  )
 
-initAtoms :: Display -> IO Atoms
-initAtoms display =
+initAtoms :: Connection -> IO Atoms
+initAtoms conn =
   $(do
        normalAtomNames <- mapM (\atom -> do
+                             receiptName <- newName ('_':atom)
                              varName <- newName ('_':atom)
-                             return ([|const atom|], mkName ("atom" ++ atom), varName)
+                             return ([|const atom|], mkName ("atom" ++ atom), receiptName, varName)
                          ) atoms
        specialAtomNames <- mapM (\(name, atomgen) -> do
+                             receiptName <- newName ('_':name)
                              varName <- newName ('_':name)
-                             return (atomgen, mkName ("atom" ++ name), varName)
+                             return (atomgen, mkName ("atom" ++ name), receiptName, varName)
                          ) specialAtoms
        let atomNames = normalAtomNames ++ specialAtomNames
+       atomReceipts <- forM atomNames $
+                       \(atomgen, _, receiptName, _) -> liftM (BindS (VarP receiptName))
+                                                        [|let name = ($atomgen conn)
+                                                          in internAtom conn $ MkInternAtom False (genericLength name) $ map (fromIntegral . ord) name|]
        atomInitializers <- forM atomNames $
-                           \(atomgen, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display ($atomgen display) False |]
-           
-       let atomFieldExps = map (\(_, atomName, varName) -> (atomName, VarE varName)) atomNames
+                           \(_, _, receiptName, varName) -> liftM (BindS (VarP varName))
+                                                            [|liftM (\(Right a) -> a) $ getReply $(return $ VarE receiptName)|]
+       
+       
+       let atomFieldExps = map (\(_, atomName, _, varName) -> (atomName, VarE varName)) atomNames
            atomsName = mkName "Atoms"
            atomsContruction = NoBindS $ AppE (VarE 'return) $ RecConE atomsName atomFieldExps
 
-       return $ DoE $ atomInitializers ++ [atomsContruction]
+       return $ DoE $ atomReceipts ++ atomInitializers ++ [atomsContruction]
    )