Remapper.hs

{-# LANGUAGE DeriveDataTypeable    #-}
{-# LANGUAGE ScopedTypeVariables   #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE IncoherentInstances   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- A module to convert one datatype to another isomorphic datatype.
--
-----------------------------------------------------------------------------

module WinDll.Shared.Remapper where

import Data.Data hiding (DataType)
import Data.Typeable
import Data.Generics hiding (DataType)

import Foreign

import WinDll.Lib.NativeMapping
import WinDll.Structs.Structures

-- | Get the number of fields of a constructor    
nrArgs :: Data a => a -> Int
nrArgs = gmapQr (+) 0 (const 1)
    
-- | Convert at runtime back and forth between *simple* data structures. (Enums only). For more complex types the compiler generates the structures. This is usefull for when the preprocessor does not have the source readily available
isoConvert :: (Data a, Data b) => a -> b
isoConvert a = let conDest i = indexConstr (dataTypeOf result) i
                   constIndex = constrRep $ toConstr a
                   result = case constIndex of
                                (AlgConstr i) -> fromConstr (conDest i) 
                                rest          -> fromConstr (repConstr (dataTypeOf result) rest)
               in result
             
-- | Class to manage the convertions that the parser generates             
class FFIType a b => IsoConvert a b where
    convertTo   :: a -> b
    convertFrom :: b -> a
    
-- | Same types are always convertable to eachother, because they implement FFITypes
instance Num a => IsoConvert a a where
    convertTo   = id
    convertFrom = id
    
-- | Boolean types can also be converted, yay
instance IsoConvert Bool Bool where
    convertTo    = id
    convertFrom = id
    
-- | Creating of pointer type should also always be possible (this instance is redundant, FFITypes also provides this conversion, however, since we'll use IsoConvert for all type conversions, this instances simplifies things)
instance Storable a => IsoConvert a (Ptr a) where
    convertTo   = toFFI
    convertFrom = fromFFI
    
-- data DataType = DataType Name [Type] [DataType]
              -- | NewType Name [Type] DataType
              -- | Constr Name [Type]
    
-- | generate the isomorphic convertion from and between the two type given and the associated FFI type
createDataTypeIsoMorphism :: DataType -> String
createDataTypeIsoMorphism d@(DataType name types consts tag) = unlines $ (genInstance d) : (createFromDataIsoConvert name types consts) : []
createDataTypeIsoMorphism d@(NewType name types cons tag   ) = unlines $ (genInstance d) : (createFromDataIsoConvert name types [cons]) : []
createDataTypeIsoMorphism (Constr name typevars            ) = []

-- | Create the from Convertion function
createFromDataIsoConvert :: Name -> Types -> DataTypes -> String
createFromDataIsoConvert name types datatypes = []

-- | Generate the instance declaration
genInstance :: DataType -> String
genInstance (DataType name types _ _) = internalGenInstance name types
genInstance (NewType name types _ _ ) = internalGenInstance name types
genInstance (Constr _ _             ) = error "Called GenInstance on a constructor"

internalGenInstance :: Name -> [Type] -> String
internalGenInstance name types =
 unlines $ 
    (case null types of
        True -> "instance IsoConvert " ++ name ++ " T" ++ name ++ " where"
        False -> "instance FFYType " ++ listTypesUsing " " types ++ " => IsoConvert (" ++ name ++ " " ++ listTypesUsing " " types ++ ") (T" ++ name ++ " " ++ listTypesUsing " " types ++ ") where")
        : ["    convertTo   = toT" ++ name,"    convertFrom = fromT" ++ name]

-- | Converts a list of Types to a string to be printed to file.
listTypesUsing :: String -> [Type] -> String
listTypesUsing _ []     = []
listTypesUsing f types  = foldl1 (\a b->a++f++b) types