----------------------------------------------------------------
--- Datatypes and file-access routines for the per-module (.mix)
--- indexes used by Hpc.
--- Colin Runciman and Andy Gill, June 2006
----------------------------------------------------------------
-
--- a module index records the attributes of each tick-box that has
--- been introduced in that module, accessed by tick-number position
--- in the list
-
-data Mix = Mix
- FilePath -- location of original file
- Integer -- time (in seconds) of original file's last update, since 1970.
- Int -- tab stop value
- [MixEntry] -- entries
- deriving (Show,Read)
-
--- We would rather use ClockTime in Mix, but ClockTime has no Read instance in 6.4 and before,
--- but does in 6.6. Definining the instance for ClockTime here is the Wrong Thing to do,
--- because if some other program also defined that instance, we will not be able to compile.
-
-type MixEntry = (HpcPos, BoxLabel)
-
-data BoxLabel = ExpBox
- | AltBox
- | TopLevelBox [String]
- | LocalBox [String]
- -- | UserBox (Maybe String)
- | GuardBinBox Bool
- | CondBinBox Bool
- | QualBinBox Bool
- -- | PreludeBinBox String Bool
- -- | UserBinBox (Maybe String) Bool
- deriving (Read, Show)
-
-mixCreate :: String -> String -> Mix -> IO ()
-mixCreate dirName modName mix =
- writeFile (mixName dirName modName) (show mix)
-
-readMix :: FilePath -> String -> IO Mix
-readMix dirName modName = do
- contents <- readFile (mixName dirName modName)
- return (read contents)
-
-mixName :: FilePath -> String -> String
-mixName dirName name = dirName ++ "/" ++ name ++ ".mix"
-
-getModificationTime' :: FilePath -> IO Integer
-getModificationTime' file = do
- (TOD sec _) <- System.Directory.getModificationTime file
- return $ sec
-
-data Tix = Tix [PixEntry] -- The number of tickboxes in each module
- [TixEntry] -- The tick boxes
- deriving (Read, Show,Eq)
-
-type TixEntry = Integer
-
--- always read and write Tix from the current working directory.
-
-readTix :: String -> IO (Maybe Tix)
-readTix pname =
- catch (do contents <- readFile $ tixName pname
- return $ Just $ read contents)
- (\ _ -> return $ Nothing)
-
-writeTix :: String -> Tix -> IO ()
-writeTix pname tix =
- writeFile (tixName pname) (show tix)
-
-tixName :: String -> String
-tixName name = name ++ ".tix"
-
--- a program index records module names and numbers of tick-boxes
--- introduced in each module that has been transformed for coverage
-
-data Pix = Pix [PixEntry] deriving (Read, Show)
-
-type PixEntry = ( String -- module name
- , Int -- number of boxes
- )
-
-pixUpdate :: FilePath -> String -> String -> Int -> IO ()
-pixUpdate dirName progName modName boxCount = do
- fileUpdate (pixName dirName progName) pixAssign (Pix [])
- where
- pixAssign :: Pix -> Pix
- pixAssign (Pix pes) =
- Pix ((modName,boxCount) : filter ((/=) modName . fst) pes)
-
-readPix :: FilePath -> String -> IO Pix
-readPix dirName pname = do
- contents <- readFile (pixName dirName pname)
- return (read contents)
-
-tickCount :: Pix -> Int
-tickCount (Pix mp) = sum $ map snd mp
-
-pixName :: FilePath -> String -> String
-pixName dirName name = dirName ++ "/" ++ name ++ ".pix"
-
--- updating a value stored in a file via read and show
-fileUpdate :: (Read a, Show a) => String -> (a->a) -> a -> IO()
-fileUpdate fname update init =
- catch
- (do
- valueText <- readFile fname
- ( case finite valueText of
- True ->
- writeFile fname (show (update (read valueText))) ))
- (const (writeFile fname (show (update init))))
-
-finite :: [a] -> Bool
-finite [] = True
-finite (x:xs) = finite xs
-
-data HpcPos = P !Int !Int !Int !Int deriving (Eq)
-
-fromHpcPos :: HpcPos -> (Int,Int,Int,Int)
-fromHpcPos (P l1 c1 l2 c2) = (l1,c1,l2,c2)
-
-toHpcPos :: (Int,Int,Int,Int) -> HpcPos
-toHpcPos (l1,c1,l2,c2) = P l1 c1 l2 c2
-
-instance Show HpcPos where
- show (P l1 c1 l2 c2) = show l1 ++ ':' : show c1 ++ '-' : show l2 ++ ':' : show c2
-
-instance Read HpcPos where
- readsPrec _i pos = [(toHpcPos (read l1,read c1,read l2,read c2),after)]
- where
- (before,after) = span (/= ',') pos
- (lhs,rhs) = case span (/= '-') before of
- (lhs,'-':rhs) -> (lhs,rhs)
- (lhs,"") -> (lhs,lhs)
- (l1,':':c1) = span (/= ':') lhs
- (l2,':':c2) = span (/= ':') rhs