MySYB.hs

{-# LANGUAGE ExistentialQuantification, KindSignatures, ScopedTypeVariables #-}

{-|
  This module reexports the SYB3 library.
  
  It also makes some extensions to SYB3, namely getFieldFun and
  setFieldFun.
-}

module Graphics.UI.SybWidget.MySYB
    ( module Data.Generics.SYB.WithClass.Basics
    , module Data.Generics.SYB.WithClass.Derive
    , constructors
    , getFieldFun, setFieldFun
    , gToString
    )
where

import Data.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Derive
import Data.Generics.SYB.WithClass.Instances()

import Data.Maybe

{- *** My SYB Helper functions *** -}
-- |Returns a set of constructors. This function is
-- undefined for Int, Float, Double and Char
constructors :: (Data ctx a) => Proxy ctx -> a -> [Constr]
constructors ctx x = dataTypeConstrs $ dataTypeOf ctx x


data GetFieldHelper = forall a. Typeable a => GetFieldHelper a

-- |A get field fun: parent -> child
getFieldFun :: forall a m (ctx :: * -> *).
               (Typeable a, Data ctx m) =>
               Proxy ctx -> Int -> m -> a
getFieldFun ctx i m = case gmapQ ctx (\x -> GetFieldHelper x) m  !! i of
                        (GetFieldHelper x) -> fromJust $ cast x

-- |A set field fun: parent -> child -> parent
setFieldFun :: forall m a (ctx :: * -> *).
               (Data ctx m, Typeable a) =>
               Proxy ctx -> Int -> m -> a -> m
setFieldFun ctx i m a = snd $ gfoldl ctx k z m
    where
      k (0, c) _  = (-1, (c . fromJust . cast) a)
      k (i', c) x = (i'-1, c x)
      z c         = (i, c)

-- |Function is similar to show, except that strings are shown without escaped \".
gToString :: (Show a, Typeable a) => a -> String
gToString x = case (cast x) of
                (Just y)  -> y
                (Nothing) -> show x