-----------------------------------------------------------------------------
-- |
-- 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 ++
                            ["}"
                            ]