    {-# LANGUAGE CPP #-}

    #if __GLASGOW_HASKELL__ >= 704
    {-# LANGUAGE DeriveGeneric, StandaloneDeriving #-}
    #endif

    -- Starting from directory-1.3.8.0 "System.Directory" is no longer Safe.
    #if __GLASGOW_HASKELL__ >= 704 && !MIN_VERSION_directory(1,3,8)
    {-# LANGUAGE Safe #-}
    #elif __GLASGOW_HASKELL__ >= 702
    {-# LANGUAGE Trustworthy #-}
    #endif

    -----------------------------------------
    -- Andy Gill and Colin Runciman, June 2006
    ------------------------------------------

    -- | Minor utilities for the HPC tools.

    module Trace.Hpc.Util
           ( HpcPos
           , fromHpcPos
           , toHpcPos
           , insideHpcPos
           , HpcHash(..)
           , Hash
           , catchIO
           , readFileUtf8
           , writeFileUtf8
           ) where

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

    import Control.DeepSeq (deepseq, NFData)
    import qualified Control.Exception as Exception
    import Data.List(foldl')
    import Data.Char (ord)
    import Data.Bits (xor)
    import Data.Word
    import System.Directory (createDirectoryIfMissing)
    import System.FilePath (takeDirectory)
    import System.IO

    -- | 'HpcPos' is an Hpc local rendition of a Span.
    data HpcPos = P !Int !Int !Int !Int deriving (HpcPos -> HpcPos -> Bool
    (HpcPos -> HpcPos -> Bool)
    -> (HpcPos -> HpcPos -> Bool) -> Eq HpcPos
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: HpcPos -> HpcPos -> Bool
    == :: HpcPos -> HpcPos -> Bool
    $c/= :: HpcPos -> HpcPos -> Bool
    /= :: HpcPos -> HpcPos -> Bool
    Eq, Eq HpcPos
    Eq HpcPos =>
    (HpcPos -> HpcPos -> Ordering)
    -> (HpcPos -> HpcPos -> Bool)
    -> (HpcPos -> HpcPos -> Bool)
    -> (HpcPos -> HpcPos -> Bool)
    -> (HpcPos -> HpcPos -> Bool)
    -> (HpcPos -> HpcPos -> HpcPos)
    -> (HpcPos -> HpcPos -> HpcPos)
    -> Ord HpcPos
    HpcPos -> HpcPos -> Bool
    HpcPos -> HpcPos -> Ordering
    HpcPos -> HpcPos -> HpcPos
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: HpcPos -> HpcPos -> Ordering
    compare :: HpcPos -> HpcPos -> Ordering
    $c< :: HpcPos -> HpcPos -> Bool
    < :: HpcPos -> HpcPos -> Bool
    $c<= :: HpcPos -> HpcPos -> Bool
    <= :: HpcPos -> HpcPos -> Bool
    $c> :: HpcPos -> HpcPos -> Bool
    > :: HpcPos -> HpcPos -> Bool
    $c>= :: HpcPos -> HpcPos -> Bool
    >= :: HpcPos -> HpcPos -> Bool
    $cmax :: HpcPos -> HpcPos -> HpcPos
    max :: HpcPos -> HpcPos -> HpcPos
    $cmin :: HpcPos -> HpcPos -> HpcPos
    min :: HpcPos -> HpcPos -> HpcPos
    Ord)

    -- | 'fromHpcPos' explodes the HpcPos into /line:column/-/line:column/
    fromHpcPos :: HpcPos -> (Int,Int,Int,Int)
    fromHpcPos :: HpcPos -> (Int, Int, Int, Int)
    fromHpcPos (P Int
    l1 Int
    c1 Int
    l2 Int
    c2) = (Int
    l1,Int
    c1,Int
    l2,Int
    c2)

    -- | 'toHpcPos' implodes to HpcPos, from /line:column/-/line:column/
    toHpcPos :: (Int,Int,Int,Int) -> HpcPos
    toHpcPos :: (Int, Int, Int, Int) -> HpcPos
    toHpcPos (Int
    l1,Int
    c1,Int
    l2,Int
    c2) = Int -> Int -> Int -> Int -> HpcPos
    P Int
    l1 Int
    c1 Int
    l2 Int
    c2

    -- | Predicate determining whether the first argument is inside the second argument.
    insideHpcPos :: HpcPos -> HpcPos -> Bool
    insideHpcPos :: HpcPos -> HpcPos -> Bool
    insideHpcPos HpcPos
    small HpcPos
    big =
                 Int
    sl1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    bl1 Bool -> Bool -> Bool
    &&
                 (Int
    sl1 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    bl1 Bool -> Bool -> Bool
    || Int
    sc1 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    bc1) Bool -> Bool -> Bool
    &&
                 Int
    sl2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    bl2 Bool -> Bool -> Bool
    &&
                 (Int
    sl2 Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Int
    bl2 Bool -> Bool -> Bool
    || Int
    sc2 Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    bc2)
      where (Int
    sl1,Int
    sc1,Int
    sl2,Int
    sc2) = HpcPos -> (Int, Int, Int, Int)
    fromHpcPos HpcPos
    small
            (Int
    bl1,Int
    bc1,Int
    bl2,Int
    bc2) = HpcPos -> (Int, Int, Int, Int)
    fromHpcPos HpcPos
    big

    instance Show HpcPos where
       show :: HpcPos -> String
    show (P Int
    l1 Int
    c1 Int
    l2 Int
    c2) = Int -> String
    forall a. Show a => a -> String
    show Int
    l1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    ':' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    c1 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    '-' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    l2 String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Char
    ':' Char -> ShowS
    forall a. a -> [a] -> [a]
    : Int -> String
    forall a. Show a => a -> String
    show Int
    c2

    instance Read HpcPos where
      readsPrec :: Int -> ReadS HpcPos
    readsPrec Int
    _i String
    pos = [((Int, Int, Int, Int) -> HpcPos
    toHpcPos (String -> Int
    forall a. Read a => String -> a
    read String
    l1,String -> Int
    forall a. Read a => String -> a
    read String
    c1,String -> Int
    forall a. Read a => String -> a
    read String
    l2,String -> Int
    forall a. Read a => String -> a
    read String
    c2),String
    after)]
          where
             (String
    before,String
    after) = (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ',') String
    pos
             parseError :: a -> a
    parseError a
    a   = String -> a
    forall a. HasCallStack => String -> a
    error (String -> a) -> String -> a
    forall a b. (a -> b) -> a -> b
    $ String
    "Read HpcPos: Could not parse: " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show a
    a
             (String
    lhs0,String
    rhs0)    = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '-') String
    before of
                                   (String
    lhs,Char
    '-':String
    rhs) -> (String
    lhs,String
    rhs)
                                   (String
    lhs,String
    "")      -> (String
    lhs,String
    lhs)
                                   (String, String)
    _ -> String -> (String, String)
    forall {a} {a}. Show a => a -> a
    parseError String
    before
             (String
    l1,String
    c1)        = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':') String
    lhs0 of
                                (String
    l,Char
    ':':String
    c) -> (String
    l,String
    c)
                                (String, String)
    _ -> String -> (String, String)
    forall {a} {a}. Show a => a -> a
    parseError String
    lhs0
             (String
    l2,String
    c2)        = case (Char -> Bool) -> String -> (String, String)
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    span (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ':') String
    rhs0 of
                                (String
    l,Char
    ':':String
    c) -> (String
    l,String
    c)
                                (String, String)
    _ -> String -> (String, String)
    forall {a} {a}. Show a => a -> a
    parseError String
    rhs0

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

    -- Very simple Hash number generators

    class HpcHash a where
      toHash :: a -> Hash

    newtype Hash = Hash Word32 deriving (Hash -> Hash -> Bool
    (Hash -> Hash -> Bool) -> (Hash -> Hash -> Bool) -> Eq Hash
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Hash -> Hash -> Bool
    == :: Hash -> Hash -> Bool
    $c/= :: Hash -> Hash -> Bool
    /= :: Hash -> Hash -> Bool
    Eq)

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

    instance Read Hash where
      readsPrec :: Int -> ReadS Hash
    readsPrec Int
    p String
    n = [ (Word32 -> Hash
    Hash Word32
    v,String
    rest)
                      | (Word32
    v,String
    rest) <- Int -> ReadS Word32
    forall a. Read a => Int -> ReadS a
    readsPrec Int
    p String
    n
                      ]

    instance Show Hash where
      showsPrec :: Int -> Hash -> ShowS
    showsPrec Int
    p (Hash Word32
    n) = Int -> Word32 -> ShowS
    forall a. Show a => Int -> a -> ShowS
    showsPrec Int
    p Word32
    n

    instance Num Hash where
      (Hash Word32
    a) + :: Hash -> Hash -> Hash
    + (Hash Word32
    b) = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32
    a Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    + Word32
    b
      (Hash Word32
    a) * :: Hash -> Hash -> Hash
    * (Hash Word32
    b) = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32
    a Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    * Word32
    b
      (Hash Word32
    a) - :: Hash -> Hash -> Hash
    - (Hash Word32
    b) = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32
    a Word32 -> Word32 -> Word32
    forall a. Num a => a -> a -> a
    - Word32
    b
      negate :: Hash -> Hash
    negate (Hash Word32
    a)     = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32
    forall a. Num a => a -> a
    negate Word32
    a
      abs :: Hash -> Hash
    abs (Hash Word32
    a)        = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32
    forall a. Num a => a -> a
    abs Word32
    a
      signum :: Hash -> Hash
    signum (Hash Word32
    a)     = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32 -> Word32
    forall a. Num a => a -> a
    signum Word32
    a
      fromInteger :: Integer -> Hash
    fromInteger Integer
    n       = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Integer -> Word32
    forall a. Num a => Integer -> a
    fromInteger Integer
    n

    instance HpcHash Int where
      toHash :: Int -> Hash
    toHash Int
    n = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Int
    n

    instance HpcHash Integer where
      toHash :: Integer -> Hash
    toHash Integer
    n = Integer -> Hash
    forall a. Num a => Integer -> a
    fromInteger Integer
    n

    instance HpcHash Char where
      toHash :: Char -> Hash
    toHash Char
    c = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Char -> Int
    ord Char
    c

    instance HpcHash Bool where
      toHash :: Bool -> Hash
    toHash Bool
    True  = Hash
    1
      toHash Bool
    False = Hash
    0

    instance HpcHash a => HpcHash [a] where
      toHash :: [a] -> Hash
    toHash [a]
    xs = (Hash -> a -> Hash) -> Hash -> [a] -> Hash
    forall b a. (b -> a -> b) -> b -> [a] -> b
    forall (t :: * -> *) b a.
    Foldable t =>
    (b -> a -> b) -> b -> t a -> b
    foldl' (\ Hash
    h a
    c -> a -> Hash
    forall a. HpcHash a => a -> Hash
    toHash a
    c Hash -> Hash -> Hash
    `hxor` (Hash
    h Hash -> Hash -> Hash
    forall a. Num a => a -> a -> a
    * Hash
    33)) Hash
    5381 [a]
    xs

    instance (HpcHash a,HpcHash b) => HpcHash (a,b) where
      toHash :: (a, b) -> Hash
    toHash (a
    a,b
    b) = (a -> Hash
    forall a. HpcHash a => a -> Hash
    toHash a
    a Hash -> Hash -> Hash
    forall a. Num a => a -> a -> a
    * Hash
    33) Hash -> Hash -> Hash
    `hxor` b -> Hash
    forall a. HpcHash a => a -> Hash
    toHash b
    b

    instance HpcHash HpcPos where
      toHash :: HpcPos -> Hash
    toHash (P Int
    a Int
    b Int
    c Int
    d) = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Int -> Word32
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> Word32) -> Int -> Word32
    forall a b. (a -> b) -> a -> b
    $ Int
    a Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    0x1000000 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    b Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    0x10000 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    c Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    0x100 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    d

    hxor :: Hash -> Hash -> Hash
    hxor :: Hash -> Hash -> Hash
    hxor (Hash Word32
    x) (Hash Word32
    y) = Word32 -> Hash
    Hash (Word32 -> Hash) -> Word32 -> Hash
    forall a b. (a -> b) -> a -> b
    $ Word32
    x Word32 -> Word32 -> Word32
    forall a. Bits a => a -> a -> a
    `xor` Word32
    y

    catchIO :: IO a -> (Exception.IOException -> IO a) -> IO a
    catchIO :: forall a. IO a -> (IOException -> IO a) -> IO a
    catchIO = IO a -> (IOException -> IO a) -> IO a
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    Exception.catch

    -- | Read a file strictly, as opposed to how `readFile` does it using lazy IO, but also
    -- disregard system locale and assume that the file is encoded in UTF-8. Haskell source
    -- files are expected to be encoded in UTF-8 by GHC.
    readFileUtf8 :: FilePath -> IO String
    readFileUtf8 :: String -> IO String
    readFileUtf8 String
    filepath =
      String -> IOMode -> (Handle -> IO String) -> IO String
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    filepath IOMode
    ReadMode ((Handle -> IO String) -> IO String)
    -> (Handle -> IO String) -> IO String
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    h TextEncoding
    utf8  -- see #17073
        String
    contents <- Handle -> IO String
    hGetContents Handle
    h
        String
    contents String -> IO () -> IO ()
    forall a b. NFData a => a -> b -> b
    `deepseq` Handle -> IO ()
    hClose Handle
    h -- prevent lazy IO
        String -> IO String
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    contents

    -- | Write file in UTF-8 encoding. Parent directory will be created if missing.
    writeFileUtf8 :: FilePath -> String -> IO ()
    writeFileUtf8 :: String -> String -> IO ()
    writeFileUtf8 String
    filepath String
    str = do
      Bool -> String -> IO ()
    createDirectoryIfMissing Bool
    True (ShowS
    takeDirectory String
    filepath)
      String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withBinaryFile String
    filepath IOMode
    WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ \Handle
    h -> do
        Handle -> TextEncoding -> IO ()
    hSetEncoding Handle
    h TextEncoding
    utf8  -- see #17073
        Handle -> String -> IO ()
    hPutStr Handle
    h String
    str