{-# 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"