{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 704
{-# LANGUAGE Safe, DeriveGeneric, StandaloneDeriving #-}
#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

#if __GLASGOW_HASKELL__ >= 704
import GHC.Generics (Generic)
import Control.DeepSeq (NFData)
#endif

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
$creadsPrec :: Int -> ReadS Tix
readsPrec :: Int -> ReadS Tix
$creadList :: ReadS [Tix]
readList :: ReadS [Tix]
$creadPrec :: ReadPrec Tix
readPrec :: ReadPrec Tix
$creadListPrec :: ReadPrec [Tix]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> Tix -> ShowS
showsPrec :: Int -> Tix -> ShowS
$cshow :: Tix -> String
show :: Tix -> String
$cshowList :: [Tix] -> ShowS
showList :: [Tix] -> ShowS
Show, Tix -> Tix -> Bool
(Tix -> Tix -> Bool) -> (Tix -> Tix -> Bool) -> Eq Tix
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Tix -> Tix -> Bool
== :: Tix -> Tix -> Bool
$c/= :: Tix -> Tix -> Bool
/= :: Tix -> Tix -> Bool
Eq)

#if __GLASGOW_HASKELL__ >= 704
-- | @since 0.6.2.0
deriving instance (Generic Tix)
-- | @since 0.6.2.0
instance NFData Tix
#endif

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
$creadsPrec :: Int -> ReadS TixModule
readsPrec :: Int -> ReadS TixModule
$creadList :: ReadS [TixModule]
readList :: ReadS [TixModule]
$creadPrec :: ReadPrec TixModule
readPrec :: ReadPrec TixModule
$creadListPrec :: ReadPrec [TixModule]
readListPrec :: ReadPrec [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
$cshowsPrec :: Int -> TixModule -> ShowS
showsPrec :: Int -> TixModule -> ShowS
$cshow :: TixModule -> String
show :: TixModule -> String
$cshowList :: [TixModule] -> ShowS
showList :: [TixModule] -> ShowS
Show, TixModule -> TixModule -> Bool
(TixModule -> TixModule -> Bool)
-> (TixModule -> TixModule -> Bool) -> Eq TixModule
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TixModule -> TixModule -> Bool
== :: TixModule -> TixModule -> Bool
$c/= :: TixModule -> TixModule -> Bool
/= :: TixModule -> TixModule -> Bool
Eq)

#if __GLASGOW_HASKELL__ >= 704
-- | @since 0.6.2.0
deriving instance (Generic TixModule)
-- | @since 0.6.2.0
instance NFData TixModule
#endif

-- 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 a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
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
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 a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
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
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"