Debug.hs

{-# LANGUAGE FlexibleInstances    #-}
{-# LANGUAGE DeriveDataTypeable   #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Windll
-- Copyright   :  (c) Tamar Christina 2009 - 2010
-- License     :  BSD3
-- 
-- Maintainer  :  tamar@zhox.com
-- Stability   :  experimental
-- Portability :  portable
--
-- Session management information and global state modifiers for the 
-- debug program.
--
-----------------------------------------------------------------------------

module WinDll.Session.Debug (module WinDll.Session.Debug
                            ,module Control.Monad.State.Strict) where

import Control.Monad.State.Strict
import Control.Monad.Trans
import Control.Monad.Error
import Control.Monad

import System.Directory
import System.IO.Unsafe
import System.FilePath

import WinDll.Version.Debug
import WinDll.Debug.Records ( fileName, MemAlloc )
import {-# SOURCE #-} WinDll.Debug.Heap ( Heap(..) )

import Data.Either
import Data.Data
import Data.Char
import Data.Generics
import Data.Monoid

import GHC.Paths ( libdir )
import GHC (guessTarget, targetId, TargetId(..), runGhc)
import Module(moduleNameSlashes)

import Debug.Trace(trace)
                    
-- | The platform your compiling for, This determines the type of library that is created.
data Platform = Windows -- ^ Windows DLL
              | Unix    -- ^ Lib files
              deriving (Show,Eq,Read)
              
-- | Contains the enviroment settings, e.g. path to ghc,hsc2hs etc
data EnvPaths  = EnvPaths

-- | Simple flags, used with GetOpt
data Options = Version | Help
        deriving (Show,Eq)
                    
-- | Global session management information passed through each function                    
data Session = Session { mainFile           :: String         -- ^ @mainFile @ Main filename
                       , absPath            :: String         -- ^ @absPath@ The absolute path to the main file
                       , verbosity          :: Int            -- ^ @verbosity@ debugging verbosity level 
                       , outputDIR          :: String         -- ^ @outputDir@ Redirect output to a folder
                       , baseDir            :: String         -- ^ @baseDir@ Path to the base folder which contains the WinDll includes folder and template 
                       , outputFile         :: String         -- ^ @outputFile@ The output file name
                       , platform           :: Platform       -- ^ @platform@ The platform to compile for
                       , options            :: [Options]      -- ^ @options@ The none executable flags
                       , memAllocs          :: [MemAlloc]     -- ^ @memAllocs@ The list of memory allocations that we're processing
                       , memAllocsLen       :: Int            -- ^ @memAllocs@ The amount of allocations to process
                       , heap               :: Heap
                       }
                       deriving Show
     
-- | Monad transformer used to do all computations in     
type Exec a = StateT Session (ErrorT String IO) a

-- | Make the Either a Monad instance 
-- instance Monad (Either String) where
    -- fail str          = Left str
    -- return a          = Right a
    -- (Left str ) >>= _ = Left str
    -- (Right a)   >>= f = f a
    
-- | And also make the Either a Functor
instance Functor (Either String) where
    fmap f (Left str) = Left str
    fmap f (Right a)  = Right (f a)

-- | And a MonadPlus instance
instance MonadPlus (Either String) where
    mzero               = Left ""
    (Left _) `mplus` xs = xs
    xs       `mplus` ys = xs
    
-- | MonadIO instance so that liftIO can be used inside the StateT
-- instance MonadIO (Either String) where
    -- liftIO = (($!) return) . unsafePerformIO 

-- | The default session initialized to the values specific for windows
newSession = Session { mainFile     = ""
                     , absPath      = ""
                     , verbosity    = 0
                     , outputDIR    = "."
                     , baseDir      = []
                     , outputFile   = []
                     , platform     = Windows
                     , options      = []
                     , memAllocs    = []
                     , memAllocsLen = 0
                     , heap         = NoHeap
                     }

-- | Guess the fullname of a target file
guessPath :: FilePath -> IO FilePath
guessPath mangled = do fn <- fileName
                       let file      = takeFileName fn
                           fullname1 = mangled </> fn
                           fullname2 = mangled </> file
                       exists1 <- doesFileExist fullname1
                       exists2 <- doesFileExist fullname2
                       case (exists1, exists2) of 
                         (True,    _) -> return fullname1
                         (_   , True) -> return fullname2
                         (_   ,    _) -> error $ "Could not find '" ++ file ++ "' in the specified location"