Haskell.hs

-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- General Folds for the Haskell datatypes that are big enough
-- to warrant one.
--
-----------------------------------------------------------------------------
module WinDll.Structs.Folds.Haskell where

import WinDll.Structs.Haskell
import WinDll.Structs.C
import WinDll.Structs.Types

-- * General type algebras

-- | Type Algebra for the HaskellStorable ADT
type HaskellStorableAlgebra a = ((Name -> [(Name,Int)] -> Int -> PtrName -> [TypeName] -> Bool -> [a] -> [a] -> Ann -> a)
                                ,(Name -> ModuleName -> Int -> [StorablePoke] -> a)
                                ,([StorablePeek] -> a)
                                )
        
-- | Type Algebra for the StorablePeek ADT    
type StorablePeekAlgebra a = ((TypeName -> PtrName -> TypeName -> a)
                             ,(Int -> [a] -> a)
                             ,(Name -> TypeName -> Name -> PtrName -> TypeName -> a)
                             ,(Bool -> Bool -> Name -> [(Name,TypeName,Ann)] -> ModuleName -> a)
                             )
                          
-- | Type Algebra for the StorablePoke ADT                          
type StorablePokeAlgebra a = ((TypeName -> Field -> PtrName -> a -> a)
                             ,(Bool -> Name -> TypeName -> Int -> a)
                             ,(Name -> a)
                             ,(Bool -> Bool -> Name -> Maybe Name -> Type -> Ann ->  a)
                             ,ModuleName -> a
                             )
                             
-- * General folds for the algebras above

-- | General fold for the HaskellStorable ADT
foldHaskellStorable :: HaskellStorableAlgebra a -> HaskellStorable -> a
foldHaskellStorable (hsstorable,hspoke,hspeek) = fold
    where fold (HSStorable a b c d e f g h i) = hsstorable a b c d e f (map fold g) (map fold h) i
          fold (HSPoke               a b c d) = hspoke a b c d
          fold (HSPeek                     a) = hspeek a
          
-- | General fold for the StorablePeek ADT
foldStorablePeek :: StorablePeekAlgebra a -> StorablePeek -> a
foldStorablePeek (tag,entry,value,ret) = fold
    where fold (PeekTag         a b c) = tag a b c
          fold (PeekEntry         a b) = a `entry` (map fold b)
          fold (PeekValue   a b c d e) = value a b c d e
          fold (PeekReturn  a b c d e) = ret a b c d e
          
-- | General fold for the StorablePoke ADT
foldStorablePoke :: StorablePokeAlgebra a -> StorablePoke -> a
foldStorablePoke (tag,new,val,var,ret) = fold
    where fold (PokeTag     a b c d) = tag a b c (fold d)
          fold (NewPtr      a b c d) = new a b c d
          fold (PokeValue         a) = val a
          fold (PokeVar a b c d e f) = var a b c d e f
          fold (PokeReturn        a) = ret a