1{-# LANGUAGE CPP #-}
2#if __GLASGOW_HASKELL__ >= 704
3{-# LANGUAGE Safe #-}
4#elif __GLASGOW_HASKELL__ >= 702
5-- System.FilePath in filepath version 1.2.0.1 isn't marked or implied Safe,
6-- as shipped with GHC 7.2.
7{-# LANGUAGE Trustworthy #-}
8#endif
9------------------------------------------------------------
10-- Andy Gill and Colin Runciman, June 2006
11------------------------------------------------------------
12
13-- | Datatypes and file-access routines for the tick data file
14-- (@.tix@) used by Hpc.
15module Trace.Hpc.Tix(Tix(..), TixModule(..),
16                     tixModuleName, tixModuleHash, tixModuleTixs,
17                     readTix, writeTix, getTixFileName) where
18
19import System.FilePath (replaceExtension)
20
21import Trace.Hpc.Util (Hash, catchIO, readFileUtf8, writeFileUtf8)
22
23-- | 'Tix' is the storage format for our dynamic information about
24-- what boxes are ticked.
25data Tix = Tix [TixModule]
26        deriving (Read, Show, Eq)
27
28data TixModule = TixModule
29                 String    --  module name
30                 Hash      --  hash number
31                 Int       --  length of Tix list (allows pre-allocation at parse time).
32                 [Integer] --  actual ticks
33        deriving (Read, Show, Eq)
34
35-- TODO: Turn extractors below into proper 'TixModule' field-labels
36tixModuleName :: TixModule -> String
37tixModuleName (TixModule nm _ _ _) = nm
38tixModuleHash :: TixModule -> Hash
39tixModuleHash (TixModule _ h  _ _) = h
40tixModuleTixs :: TixModule -> [Integer]
41tixModuleTixs (TixModule  _ _ _ tixs) = tixs
42
43-- We /always/ read and write Tix from the current working directory.
44
45-- | Read a @.tix@ File.
46readTix :: String
47        -> IO (Maybe Tix)
48readTix tixFilename =
49  catchIO (fmap (Just . read) $ readFileUtf8 tixFilename)
50          (const $ return Nothing)
51
52-- | Write a @.tix@ File.
53writeTix :: String
54         -> Tix
55         -> IO ()
56writeTix name tix = writeFileUtf8 name (show tix)
57
58-- | 'getTixFullName' takes a binary or @.tix@-file name,
59-- and normalizes it into a @.tix@-file name.
60getTixFileName :: String -> String
61getTixFileName str = replaceExtension str "tix"
62