pituicat/src/Affection/Property.hs

47 lines
1.1 KiB
Haskell
Raw Normal View History

2017-03-16 22:51:41 +00:00
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
2017-03-18 16:38:26 +00:00
module Affection.Property
2017-03-20 04:24:30 +00:00
( Props
2017-03-18 16:38:26 +00:00
, prop
, props
) where
2017-03-16 22:51:41 +00:00
import qualified GEGL as G
import qualified BABL as B
2017-03-18 16:38:26 +00:00
import Control.Monad.State.Lazy
2017-03-16 23:22:26 +00:00
import Foreign.Ptr (Ptr)
2017-03-16 22:51:41 +00:00
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
2017-03-20 04:24:30 +00:00
put $ G.Property k (toPropertyValue v) : ps
2017-03-16 22:51:41 +00:00
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