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)] -> PtrName -> [TypeName] -> Bool -> [a] -> [a] -> Ann -> a)
                                ,(Name -> 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 -> Name -> [(Name,TypeName,Ann)] -> a)
                             )
                          
-- | Type Algebra for the StorablePoke ADT                          
type StorablePokeAlgebra a = ((TypeName -> Field -> PtrName -> a -> a)
                             ,(Name -> TypeName -> a)
                             ,(Name -> a)
                             ,(Bool -> Name -> Maybe Name -> Type -> Ann ->  a)
                             , 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) = hsstorable a b c d e (map fold f) (map fold g) h
          fold (HSPoke               a b c) = hspoke a b c
          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) = ret a b c
          
-- | 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) = a `new` b
          fold (PokeValue       a) = val a
          fold (PokeVar a b c d e) = var a b c d e
          fold (PokeReturn       ) = ret