Hs2lib-0.5.0: WinDll/Structs/MShow/CSharp.hs
-----------------------------------------------------------------------------
-- |
-- Module : Windll
-- Copyright : (c) Tamar Christina 2009 - 2010
-- License : BSD3
--
-- Maintainer : tamar@zhox.com
-- Stability : experimental
-- Portability : portable
--
-- MShow instances for the CSharp datatypes
--
-----------------------------------------------------------------------------
module WinDll.Structs.MShow.CSharp where
import WinDll.Structs.MShow.MShow
import WinDll.Structs.Folds.CSharp
import WinDll.Structs.Folds.C
import WinDll.Structs.CSharp
import qualified WinDll.Structs.CSharp as Cs
import WinDll.Structs.C hiding (Normal)
import WinDll.Structs.Structures
import Data.Char
import Data.List
instance MShow CsInclude where
mshow = foldInclude ((\a->"using "++a++";")
,(\a->"using WinDll."++a++";")
) . csUnpackInclude
instance MShow CsDataEnum where
mshow = foldDataEnum ((\a b->let fix = foldr1 (\a b->a++", "++b) . map (("c"++a)++)
in "public enum List"++a++" {" ++ fix b ++ "};")) . csUnpackEnum
instance MShow Attr where
mshow = foldAttr (\p k v -> let pre = case p of
Cs.Normal -> ""
Cs.Param -> "param: "
Cs.Return -> "return: "
in pre ++ k ++ "(" ++ intercalate "," v ++ ")" )
instance MShow Argument where
mshow = mshowM 1
mshowM 1 = foldArgument (\t ty nm -> let at = "public " ++ ty ++ " " ++ nm ++ ";"
in if null t then at else unlines $ map (\x-> "[" ++ mshow x ++"]") t ++ [at])
mshowM 2 = foldArgument (\t ty nm -> let at = ty ++ " " ++ nm
in if null t then at else concat $ ["[" ++ intercalate ", " (map mshow t) ++ "]", at])
instance MShow CsExport where
mshow = foldCsExport (\c t n r a-> let comments_body = zipWith ($) (repeat ("/// "++)) c
params_decl = map (\(Argument _ _ n) -> "/// <param name=\"" ++ n ++ "\"></param>") a
result_decl = if r == "void" then [] else ["/// <returns> </returns>"]
comments = ("/// <summary>" : comments_body)
++ ("/// </summary>" : params_decl)
++ result_decl
attributes = if null t then [] else map (\x-> "[" ++ mshow x ++"]") t
arguments = "(" ++ intercalate ", " (map (mshowM 2) a) ++ ")"
decl = if '*' `elem` arguments || '*' `elem` r
then "public unsafe static extern "
else "public static extern "
in unlines $ comments ++ attributes ++ [decl ++ r ++ " " ++ n ++ arguments ++ ";",""])
instance MShow CsStruct where
mshow cs = let attr = map (\x-> "[" ++ mshow x ++"]") (cssTopAttr cs)
indent' x = " " ++ x
args = concatMap (map indent'.lines.mshow) (cssElements cs)
in unlines $ attr ++
["public unsafe struct " ++ cssName cs
,"{"
] ++ args ++
["};"
,""
]
instance MShow CsCallback where
mshow cs = let attr = map (\x-> "[" ++ mshow x ++"]") (cscTopAttr cs)
indent' x = " " ++ x
args = intercalate "," (map (mshowM 2) (cscArguments cs))
ret = cscRetType cs
unsafe = if '*' `elem` args || '*' `elem` ret then "unsafe " else ""
in unlines $ attr ++ ["public " ++ unsafe ++ "delegate " ++ ret ++ " " ++ (cscName cs) ++ "(" ++ args ++ ");"]
instance MShow CSharp where
mshow cs = let nm = "namespace " ++ _namespace cs
indent = (" " ++)
csexp = concatMap (map indent.lines.mshow) $ _functions cs
cspre = let cs' = _preserved cs
val = (indent "/// Preserved export statements") : (concatMap (map indent.lines.mshow) cs')
in if null cs' then [] else val
csrts = let cs' = _rtscontrol cs
val = (indent "/// Runtime control methods") : (concatMap (map indent.lines.mshow) cs')
in if null cs' then [] else val
csenum = let cs' = _enums cs
val = (indent "/// Constructor Enumerations") : (concatMap (map indent.lines.mshow) cs')
in if null cs' then [] else val
csstrc = let cs' = _structs cs
in concatMap (map indent.lines.mshow) cs'
csback = let cs' = _callbacks cs
val = (indent "/// Callback functions ") : (concatMap (map indent.lines.mshow) cs')
in if null cs' then [] else val
imports = map mshow (_includes cs)
in unlines $ imports ++ [""
,nm
,"{"
] ++
zipWith id (repeat (" /// "++)) (lines $ _header cs) ++
[" public unsafe class " ++ _class cs
," {"
] ++ [""] ++
csback ++ [""] ++
csexp ++
cspre ++
csrts ++
[" }"
,"}"
,nm ++ ".Types"
,"{" ] ++
zipWith id (repeat (" /// "++)) (lines $ _header cs) ++
csenum ++ [""] ++
csstrc ++
["}"
]