{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE FlexibleInstances  #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Types used when describing structures in WinDll
--
-----------------------------------------------------------------------------
module WinDll.Structs.Types where

import qualified Language.Haskell.Exts as Exts
import qualified Language.Haskell.Exts.SrcLoc as Span

import Data.Generics hiding (DataType)
import Data.List ( nub )
import Data.Monoid

type Name          = String
type ModuleName    = String
type Import        = String
type ExportName    = String
type Type          = Exts.Type
type TypeName      = String
type TypeNames     = [TypeName]
type NamedTypes    = [(Name,Type)]
type AnnNamedTypes = [AnnType]
type Types         = [Type]

instance Monoid Ann where
  mempty = noAnn
  mappend (Ann a1 b1 c1 d1 e1 f1 g1 h1 i1) 
          (Ann a2 b2 c2 d2 e2 f2 g2 h2 i2) = Ann (nub $ a1 ++ a2) (b1 || b2) 
                                                 (nub $ c1 ++ c2) (nub $ d1 ++ d2) (nub $ e1 ++ e2)
                                                 (nub $ f1 ++ f2) (\v -> nub $ g1 v ++ g2 v) (h1 || h2)
                                                 (i1 ++ " " ++ i2)

-- | Annotation on functions, This allows more complex types to be expressed
data Ann = Ann { annArrayIndices    :: [Int]                      -- ^ Offsets into the type list to indicate which fields are counters for lists
               , annArrayIsList     :: Bool                       -- ^ Indicates if the field type is a List type. 
               , annStableIndices   :: [Int]                      -- ^ Indices/Offsets to indicate whether this function has any StablePtr values
               , annWorkingSet      :: [(String, String)]         -- ^ Copy of the definition list for the Haskell translation functions
               , annWorkingSetC     :: [(String, String)]         -- ^ Copy of the definition list for the C translation functions
               , annWorkingSetCSize :: [(String, Int)]            -- ^ Copy of the definition list for the C sizes translation functions
               , annWorkingSetCs    :: Bool -> [(String, String)] -- ^ Copy of the definition list for the C# translation functions
               , annDebug           :: Bool                       -- ^ Indicates is debugging has been enabled for this session
               , annModule          :: ModuleName 
               }
    deriving(Show,Eq,Data,Typeable)
    
instance Eq (Bool -> [(String, String)]) where
 f == g = f False == g False && f True == f True

instance Show (Bool -> [(String, String)]) where
  show f = unlines [show (f True), show (f False)]
    
-- | Annotated type, basically a 4-tuple that holds all possible information on a datatype field
data AnnType = AnnType { antName     :: Name       -- ^ The field name, if this is a record the name will be the record name.
                       , antType     :: Type       -- ^ The preprocessed type of the field
                       , antAnn      :: Ann        -- ^ The type annotations for the antType
                       , antOrigType :: Type       -- ^ The original unpreprocessed type
                       , antModule   :: ModuleName -- ^ The module that originally defined the type
                       }
    deriving(Show,Eq,Data,Typeable)
    
-- | Generic empty annotation
noAnn :: Ann
noAnn = Ann { annArrayIndices    = []
            , annArrayIsList     = False
            , annStableIndices   = []
            , annWorkingSet      = []
            , annWorkingSetC     = []
            , annWorkingSetCSize = []
            , annWorkingSetCs    = const []
            , annDebug           = False
            , annModule          = []
            }

-- | Find any Names embedded within any arbitraty structures
findStrings' :: Data a => a -> [String] -- Language.Haskell.Exts.Syntax.Name -> [String]
findStrings' = everything (++) ([] `mkQ` inner)
    where inner (Exts.Ident s ) = [s]
          inner (Exts.Symbol s) = [s]