<commit_before>{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
---------------------------------------------------------------
-- <NAME> and <NAME>, June 2006
---------------------------------------------------------------

-- | Datatypes and file-access routines for the per-module (@.mix@)
-- indexes used by Hpc.
module Trace.Hpc.Mix
        ( Mix(..)
        , MixEntry
        , BoxLabel(..)
        , CondBox(..)
        , mixCreate
        , readMix
        , createMixEntryDom
        , MixEntryDom
        )
  where

import Data.Maybe (catMaybes)
import Data.Time (UTCTime)
import Data.Tree
import Data.Char

-- 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

import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..), catchIO)
import Trace.Hpc.Tix

-- | 'Mix' is the information about a modules static properties, like
-- location of Tix's in a file.
--
-- Tab stops are the size of a tab in the provided /line:column/ values.
--
--  * In GHC, this is 1 (a tab is just a character)
--  * With @hpc-tracer@, this is 8 (a tab represents several spaces).
data Mix = Mix
             FilePath           -- location of original file
             UTCTime            -- time of original file's last update
             Hash               -- hash of mix entry + timestamp
             Int                -- tab stop value.
             [MixEntry]         -- entries
        deriving (Show,Read)

type MixEntry = (HpcPos, BoxLabel)

data BoxLabel = ExpBox  Bool -- isAlt
              | TopLevelBox [String]
              | LocalBox [String]
              | BinBox CondBox Bool
              deriving (Read, Show, Eq, Ord)

data CondBox = GuardBinBox
             | CondBinBox
             | QualBinBox
              deriving (Read, Show, Eq, Ord)

instance HpcHash BoxLabel where
   toHash (ExpBox b)       = 0x100 + toHash b
   toHash (TopLevelBox nm) = 0x200 + toHash nm
   toHash (LocalBox nm)    = 0x300 + toHash nm
   toHash (BinBox cond b)  = 0x400 + toHash (cond,b)

instance HpcHash CondBox where
   toHash GuardBinBox = 0x10
   toHash CondBinBox  = 0x20
   toHash QualBinBox  = 0x30


-- | Create is mix file.
mixCreate :: String -- ^ Dir Name
          -> String -- ^ module Name
          -> Mix    -- ^ Mix DataStructure
          -> IO ()
mixCreate dirName modName mix =
   writeFile (mixName dirName modName) (show mix)

-- | Read a mix file.
readMix :: [String]                 -- ^ Dir Names
        -> Either String TixModule  -- ^ module wanted
        -> IO Mix
readMix dirNames mod' = do
   let modName = case mod' of
                    Left str -> str
                    Right tix -> tixModuleName tix
   res <- sequence [ (do contents <- readFile (mixName dirName modName)
                         case reads contents of
                           [(r@(Mix _ _ h _ _),cs)]
                                | all isSpace cs
                               && (case mod' of
                                     Left  _   -> True
                                     Right tix -> h == tixModuleHash tix
                                  ) -> return $ Just r
                           _ -> return $ Nothing) `catchIO` (\ _ -> return $ Nothing)
                   | dirName <- dirNames
                   ]
   case catMaybes res of
     [r] -> return r
     xs@(_:_) -> error $ "found " ++ show(length xs) ++ " instances of " ++ modName ++ " in " ++ show dirNames
     _        -> error $ "can not find " ++ modName ++ " in " ++ show dirNames

mixName :: FilePath -> String -> String
mixName dirName name = dirName ++ "/" ++ name ++ ".mix"

------------------------------------------------------------------------------

type MixEntryDom a = Tree (HpcPos,a)

-- A good tree has all its children fully inside its parents HpcPos.
-- No child should have the *same* HpcPos.
-- There is no ordering to the children

