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.AF.General.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 Maybe

{- *** My SYB Helper functions *** -}
constructors :: (Data ctx a) => Proxy ctx -> a -> [Constr]
constructors ctx x = dataTypeConstrs $ dataTypeOf ctx x




-- |A get field fun: parent -> child
data GetFieldHelper = forall a. Typeable a => GetFieldHelper a
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