{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 702
-- System.FilePath in filepath version 1.2.0.1 isn't marked or implied Safe,
-- as shipped with GHC 7.2.
{-# LANGUAGE Trustworthy #-}
#endif
------------------------------------------------------------
-- Andy Gill and Colin Runciman, June 2006
------------------------------------------------------------

-- | Datatypes and file-access routines for the tick data file
-- (@.tix@) used by Hpc.
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)

-- | 'Tix' is the storage format for our dynamic information about
-- what boxes are ticked.
data Tix = Tix [TixModule]
        deriving (ReadPrec [Tix]
ReadPrec Tix
Int -> ReadS Tix
ReadS [Tix]
(Int -> ReadS Tix)
-> ReadS [Tix] -> ReadPrec Tix -> ReadPrec [Tix] -> Read Tix
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Tix]
$creadListPrec :: ReadPrec [Tix]
readPrec :: ReadPrec Tix
$creadPrec :: ReadPrec Tix
readList :: ReadS [Tix]
$creadList :: ReadS [Tix]
readsPrec :: Int -> ReadS Tix
$creadsPrec :: Int -> ReadS Tix
Instance of class: Read of the constraint type Read TixModule
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read TixModule
Instance of class: Read of the constraint type Read Tix
Read, Int -> Tix -> ShowS
[Tix] -> ShowS
Tix -> String
(Int -> Tix -> ShowS)
-> (Tix -> String) -> ([Tix] -> ShowS) -> Show Tix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Tix] -> ShowS
$cshowList :: [Tix] -> ShowS
show :: Tix -> String
$cshow :: Tix -> String
showsPrec :: Int -> Tix -> ShowS
$cshowsPrec :: Int -> Tix -> ShowS
Instance of class: Show of the constraint type Show TixModule
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Instance of class: Show of the constraint type Show TixModule
Show, Tix -> Tix -> Bool
(Tix -> Tix -> Bool) -> (Tix -> Tix -> Bool) -> Eq Tix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tix -> Tix -> Bool
$c/= :: Tix -> Tix -> Bool
== :: Tix -> Tix -> Bool
$c== :: Tix -> Tix -> Bool
Instance of class: Eq of the constraint type Eq TixModule
External instance of the constraint type forall a. Eq a => Eq [a]
Instance of class: Eq of the constraint type Eq TixModule
Eq)

data TixModule = TixModule
                 String    --  module name
                 Hash      --  hash number
                 Int       --  length of Tix list (allows pre-allocation at parse time).
                 [Integer] --  actual ticks
        deriving (ReadPrec [TixModule]
ReadPrec TixModule
Int -> ReadS TixModule
ReadS [TixModule]
(Int -> ReadS TixModule)
-> ReadS [TixModule]
-> ReadPrec TixModule
-> ReadPrec [TixModule]
-> Read TixModule
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TixModule]
$creadListPrec :: ReadPrec [TixModule]
readPrec :: ReadPrec TixModule
$creadPrec :: ReadPrec TixModule
readList :: ReadS [TixModule]
$creadList :: ReadS [TixModule]
readsPrec :: Int -> ReadS TixModule
$creadsPrec :: Int -> ReadS TixModule
External instance of the constraint type Read Integer
External instance of the constraint type Read Char
External instance of the constraint type Read Integer
External instance of the constraint type Read Int
External instance of the constraint type Read Hash
External instance of the constraint type Read Char
External instance of the constraint type Monad ReadPrec
External instance of the constraint type forall a. Read a => Read [a]
External instance of the constraint type Monad ReadPrec
Instance of class: Read of the constraint type Read TixModule
Read, Int -> TixModule -> ShowS
[TixModule] -> ShowS
TixModule -> String
(Int -> TixModule -> ShowS)
-> (TixModule -> String)
-> ([TixModule] -> ShowS)
-> Show TixModule
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TixModule] -> ShowS
$cshowList :: [TixModule] -> ShowS
show :: TixModule -> String
$cshow :: TixModule -> String
showsPrec :: Int -> TixModule -> ShowS
$cshowsPrec :: Int -> TixModule -> ShowS
External instance of the constraint type Show Integer
External instance of the constraint type Show Char
External instance of the constraint type Show Integer
External instance of the constraint type Show Int
External instance of the constraint type Show Hash
External instance of the constraint type Show Char
External instance of the constraint type forall a. Show a => Show [a]
External instance of the constraint type Ord Int
Show, TixModule -> TixModule -> Bool
(TixModule -> TixModule -> Bool)
-> (TixModule -> TixModule -> Bool) -> Eq TixModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TixModule -> TixModule -> Bool
$c/= :: TixModule -> TixModule -> Bool
== :: TixModule -> TixModule -> Bool
$c== :: TixModule -> TixModule -> Bool
External instance of the constraint type Eq Integer
External instance of the constraint type Eq Char
External instance of the constraint type Eq Integer
External instance of the constraint type Eq Int
External instance of the constraint type Eq Hash
External instance of the constraint type Eq Char
External instance of the constraint type forall a. Eq a => Eq [a]
Eq)

