36 lines
1.2 KiB
Haskell
36 lines
1.2 KiB
Haskell
{-# LANGUAGE TemplateHaskell #-}
|
|
|
|
module Phi.X11.Atoms ( Atoms(..)
|
|
, initAtoms
|
|
) where
|
|
|
|
import Control.Monad
|
|
import Language.Haskell.TH
|
|
import Graphics.X11
|
|
|
|
import Phi.X11.AtomList
|
|
|
|
|
|
$(do
|
|
let atomsName = mkName "Atoms"
|
|
atomNames = map (\atom -> (atom, mkName ("atom" ++ atom))) atoms
|
|
fields = map (\(_, name) -> (name, IsStrict, ConT ''Atom)) atomNames
|
|
return [DataD [] atomsName [] [RecC atomsName fields] []]
|
|
)
|
|
|
|
initAtoms :: Display -> IO Atoms
|
|
initAtoms display =
|
|
$(do
|
|
let atomsName = mkName "Atoms"
|
|
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
|
|
atomsContruction = NoBindS $ AppE (VarE 'return) $ RecConE atomsName atomFieldExps
|
|
|
|
return $ DoE $ atomInitializers ++ [atomsContruction]
|
|
)
|