From c67a6ae2fa4ae306dfbafb1e8ddd2e2ab1fb8bee Mon Sep 17 00:00:00 2001
From: BinderDavid <dbinder1989@googlemail.com>
Date: Fri, 29 Sep 2023 16:25:52 +0000
Subject: [PATCH] Refactor ShowTix and add export list to Lexer
---
src/Trace/Hpc/Lexer.hs | 11 +----
src/Trace/Hpc/ShowTix.hs | 96 ++++++++++++++++++++++++++--------------
2 files changed, 64 insertions(+), 43 deletions(-)
diff --git a/src/Trace/Hpc/Lexer.hs b/src/Trace/Hpc/Lexer.hs
index fe41c46..b25bf08 100644
--- a/src/Trace/Hpc/Lexer.hs
+++ b/src/Trace/Hpc/Lexer.hs
@@ -2,11 +2,9 @@
-- Module : Trace.Hpc.Lexer
-- Description : A lexer for overlay files use by @hpc overlay@
-- License : BSD-3-Clause
-module Trace.Hpc.Lexer where
+module Trace.Hpc.Lexer (Token (..), initLexer) where
-import Data.Char
-
-------------------------------------------------------------------------------
+import Data.Char (isAlpha, isDigit, isSpace)
data Token
= ID String
@@ -55,8 +53,3 @@ lexerCAT (c : cs) s line column
| c == ']' = (line, column, CAT s) : lexer cs line (succ column)
| otherwise = lexerCAT cs (s ++ [c]) line (succ column)
lexerCAT [] _ _ _ = error "lexer failure in CAT"
-
-test :: IO ()
-test = do
- t <- readFile "EXAMPLE.tc"
- print (initLexer t)
diff --git a/src/Trace/Hpc/ShowTix.hs b/src/Trace/Hpc/ShowTix.hs
index 4eeb956..48e787b 100644
--- a/src/Trace/Hpc/ShowTix.hs
+++ b/src/Trace/Hpc/ShowTix.hs
@@ -4,13 +4,30 @@
-- License : BSD-3-Clause
module Trace.Hpc.ShowTix (showtixPlugin) where
+import Control.Monad (forM, forM_)
import qualified Data.Set as Set
import Trace.Hpc.Flags
-import Trace.Hpc.Mix
-import Trace.Hpc.Plugin
+ ( FlagOptSeq,
+ Flags (includeMods),
+ allowModule,
+ excludeOpt,
+ hpcDirOpt,
+ includeOpt,
+ outputOpt,
+ readMixWithFlags,
+ resetHpcDirsOpt,
+ srcDirOpt,
+ verbosityOpt,
+ )
+import Trace.Hpc.Mix (Mix (..), MixEntry)
+import Trace.Hpc.Plugin (Plugin (..), hpcError)
import Trace.Hpc.Tix
-
-------------------------------------------------------------------------------
+ ( Tix (Tix),
+ TixModule (..),
+ getTixFileName,
+ readTix,
+ tixModuleName,
+ )
showtixOptions :: FlagOptSeq
showtixOptions =
@@ -42,35 +59,46 @@ showtixMain flags (prog : modNames) = do
Nothing ->
hpcError showtixPlugin $ "could not read .tix file : " ++ prog
Just (Tix tixs) -> do
- tixs_mixs <-
- sequence
- [ do
- mix <- readMixWithFlags hpcflags1 (Right tix)
- return (tix, mix)
- | tix <- tixs,
- allowModule hpcflags1 (tixModuleName tix)
- ]
+ -- Filter out TixModule's we are not interested in.
+ let tixs_filtered = filter (allowModule hpcflags1 . tixModuleName) tixs
+ -- Read the corresponding Mix file for each TixModule
+ tixs_mixs <- forM tixs_filtered $ \tix -> do
+ mix <- readMixWithFlags hpcflags1 (Right tix)
+ pure (tix, mix)
+
+ forM_ tixs_mixs printTixModule
+
+printTixModule ::
+ -- | A TixModule and the corresponding Mix-file
+ (TixModule, Mix) ->
+ IO ()
+printTixModule (TixModule modName _ _ tixs, Mix _ _ _ _ entries) = do
+ let enumerated :: [(Int, Integer, MixEntry)]
+ enumerated = zip3 [(0 :: Int) ..] tixs entries
+
+ forM_ enumerated $ \(ix, count, (pos, lab)) -> do
+ putStrLn
+ ( rjust 5 (show ix)
+ ++ " "
+ ++ rjust 10 (show count)
+ ++ " "
+ ++ ljust 20 modName
+ ++ " "
+ ++ rjust 20 (show pos)
+ ++ " "
+ ++ show lab
+ )
- let rjust n str = replicate (n - length str) ' ' ++ str
- let ljust n str = str ++ replicate (n - length str) ' '
+-- | Pad input with space on the left.
+--
+-- >>> rjust 10 "hi"
+-- " hi"
+rjust :: Int -> String -> String
+rjust n str = replicate (n - length str) ' ' ++ str
- sequence_
- [ sequence_
- [ putStrLn
- ( rjust 5 (show ix)
- ++ " "
- ++ rjust 10 (show count)
- ++ " "
- ++ ljust 20 modName
- ++ " "
- ++ rjust 20 (show pos)
- ++ " "
- ++ show lab
- )
- | (count, ix, (pos, lab)) <- zip3 tixs' [(0 :: Int) ..] entries
- ]
- | ( TixModule modName _hash1 _ tixs',
- Mix _file _timestamp _hash2 _tab entries
- ) <-
- tixs_mixs
- ]
+-- | Pad input with space on the right.
+--
+-- >>> ljust 10 "hi"
+-- "hi "
+ljust :: Int -> String -> String
+ljust n str = str ++ replicate (n - length str) ' '
--
GitLab