module GHC.Iface.Ext.Binary.Header (
  extractSourceFileName
, HieHeader
, readHieFileHeader
) where

import Control.Monad
import Data.Word
import Data.ByteString (ByteString, pack)
import Data.ByteString.Internal (w2c)
import GHC.Settings.Utils (maybeRead)

import GHC.Iface.Ext.Binary.Utils

hieMagic :: [Word8]
hieMagic :: [Word8]
hieMagic = [Word8
72,Word8
73,Word8
69]

hieMagicLen :: Int
hieMagicLen :: Int
hieMagicLen = Int
3

newline :: Word8
newline :: Word8
newline = Word8
10

extractSourceFileName :: ReadBinHandle -> IO FilePath
extractSourceFileName :: ReadBinHandle -> IO FilePath
extractSourceFileName ReadBinHandle
bh0 = do
  ReadBinHandle -> Int -> IO ()
advance ReadBinHandle
bh0 Int
hieMagicLen
  IO ()
skipLine
  IO ()
skipLine
  ReadBinHandle -> Int -> IO ()
advance ReadBinHandle
bh0 Int
8
  forall a. Binary a => ReadBinHandle -> IO a
get @FilePath ReadBinHandle
bh0
  where
    skipLine :: IO ()
    skipLine :: IO ()
skipLine = do
      Word8
c <- forall a. Binary a => ReadBinHandle -> IO a
get @Word8 ReadBinHandle
bh0
      if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newline
      then () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      else IO ()
skipLine

type HieHeader = (Integer, ByteString)

readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader
readHieFileHeader :: FilePath -> ReadBinHandle -> IO HieHeader
readHieFileHeader FilePath
file ReadBinHandle
bh0 = do
  [Word8]
magic <- Int -> IO Word8 -> IO [Word8]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
hieMagicLen (ReadBinHandle -> IO Word8
forall a. Binary a => ReadBinHandle -> IO a
get ReadBinHandle
bh0)
  FilePath
version <- (Word8 -> Char) -> [Word8] -> FilePath
forall a b. (a -> b) -> [a] -> [b]
map Word8 -> Char
w2c ([Word8] -> FilePath) -> IO [Word8] -> IO FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Word8]
takeLine
  case FilePath -> Maybe Integer
forall a. Read a => FilePath -> Maybe a
maybeRead FilePath
version of
    Maybe Integer
Nothing -> do
      FilePath -> IO HieHeader
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO HieHeader) -> FilePath -> IO HieHeader
forall a b. (a -> b) -> a -> b
$ FilePath
"readHieFileHeader: hieVersion isn't an Integer: " FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> FilePath -> FilePath
forall a. Show a => a -> FilePath
show FilePath
version
    Just Integer
hieVersion -> do
      ByteString
ghcVersion <- [Word8] -> ByteString
pack ([Word8] -> ByteString) -> IO [Word8] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO [Word8]
takeLine
      Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when ([Word8]
magic [Word8] -> [Word8] -> Bool
forall a. Eq a => a -> a -> Bool
/= [Word8]
hieMagic) (IO () -> IO ()) -> (FilePath -> IO ()) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO ()
forall a. FilePath -> IO a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
unwords [
          FilePath
"readHieFileHeader: headers don't match for file:"
        , FilePath
file
        , FilePath
"Expected"
        , [Word8] -> FilePath
forall a. Show a => a -> FilePath
show [Word8]
hieMagic
        , FilePath
"but got", [Word8] -> FilePath
forall a. Show a => a -> FilePath
show [Word8]
magic
        ]
      HieHeader -> IO HieHeader
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Integer
hieVersion, ByteString
ghcVersion)
  where
    takeLine :: IO [Word8]
    takeLine :: IO [Word8]
takeLine = [Word8] -> [Word8]
forall a. [a] -> [a]
reverse ([Word8] -> [Word8]) -> IO [Word8] -> IO [Word8]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> IO [Word8]
loop []
      where
        loop :: [Word8] -> IO [Word8]
        loop :: [Word8] -> IO [Word8]
loop [Word8]
acc = do
          Word8
c <- forall a. Binary a => ReadBinHandle -> IO a
get @Word8 ReadBinHandle
bh0
          if Word8
c Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
newline
          then [Word8] -> IO [Word8]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Word8]
acc
          else [Word8] -> IO [Word8]
loop (Word8
c Word8 -> [Word8] -> [Word8]
forall a. a -> [a] -> [a]
: [Word8]
acc)