-- |
-- Module             : Trace.Hpc.Utils
-- Description        : Utility functions for hpc-bin
-- License            : BSD-3-Clause
module Trace.Hpc.Utils where

import qualified Data.Map as Map
import qualified Data.Set as Set
import System.FilePath
import Trace.Hpc.Flags
import Trace.Hpc.Tix
import Trace.Hpc.Util

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

-- Spec: dropWhileEndLE p = reverse . dropWhile p . reverse
-- turns \n into ' '
dropWhileEndLE :: (a -> Bool) -> [a] -> [a]
dropWhileEndLE p = foldr (\x r -> if null r && p x then [] else x : r) []

-- | grab's the text behind a HpcPos;
grabHpcPos :: Map.Map Int String -> HpcPos -> String
grabHpcPos hsMap srcspan =
  case lns of
    [] -> error "grabHpcPos: invalid source span"
    [ln] ->
      take ((c2 - c1) + 1) $ drop (c1 - 1) ln
    hd : tl ->
      let lns1 = drop (c1 - 1) hd : tl
          lns2 = init lns1 ++ [take (c2 + 1) (last lns1)]
       in foldl1 (\xs ys -> xs ++ "\n" ++ ys) lns2
  where
    (l1, c1, l2, c2) = fromHpcPos srcspan
    lns =
      map
        ( \n -> case Map.lookup n hsMap of
            Just ln -> ln
            Nothing -> error $ "bad line number : " ++ show n
        )
        [l1 .. l2]

readFileFromPath :: (String -> IO String) -> String -> [String] -> IO String
readFileFromPath _ filename@('/' : _) _ = readFileUtf8 filename
readFileFromPath err filename path0 = readTheFile path0
  where
    readTheFile [] =
      err $
        "could not find "
          ++ show filename
          ++ " in path "
          ++ show path0
    readTheFile (dir : dirs) =
      catchIO
        (readFileUtf8 (dir </> filename))
        (\_ -> readTheFile dirs)

mergeTix :: MergeFun -> (Integer -> Integer -> Integer) -> Tix -> Tix -> Tix
mergeTix modComb f (Tix t1) (Tix t2) =
  Tix
    [ case (Map.lookup m fm1, Map.lookup m fm2) of
        -- todo, revisit the semantics of this combination
        (Just (TixModule _ hash1 len1 tix1), Just (TixModule _ hash2 len2 tix2))
          | hash1 /= hash2
              || length tix1 /= length tix2
              || len1 /= length tix1
              || len2 /= length tix2 ->
              error $ "mismatched in module " ++ m
          | otherwise ->
              TixModule m hash1 len1 (zipWith f tix1 tix2)
        (Just m1, Nothing) ->
          m1
        (Nothing, Just m2) ->
          m2
        _ -> error "impossible"
      | m <- Set.toList (theMergeFun modComb m1s m2s)
    ]
  where
    m1s = Set.fromList $ map tixModuleName t1
    m2s = Set.fromList $ map tixModuleName t2

    fm1 = Map.fromList [(tixModuleName tix, tix) | tix <- t1]
    fm2 = Map.fromList [(tixModuleName tix, tix) | tix <- t2]