isGoodNode :: MixEntryDom a -> Bool
isGoodNode (Node (pos,_) sub_nodes) =
      and [ pos' `insideHpcPos` pos  | Node(pos',_)  _ <- sub_nodes ]<commit_msg>Differentiate between missing and unparseable .mix files<commit_after>{-# LANGUAGE CPP #-}
#if __GLASGOW_HASKELL__ >= 709
{-# LANGUAGE Safe #-}
#elif __GLASGOW_HASKELL__ >= 701
{-# LANGUAGE Trustworthy #-}
#endif
---------------------------------------------------------------
-- <NAME> and <NAME>, June 2006
---------------------------------------------------------------

-- | Datatypes and file-access routines for the per-module (@.mix@)
-- indexes used by Hpc.
module Trace.Hpc.Mix
        ( Mix(..)
        , MixEntry
        , BoxLabel(..)
        , CondBox(..)
        , mixCreate
        , readMix
        , createMixEntryDom
        , MixEntryDom
        )
  where

import Control.Monad (forM)
import Data.Maybe (catMaybes)
import Data.Time (UTCTime)
import Data.Tree
import Data.Char
import System.Directory (doesFileExist)

-- 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

import Trace.Hpc.Util (HpcPos, insideHpcPos, Hash, HpcHash(..))
import Trace.Hpc.Tix

-- | 'Mix' is the information about a modules static properties, like
-- location of Tix's in a file.
--
-- Tab stops are the size of a tab in the provided /line:column/ values.
--
--  * In GHC, this is 1 (a tab is just a character)
--  * With @hpc-tracer@, this is 8 (a tab represents several spaces).
data Mix = Mix
             FilePath           -- location of original file
             UTCTime            -- time of original file's last update
             Hash               -- hash of mix entry + timestamp
             Int                -- tab stop value.
             [MixEntry]         -- entries
        deriving (Show,Read)

type MixEntry = (HpcPos, BoxLabel)

data BoxLabel = ExpBox  Bool -- isAlt
              | TopLevelBox [String]
              | LocalBox [String]
              | BinBox CondBox Bool
              deriving (Read, Show, Eq, Ord)

data CondBox = GuardBinBox
             | CondBinBox
             | QualBinBox
              deriving (Read, Show, Eq, Ord)

instance HpcHash BoxLabel where
   toHash (ExpBox b)       = 0x100 + toHash b
   toHash (TopLevelBox nm) = 0x200 + toHash nm
   toHash (LocalBox nm)    = 0x300 + toHash nm
   toHash (BinBox cond b)  = 0x400 + toHash (cond,b)

instance HpcHash CondBox where
   toHash GuardBinBox = 0x10
   toHash CondBinBox  = 0x20
   toHash QualBinBox  = 0x30


-- | Create is mix file.
mixCreate :: String -- ^ Dir Name
          -> String -- ^ module Name
          -> Mix    -- ^ Mix DataStructure
          -> IO ()
mixCreate dirName modName mix =
   writeFile (mixName dirName modName) (show mix)

-- | Read a mix file.
readMix :: [String]                 -- ^ Dir Names
        -> Either String TixModule  -- ^ module wanted
        -> IO Mix
readMix dirNames mod' = do
   let modName = case mod' of
                    Left str -> str
                    Right tix -> tixModuleName tix
       moduleHashMatches h =
         case mod' of
           Left _ -> True
           Right tix -> h == tixModuleHash tix
   res <- forM dirNames $ \dirName -> do
     let mixFile = mixName dirName modName
     mixExists <- doesFileExist mixFile
     if not mixExists then return Nothing
       else do
         contents <- readFile (mixName dirName modName)
         case reads contents of
           [(r@(Mix _ _ h _ _),cs)]
             | all isSpace cs && moduleHashMatches h -> return $ Just r
           _ -> error $ "cannot parse " ++ mixFile
   case catMaybes res of
     [r] -> return r
     xs@(_:_) -> error $ "found " ++ show(length xs) ++ " instances of " ++ modName ++ " in " ++ show dirNames
     _        -> error $ "can not find " ++ modName ++ " in " ++ show dirNames

mixName :: FilePath -> String -> String
mixName dirName name = dirName ++ "/" ++ name ++ ".mix"

------------------------------------------------------------------------------

type MixEntryDom a = Tree (HpcPos,a)

-- A good tree has all its children fully inside its parents HpcPos.
-- No child should have the *same* HpcPos.
-- There is no ordering to the children

isGoodNode :: MixEntryDom a -> Bool
isGoodNode (Node (pos,_) sub_nodes) =
      and [ pos' `insideHpcPos` pos  | Node(pos',_)  _ <- sub_nodes ]
{'fraction_non_alphanumeric': 0.14439962031324158, 'fraction_numerical': 0.008780256288561937, 'mean_word_length': 1.6079826732673268, 'pattern_counts': {'":': 0, '<': 15, '<?xml version=': 0, '>': 47, 'https://': 0, 'lorem ipsum': 0, 'www.': 0, 'xml': 0}, 'pii_count': 0, 'substrings_counts': 0, 'word_list_counts': {'cursed_substrings.json': 6, 'profanity_word_list.json': 0, 'sexual_word_list.json': 0, 'zh_pornsignals.json': 0}}
{'dir': 'git-commits-cleaned', 'id': '6490495', 'n_tokens_mistral': 2498, 'n_tokens_neox': 2380, 'n_words': 853}