HaskellSrcExts.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- General Folds for the Haskell-Src-Exts datatypes
--
-----------------------------------------------------------------------------
module WinDll.Structs.Folds.HaskellSrcExts where

import qualified Language.Haskell.Exts as Exts
import qualified Language.Haskell.Exts.SrcLoc as Span
import Language.Haskell.Exts.Pretty

-- * General folds

-- | Fold algebra for the Type ADT in Language.Haskell.Exts.Syntax
type TypeAlgebra a = ((Maybe [Exts.TyVarBind]) -> Exts.Context -> a -> a
                     ,a -> a -> a
                     ,Exts.Boxed -> [a] -> a
                     ,a -> a
                     ,a -> a -> a
                     ,Exts.Name -> a
                     ,Exts.QName -> a
                     ,a -> a
                     ,a -> Exts.QName -> a -> a
                     ,a -> Exts.Kind -> a
                     )
   
-- | Fold function for the above algebra   
foldType :: TypeAlgebra a -> Exts.Type -> a
foldType (tforall, tfun, ttuple, tlist, tapp
         ,tvar, tcon, tparen, tinfix, tkind) = fold
    where fold (Exts.TyForall a b c) = tforall a b (fold c)
          fold (Exts.TyFun      a b) = (fold a) `tfun` (fold b)
          fold (Exts.TyTuple    a b) = a `ttuple` (map fold b)
          fold (Exts.TyList       a) = tlist (fold a)
          fold (Exts.TyApp      a b) = (fold a) `tapp` (fold b)
          fold (Exts.TyVar        a) = tvar a
          fold (Exts.TyCon        a) = tcon a
          fold (Exts.TyParen      a) = tparen (fold a)
          fold (Exts.TyInfix  a b c) = tinfix (fold a) b (fold c)
          fold (Exts.TyKind     a b) = tkind (fold a) b   
          
-- | Fold algebra for the Type ADT in Language.Haskell.Exts.Syntax
type TypeAlgebraIO a = ((Maybe [Exts.TyVarBind]) -> Exts.Context -> a -> a
                       ,a -> a -> a
                       ,Exts.Boxed -> [a] -> a
                       ,a -> a
                       ,Bool -> a -> a -> a
                       ,Exts.Name -> a
                       ,Exts.QName -> a
                       ,a -> a
                       ,a -> Exts.QName -> a -> a
                       ,a -> Exts.Kind -> a
                       )
          
-- | Fold function for the above algebra, Except in the case of a TyApp
--   The function is applied to the second argument only if the first is a "IO",
--   The boolean indicates if this is an IO application yes or no.
foldTypeIO :: TypeAlgebraIO a -> Exts.Type -> a
foldTypeIO (tforall, tfun, ttuple, tlist, tapp
           ,tvar, tcon, tparen, tinfix, tkind) = fold
    where fold (Exts.TyForall a b c) = tforall a b (fold c)
          fold (Exts.TyFun      a b) = (fold a) `tfun` (fold b)
          fold (Exts.TyTuple    a b) = a `ttuple` (map fold b)
          fold (Exts.TyList       a) = tlist (fold a)
          fold (Exts.TyApp      a b) = tapp (prettyPrint a == "IO") (fold a) (fold b)
          fold (Exts.TyVar        a) = tvar a
          fold (Exts.TyCon        a) = tcon a
          fold (Exts.TyParen      a) = tparen (fold a)
          fold (Exts.TyInfix  a b c) = tinfix (fold a) b (fold c)
          fold (Exts.TyKind     a b) = tkind (fold a) b