phi/lib/Phi/X11/Atoms.hs

{-# LANGUAGE TemplateHaskell #-}

module Phi.X11.Atoms ( Atoms(..)
                     , initAtoms
                     ) where

import Control.Monad
import Language.Haskell.TH
import Graphics.X11

import Phi.X11.AtomList


$(let atomsName = mkName "Atoms"
      atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) atoms
      fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames
  in return [DataD [] atomsName [] [RecC atomsName fields] []]
 )

initAtoms :: Display -> IO Atoms
initAtoms display =
  $(do
       atomNames <- mapM (\atom -> do
                             varName <- newName ('_':atom)
                             return (atom, mkName ("atom" ++ atom), varName)
                         ) atoms
       atomInitializers <- forM atomNames $
                           \(atom, _, varName) -> liftM (BindS (VarP varName)) [| internAtom display atom False |]
           
       let atomFieldExps = map (\(_, atomName, varName) -> (atomName, VarE varName)) atomNames
           atomsName = mkName "Atoms"
           atomsContruction = NoBindS $ AppE (VarE 'return) $ RecConE atomsName atomFieldExps

       return $ DoE $ atomInitializers ++ [atomsContruction]
   )