Uniplate.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE IncoherentInstances #-} -- :-/
{-# LANGUAGE CPP #-}

module Generics.Deriving.Uniplate (
    Uniplate(..)

  -- * Default definition
  , childrendefault

  ) where


import Generics.Deriving.Base

--------------------------------------------------------------------------------
-- Generic Uniplate
--------------------------------------------------------------------------------

class Uniplate' f b where
  children' :: f a -> [b]

instance Uniplate' U1 a where
  children' U1 = []

instance Uniplate' (K1 i a) a where
  children' (K1 a) = [a]

instance Uniplate' (K1 i a) b where
  children' (K1 _) = []

instance (Uniplate' f b) => Uniplate' (M1 i c f) b where
  children' (M1 a) = children' a

instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :+: g) b where
  children' (L1 a) = children' a
  children' (R1 a) = children' a

instance (Uniplate' f b, Uniplate' g b) => Uniplate' (f :*: g) b where
  children' (a :*: b) = children' a ++ children' b 


class Uniplate a where 
  children :: a -> [a]
  children _ = []

#ifdef __UHC__

{-# DERIVABLE Uniplate children childrendefault #-}
deriving instance (Uniplate a) => Uniplate (Maybe a)

#endif

childrendefault :: (Representable0 a rep0, Uniplate' rep0 a) => rep0 x -> a -> [a]
childrendefault rep x = children' (from0 x `asTypeOf` rep)


-- Base types instances
instance Uniplate Char
instance Uniplate Int
instance Uniplate Float

instance Uniplate [a] where
  children []    = []
  children (_:t) = [t]

#ifndef __UHC__
instance (Uniplate a) => Uniplate (Maybe a) where
  children = t undefined where
    t :: Rep0Maybe a x -> Maybe a -> [Maybe a]
    t = childrendefault
#endif