{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE MultiWayIf #-}
module GHC.Iface.Ext.Binary (
  readHieFile
, readHieFileEither
, HieHeader
, HieFileResult(..)
, extractSourceFileName
) where

import Data.List (intercalate)
import Data.ByteString (ByteString)

import GHC.Types.Name.Cache

import GHC.Iface.Ext.Types

import GHC.Iface.Ext.Binary.Utils
import GHC.Iface.Ext.Binary.GHC912 qualified as HieFile
import GHC.Iface.Ext.Binary.Header (HieHeader, readHieFileHeader)
import GHC.Iface.Ext.Binary.Header qualified as Header

#if __GLASGOW_HASKELL__ == 908 || __GLASGOW_HASKELL__ == 910 || __GLASGOW_HASKELL__ == 912
supported :: [Integer]
supported :: [Integer]
supported = [Integer]
supported908 [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer]
supported910 [Integer] -> [Integer] -> [Integer]
forall a. [a] -> [a] -> [a]
++ [Integer]
supported912
#endif

supported908 :: [Integer]
supported908 :: [Integer]
supported908 = [Integer
9081 .. Integer
9084]

supported910 :: [Integer]
supported910 :: [Integer]
supported910 = [Integer
9101 .. Integer
9102]

supported912 :: [Integer]
supported912 :: [Integer]
supported912 = [Integer
9121 .. Integer
9122]

-- | Read a `HieFile` from a `FilePath`. Can use an existing `NameCache`.
readHieFile :: NameCache -> FilePath -> IO HieFileResult
readHieFile :: NameCache -> String -> IO HieFileResult
readHieFile NameCache
name_cache String
file = (HieHeader -> IO HieFileResult)
-> (HieFileResult -> HieFileResult)
-> NameCache
-> String
-> IO HieFileResult
forall a.
(HieHeader -> IO a)
-> (HieFileResult -> a) -> NameCache -> String -> IO a
readHie (String -> HieHeader -> IO HieFileResult
forall a. String -> HieHeader -> IO a
unsupportedVersion String
file) HieFileResult -> HieFileResult
forall a. a -> a
id NameCache
name_cache String
file

extractSourceFileName :: FilePath -> IO FilePath
extractSourceFileName :: String -> IO String
extractSourceFileName String
file = String -> IO ReadBinHandle
readBinMem String
file IO ReadBinHandle -> (ReadBinHandle -> IO String) -> IO String
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ReadBinHandle -> IO String
Header.extractSourceFileName

unsupportedVersion :: FilePath -> HieHeader -> IO a
unsupportedVersion :: forall a. String -> HieHeader -> IO a
unsupportedVersion String
file = String -> IO a
forall a. String -> IO a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> IO a) -> (HieHeader -> String) -> HieHeader -> IO a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> HieHeader -> String
unsupportedVersionError String
file

unsupportedVersionError :: FilePath -> HieHeader -> String
unsupportedVersionError :: String -> HieHeader -> String
unsupportedVersionError String
file (Integer -> String
forall a. Show a => a -> String
show -> String
version, ByteString
_) =
  String
"Unsupported HIE version " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
version String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" for file " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
file String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
", supported versions: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
supportedVersions
  where
    supportedVersions :: String
    supportedVersions :: String
supportedVersions = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
", " ([String] -> String)
-> ([String] -> [String]) -> [String] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> [String]
forall a. [a] -> [a]
reverse ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Integer -> String) -> [Integer] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Integer -> String
forall a. Show a => a -> String
show [Integer]
supported

-- | Read a `HieFile` from a `FilePath`. Can use an existing `NameCache`.
-- `Left` case returns the failing header versions.
readHieFileEither :: NameCache -> FilePath -> IO (Either HieHeader HieFileResult)
readHieFileEither :: NameCache -> String -> IO (Either HieHeader HieFileResult)
readHieFileEither = (HieHeader -> IO (Either HieHeader HieFileResult))
-> (HieFileResult -> Either HieHeader HieFileResult)
-> NameCache
-> String
-> IO (Either HieHeader HieFileResult)
forall a.
(HieHeader -> IO a)
-> (HieFileResult -> a) -> NameCache -> String -> IO a
readHie (Either HieHeader HieFileResult
-> IO (Either HieHeader HieFileResult)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either HieHeader HieFileResult
 -> IO (Either HieHeader HieFileResult))
-> (HieHeader -> Either HieHeader HieFileResult)
-> HieHeader
-> IO (Either HieHeader HieFileResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HieHeader -> Either HieHeader HieFileResult
forall a b. a -> Either a b
Left) HieFileResult -> Either HieHeader HieFileResult
forall a b. b -> Either a b
Right

readHie :: (HieHeader -> IO a) -> (HieFileResult -> a) -> NameCache -> FilePath -> IO a
readHie :: forall a.
(HieHeader -> IO a)
-> (HieFileResult -> a) -> NameCache -> String -> IO a
readHie HieHeader -> IO a
left HieFileResult -> a
right NameCache
name_cache String
file = do
  ReadBinHandle
bh0 <- String -> IO ReadBinHandle
readBinMem String
file
  header :: HieHeader
header@(Integer
version, ByteString
ghcVersion) <- String -> ReadBinHandle -> IO HieHeader
readHieFileHeader String
file ReadBinHandle
bh0
  let hieFileResult :: HieFile -> a
hieFileResult = HieFileResult -> a
right (HieFileResult -> a) -> (HieFile -> HieFileResult) -> HieFile -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> ByteString -> HieFile -> HieFileResult
HieFileResult Integer
version ByteString
ghcVersion
  if
    | Integer
version Integer -> [Integer] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
supported908 -> HieFile -> a
hieFileResult (HieFile -> a) -> IO HieFile -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> NameCache -> IO HieFile
HieFile.readHieFile908 ReadBinHandle
bh0 NameCache
name_cache
    | Integer
version Integer -> [Integer] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
supported910 -> HieFile -> a
hieFileResult (HieFile -> a) -> IO HieFile -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> NameCache -> IO HieFile
HieFile.readHieFile910 ReadBinHandle
bh0 NameCache
name_cache
    | Integer
version Integer -> [Integer] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Integer]
supported912 -> HieFile -> a
hieFileResult (HieFile -> a) -> IO HieFile -> IO a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBinHandle -> NameCache -> IO HieFile
HieFile.readHieFile912 ReadBinHandle
bh0 NameCache
name_cache
    | Bool
otherwise -> HieHeader -> IO a
left HieHeader
header
{-# INLINE readHie #-}

data HieFileResult = HieFileResult {
  HieFileResult -> Integer
hie_file_result_version :: Integer
, HieFileResult -> ByteString
hie_file_result_ghc_version :: ByteString
, HieFileResult -> HieFile
hie_file_result :: HieFile
}