#if __GLASGOW_HASKELL__ >= 704
#elif __GLASGOW_HASKELL__ >= 702
#endif
module Trace.Hpc.Tix(Tix(..), TixModule(..),
tixModuleName, tixModuleHash, tixModuleTixs,
readTix, writeTix, getTixFileName) where
import System.FilePath (replaceExtension)
import Trace.Hpc.Util (Hash, catchIO, readFileUtf8, writeFileUtf8)
data Tix = Tix [TixModule]
deriving (Read, Show, Eq)
data TixModule = TixModule
String
Hash
Int
[Integer]
deriving (Read, Show, Eq)
tixModuleName :: TixModule -> String
tixModuleName (TixModule nm _ _ _) = nm
tixModuleHash :: TixModule -> Hash
tixModuleHash (TixModule _ h _ _) = h
tixModuleTixs :: TixModule -> [Integer]
tixModuleTixs (TixModule _ _ _ tixs) = tixs
readTix :: String
-> IO (Maybe Tix)
readTix tixFilename =
catchIO (fmap (Just . read) $ readFileUtf8 tixFilename)
(const $ return Nothing)
writeTix :: String
-> Tix
-> IO ()
writeTix name tix = writeFileUtf8 name (show tix)
getTixFileName :: String -> String
getTixFileName str = replaceExtension str "tix"