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