affection/src/Affection/Property.hs
2017-03-17 00:20:42 +01:00

43 lines
1 KiB
Haskell

{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
module Affection.Property where
import Control.Monad.State.Lazy
import qualified GEGL as G
import qualified BABL as B
import GHC.Ptr (Ptr)
type Props a = State [G.Property] a
props :: Props a -> [G.Property]
props = flip execState []
prop :: IsPropertyValue v => String -> v -> Props ()
prop k v = do
ps <- get
put $ (G.Property k (toPropertyValue v)) : ps
class IsPropertyValue v where
toPropertyValue :: v -> G.PropertyValue
instance IsPropertyValue Int where
toPropertyValue = G.PropertyInt
instance IsPropertyValue String where
toPropertyValue = G.PropertyString
instance IsPropertyValue Double where
toPropertyValue = G.PropertyDouble
instance IsPropertyValue G.Color where
toPropertyValue = G.PropertyColor
instance IsPropertyValue B.PixelFormat where
toPropertyValue = G.PropertyFormat
instance IsPropertyValue G.GeglBuffer where
toPropertyValue = G.PropertyBuffer
instance IsPropertyValue (Ptr ()) where
toPropertyValue = G.PropertyPointer