-- TODO: Turn extractors below into proper 'TixModule' field-labels
tixModuleName :: TixModule -> String
tixModuleName :: TixModule -> String
tixModuleName (TixModule String
nm Hash
_ Int
_ [Integer]
_) = String
nm
tixModuleHash :: TixModule -> Hash
tixModuleHash :: TixModule -> Hash
tixModuleHash (TixModule String
_ Hash
h  Int
_ [Integer]
_) = Hash
h
tixModuleTixs :: TixModule -> [Integer]
tixModuleTixs :: TixModule -> [Integer]
tixModuleTixs (TixModule  String
_ Hash
_ Int
_ [Integer]
tixs) = [Integer]
tixs

-- We /always/ read and write Tix from the current working directory.

-- | Read a @.tix@ File.
readTix :: String
        -> IO (Maybe Tix)
readTix :: String -> IO (Maybe Tix)
readTix String
tixFilename =
  IO (Maybe Tix) -> (IOException -> IO (Maybe Tix)) -> IO (Maybe Tix)
forall a. IO a -> (IOException -> IO a) -> IO a
catchIO ((String -> Maybe Tix) -> IO String -> IO (Maybe Tix)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
External instance of the constraint type Functor IO
fmap (Tix -> Maybe Tix
forall a. a -> Maybe a
Just (Tix -> Maybe Tix) -> (String -> Tix) -> String -> Maybe Tix
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Tix
forall a. Read a => String -> a
Instance of class: Read of the constraint type Read Tix
read) (IO String -> IO (Maybe Tix)) -> IO String -> IO (Maybe Tix)
forall a b. (a -> b) -> a -> b
$ String -> IO String
readFileUtf8 String
tixFilename)
          (IO (Maybe Tix) -> IOException -> IO (Maybe Tix)
forall a b. a -> b -> a
const (IO (Maybe Tix) -> IOException -> IO (Maybe Tix))
-> IO (Maybe Tix) -> IOException -> IO (Maybe Tix)
forall a b. (a -> b) -> a -> b
$ Maybe Tix -> IO (Maybe Tix)
forall (m :: * -> *) a. Monad m => a -> m a
External instance of the constraint type Monad IO
return Maybe Tix
forall a. Maybe a
Nothing)

-- | Write a @.tix@ File.
writeTix :: String
         -> Tix
         -> IO ()
writeTix :: String -> Tix -> IO ()
writeTix String
name Tix
tix = String -> String -> IO ()
writeFileUtf8 String
name (Tix -> String
forall a. Show a => a -> String
Instance of class: Show of the constraint type Show Tix
show Tix
tix)

-- | 'getTixFullName' takes a binary or @.tix@-file name,
-- and normalizes it into a @.tix@-file name.
getTixFileName :: String -> String
getTixFileName :: ShowS
getTixFileName String
str = String -> ShowS
replaceExtension String
str String
"tix"