1 {-# LANGUAGE ExistentialQuantification, KindSignatures, ScopedTypeVariables #-} 2 3 {-| 4 This module reexports the SYB3 library. 5 6 It also makes some extensions to SYB3, namely getFieldFun and 7 setFieldFun. 8 -} 9 10 module Graphics.UI.SybWidget.MySYB 11 ( module Data.Generics.SYB.WithClass.Basics 12 , module Data.Generics.SYB.WithClass.Derive 13 , constructors 14 , getFieldFun, setFieldFun 15 , gToString 16 ) 17 where 18 19 import Data.Generics.SYB.WithClass.Basics 20 import Data.Generics.SYB.WithClass.Derive 21 import Data.Generics.SYB.WithClass.Instances() 22 23 import Maybe 24 25 {- *** My SYB Helper functions *** -} 26 -- |Returns a set of constructors. This function is 27 -- undefined for Int, Float, Double and Char 28 constructors :: (Data ctx a) => Proxy ctx -> a -> [Constr] 29 constructors ctx x = dataTypeConstrs $ dataTypeOf ctx x 30 31 32 data GetFieldHelper = forall a. Typeable a => GetFieldHelper a 33 34 -- |A get field fun: parent -> child 35 getFieldFun :: forall a m (ctx :: * -> *). 36 (Typeable a, Data ctx m) => 37 Proxy ctx -> Int -> m -> a 38 getFieldFun ctx i m = case gmapQ ctx (\x -> GetFieldHelper x) m !! i of 39 (GetFieldHelper x) -> fromJust $ cast x 40 41 -- |A set field fun: parent -> child -> parent 42 setFieldFun :: forall m a (ctx :: * -> *). 43 (Data ctx m, Typeable a) => 44 Proxy ctx -> Int -> m -> a -> m 45 setFieldFun ctx i m a = snd $ gfoldl ctx k z m 46 where 47 k (0, c) _ = (-1, (c . fromJust . cast) a) 48 k (i', c) x = (i'-1, c x) 49 z c = (i, c) 50 51 -- |Function is similar to show, except that strings are shown without escaped \". 52 gToString :: (Show a, Typeable a) => a -> String 53 gToString x = case (cast x) of 54 (Just y) -> y 55 (Nothing) -> show x 56