hi-file-parser-0.1.6.0/src/0000755000000000000000000000000014521471445013447 5ustar0000000000000000hi-file-parser-0.1.6.0/test/0000755000000000000000000000000014521442134013630 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/0000755000000000000000000000000014275240513014733 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/0000755000000000000000000000000014275240513016002 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x32/0000755000000000000000000000000014422755377016433 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x32/ghc7103/0000755000000000000000000000000014275240513017472 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x32/ghc8002/0000755000000000000000000000000014275240513017471 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x32/ghc8022/0000755000000000000000000000000014275240513017473 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x32/ghc8044/0000755000000000000000000000000014275240513017477 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/0000755000000000000000000000000014521442134016420 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc8022/0000755000000000000000000000000014275240513017500 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc8044/0000755000000000000000000000000014275240513017504 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc8065/0000755000000000000000000000000014423004263017502 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc8084/0000755000000000000000000000000014275240513017510 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc8107/0000755000000000000000000000000014423005013017471 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc9002/0000755000000000000000000000000014423005225017471 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc9027/0000755000000000000000000000000014422752106017506 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc9044/0000755000000000000000000000000014422752106017505 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc9047/0000755000000000000000000000000014521442134017505 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc9063/0000755000000000000000000000000014521442134017503 5ustar0000000000000000hi-file-parser-0.1.6.0/test-files/iface/x64/ghc9081/0000755000000000000000000000000014521442134017503 5ustar0000000000000000hi-file-parser-0.1.6.0/src/HiFileParser.hs0000644000000000000000000006513514521471445016332 0ustar0000000000000000{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE BangPatterns #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE LambdaCase #-} module HiFileParser ( Interface(..) , List(..) , Dictionary(..) , Module(..) , Usage(..) , Dependencies(..) , getInterface , fromFile ) where {- HLINT ignore "Reduce duplication" -} import Control.Monad (replicateM, replicateM_, when) import Data.Binary (Word64,Word32,Word8) import qualified Data.Binary.Get as G (Get, Decoder (..), bytesRead, getByteString, getInt64be, getWord32be, getWord64be, getWord8, lookAhead, runGetIncremental, skip) import Data.Bool (bool) import Data.ByteString.Lazy.Internal (defaultChunkSize) import Data.Char (chr) import Data.Functor (void, ($>)) import Data.Maybe (catMaybes) #if !MIN_VERSION_base(4,11,0) import Data.Semigroup ((<>)) #endif import qualified Data.Vector as V import qualified Data.Text.Encoding as Text import qualified Data.Text as Text import GHC.IO.IOMode (IOMode (..)) import Numeric (showHex) import RIO.ByteString as B (ByteString, hGetSome, null) import RIO (Int64,Generic, NFData) import System.IO (withBinaryFile) import Data.Bits (FiniteBits(..),testBit, unsafeShiftL,(.|.),clearBit, complement) import Control.Monad.State (StateT, evalStateT, get, gets, lift, modify) import qualified Debug.Trace newtype IfaceGetState = IfaceGetState { useLEB128 :: Bool -- ^ Use LEB128 encoding for numbers } data IfaceVersion = V7021 | V7041 | V7061 | V7081 | V8001 | V8021 | V8041 | V8061 | V8101 | V9001 | V9041 | V9045 | V9081 deriving (Show,Eq,Ord,Enum) -- careful, the Ord matters! type Get a = StateT IfaceGetState G.Get a enableDebug :: Bool enableDebug = False traceGet :: String -> Get () traceGet s | enableDebug = Debug.Trace.trace s (return ()) | otherwise = return () traceShow :: Show a => String -> Get a -> Get a traceShow s g | not enableDebug = g | otherwise = do a <- g traceGet (s ++ " " ++ show a) return a runGetIncremental :: Get a -> G.Decoder a runGetIncremental g = G.runGetIncremental (evalStateT g emptyState) where emptyState = IfaceGetState False getByteString :: Int -> Get ByteString getByteString i = lift (G.getByteString i) getWord8 :: Get Word8 getWord8 = lift G.getWord8 bytesRead :: Get Int64 bytesRead = lift G.bytesRead skip :: Int -> Get () skip = lift . G.skip uleb :: Get a -> Get a -> Get a uleb f g = do c <- gets useLEB128 if c then f else g getWord32be :: Get Word32 getWord32be = uleb getULEB128 (lift G.getWord32be) getWord64be :: Get Word64 getWord64be = uleb getULEB128 (lift G.getWord64be) getInt64be :: Get Int64 getInt64be = uleb getSLEB128 (lift G.getInt64be) lookAhead :: Get b -> Get b lookAhead g = do s <- get lift $ G.lookAhead (evalStateT g s) getPtr :: Get Word32 getPtr = lift G.getWord32be type IsBoot = Bool type ModuleName = ByteString newtype List a = List { unList :: [a] } deriving newtype (Show, NFData) newtype Dictionary = Dictionary { unDictionary :: V.Vector ByteString } deriving newtype (Show, NFData) newtype Module = Module { unModule :: ModuleName } deriving newtype (Show, NFData) newtype Usage = Usage { unUsage :: FilePath } deriving newtype (Show, NFData) data Dependencies = Dependencies { dmods :: List (ModuleName, IsBoot) , dpkgs :: List (ModuleName, Bool) , dorphs :: List Module , dfinsts :: List Module , dplugins :: List ModuleName } deriving (Show, Generic) instance NFData Dependencies data Interface = Interface { deps :: Dependencies , usage :: List Usage } deriving (Show, Generic) instance NFData Interface -- | Read a block prefixed with its length withBlockPrefix :: Get a -> Get a withBlockPrefix f = getPtr *> f getBool :: Get Bool getBool = toEnum . fromIntegral <$> getWord8 getString :: Get String getString = fmap (chr . fromIntegral) . unList <$> getList getWord32be getMaybe :: Get a -> Get (Maybe a) getMaybe f = bool (pure Nothing) (Just <$> f) =<< getBool getList :: Get a -> Get (List a) getList f = do use_uleb <- gets useLEB128 if use_uleb then do l <- (getSLEB128 :: Get Int64) List <$> replicateM (fromIntegral l) f else do i <- getWord8 l <- if i == 0xff then getWord32be else pure (fromIntegral i :: Word32) List <$> replicateM (fromIntegral l) f getTuple :: Get a -> Get b -> Get (a, b) getTuple f g = (,) <$> f <*> g getByteStringSized :: Get ByteString getByteStringSized = do size <- getInt64be getByteString (fromIntegral size) getDictionary :: Int -> Get Dictionary getDictionary ptr = do offset <- bytesRead skip $ ptr - fromIntegral offset size <- fromIntegral <$> getInt64be traceGet ("Dictionary size: " ++ show size) dict <- Dictionary <$> V.replicateM size getByteStringSized traceGet ("Dictionary: " ++ show dict) return dict -- | Get a FastString -- -- FastStrings are stored in a global FastString table and only the index (a -- Word32be) is stored at the expected position. getCachedBS :: Dictionary -> Get ByteString getCachedBS d = go =<< traceShow "Dict index:" getWord32be where go i = case unDictionary d V.!? fromIntegral i of Just bs -> pure bs Nothing -> fail $ "Invalid dictionary index: " <> show i -- | Get Fingerprint getFP' :: Get String getFP' = do x <- getWord64be y <- getWord64be return (showHex x (showHex y "")) getFP :: Get () getFP = void getFP' getInterface721 :: Dictionary -> Get Interface getInterface721 d = do void getModule void getBool replicateM_ 2 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = getCachedBS d *> (Module <$> getCachedBS d) getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing _ -> fail $ "Invalid usageType: " <> show usageType getInterface741 :: Dictionary -> Get Interface getInterface741 d = do void getModule void getBool replicateM_ 3 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = getCachedBS d *> (Module <$> getCachedBS d) getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getWord64be <* getWord64be _ -> fail $ "Invalid usageType: " <> show usageType getInterface761 :: Dictionary -> Get Interface getInterface761 d = do void getModule void getBool replicateM_ 3 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = getCachedBS d *> (Module <$> getCachedBS d) getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getWord64be <* getWord64be _ -> fail $ "Invalid usageType: " <> show usageType getInterface781 :: Dictionary -> Get Interface getInterface781 d = do void getModule void getBool replicateM_ 3 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = getCachedBS d *> (Module <$> getCachedBS d) getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getFP _ -> fail $ "Invalid usageType: " <> show usageType getInterface801 :: Dictionary -> Get Interface getInterface801 d = do void getModule void getWord8 replicateM_ 3 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = getCachedBS d *> (Module <$> getCachedBS d) getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getFP 3 -> getModule *> getFP $> Nothing _ -> fail $ "Invalid usageType: " <> show usageType getInterface821 :: Dictionary -> Get Interface getInterface821 d = do void getModule void $ getMaybe getModule void getWord8 replicateM_ 3 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = do idType <- getWord8 case idType of 0 -> void $ getCachedBS d _ -> void $ getCachedBS d *> getList (getTuple (getCachedBS d) getModule) Module <$> getCachedBS d getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getFP 3 -> getModule *> getFP $> Nothing _ -> fail $ "Invalid usageType: " <> show usageType getInterface841 :: Dictionary -> Get Interface getInterface841 d = do void getModule void $ getMaybe getModule void getWord8 replicateM_ 5 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = do idType <- getWord8 case idType of 0 -> void $ getCachedBS d _ -> void $ getCachedBS d *> getList (getTuple (getCachedBS d) getModule) Module <$> getCachedBS d getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> pure (List []) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getFP 3 -> getModule *> getFP $> Nothing _ -> fail $ "Invalid usageType: " <> show usageType getInterface861 :: Dictionary -> Get Interface getInterface861 d = do void getModule void $ getMaybe getModule void getWord8 replicateM_ 6 getFP void getBool void getBool Interface <$> getDependencies <*> getUsage where getModule = do idType <- getWord8 case idType of 0 -> void $ getCachedBS d _ -> void $ getCachedBS d *> getList (getTuple (getCachedBS d) getModule) Module <$> getCachedBS d getDependencies = withBlockPrefix $ Dependencies <$> getList (getTuple (getCachedBS d) getBool) <*> getList (getTuple (getCachedBS d) getBool) <*> getList getModule <*> getList getModule <*> getList (getCachedBS d) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where go :: Get (Maybe Usage) go = do usageType <- getWord8 case usageType of 0 -> getModule *> getFP *> getBool $> Nothing 1 -> getCachedBS d *> getFP *> getMaybe getFP *> getList (getTuple (getWord8 *> getCachedBS d) getFP) *> getBool $> Nothing 2 -> Just . Usage <$> getString <* getFP 3 -> getModule *> getFP $> Nothing _ -> fail $ "Invalid usageType: " <> show usageType getInterfaceRecent :: IfaceVersion -> Dictionary -> Get Interface getInterfaceRecent version d = do void $ traceShow "Module:" getModule void $ traceShow "Sig:" $ getMaybe getModule void getWord8 -- hsc_src getFP -- iface_hash getFP -- mod_hash getFP -- flag_hash getFP -- opt_hash getFP -- hpc_hash getFP -- plugin_hash void getBool -- orphan void getBool -- hasFamInsts ddeps <- traceShow "Dependencies:" getDependencies dusage <- traceShow "Usage:" getUsage pure (Interface ddeps dusage) where since v = when (version >= v) getFastString = getCachedBS d getModule = do idType <- traceShow "Unit type:" getWord8 case idType of 0 -> void getFastString 1 -> void $ getFastString *> getList (getTuple getFastString getModule) _ -> fail $ "Invalid unit type: " <> show idType Module <$> getFastString getDependencies = withBlockPrefix $ do if version >= V9041 then do -- warning: transitive dependencies are no longer stored, -- only direct imports! -- Modules are now prefixed with their UnitId (should have been -- ModuleWithIsBoot...) direct_mods <- traceShow "direct_mods:" $ getList (getFastString *> getTuple getFastString getBool) direct_pkgs <- getList getFastString -- plugin packages are now stored separately plugin_pkgs <- getList getFastString let all_pkgs = unList plugin_pkgs ++ unList direct_pkgs -- instead of a trust bool for each unit, we have an additional -- list of trusted units (transitive) trusted_pkgs <- getList getFastString let trusted u = u `elem` unList trusted_pkgs let all_pkgs_trust = List (zip all_pkgs (map trusted all_pkgs)) -- these are new _sig_mods <- getList getModule _boot_mods <- getList (getFastString *> getTuple getFastString getBool) dep_orphs <- getList getModule dep_finsts <- getList getModule -- plugin names are no longer stored here let dep_plgins = List [] pure (Dependencies direct_mods all_pkgs_trust dep_orphs dep_finsts dep_plgins) else do dep_mods <- getList (getTuple getFastString getBool) dep_pkgs <- getList (getTuple getFastString getBool) dep_orphs <- getList getModule dep_finsts <- getList getModule dep_plgins <- getList getFastString pure (Dependencies dep_mods dep_pkgs dep_orphs dep_finsts dep_plgins) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go where -- this must follow the `Binary Usage` instance in GHC -- (in GHC.Unit.Module.Deps, at least in GHC 9.4.5) go :: Get (Maybe Usage) go = do usageType <- traceShow "Usage type:" getWord8 case usageType of 0 -> do void (traceShow "Module:" getModule) -- usg_mod void getFP -- usg_mod_hash void getBool -- usg_safe pure Nothing 1 -> do void (traceShow "Home module:" getFastString) -- usg_mod_name since V9045 $ void getFastString -- usg_unit_id void getFP -- usg_mod_hash void (getMaybe getFP) -- usg_exports void getEntitiesList -- usg_entities void getBool -- usg_safe pure Nothing 2 -> do -- usg_file_path file_path <- traceShow "File:" $ if version >= V9081 then Text.unpack . Text.decodeUtf8 <$> getFastString else getString void $ traceShow "FP:" getFP' -- usg_file_hash since V9041 $ void $ traceShow "File label:" (getMaybe getString)-- usg_file_label pure (Just (Usage file_path)) 3 -> do void getModule -- usg_mod void getFP -- usg_mod_hash pure Nothing 4 | version >= V9041 -> do -- UsageHomeModuleInterface void getFastString -- usg_mod_name since V9045 $ void getFastString -- usg_unit_id void getFP -- usg_iface_hash pure Nothing _ -> fail $ "Invalid usageType: " <> show usageType getEntitiesList :: Get (List (ByteString, ())) getEntitiesList = getList (getTuple (getNameSpace *> getFastString) getFP) -- See `instance Binary NameSpace` in module GHC.Types.Name.Occurrence. We -- discard the information. getNameSpace :: Get () getNameSpace = if version >= V9081 then do nameSpaceType <- getWord8 case nameSpaceType of 0 -> pure () 1 -> pure () 2 -> pure () 3 -> pure () -- Unlike the original, we test that the byte we have obtained is -- valid. 4 -> do void getFastString _ -> fail $ "Invalid NameSpace type: " <> show nameSpaceType else void getWord8 getInterface :: Get Interface getInterface = do let enableLEB128 = modify (\c -> c { useLEB128 = True}) magic <- lookAhead getWord32be >>= \case -- normal magic 0x1face -> getWord32be 0x1face64 -> getWord32be m -> do -- GHC 8.10 mistakenly encoded header fields with LEB128 -- so it gets special treatment lookAhead (enableLEB128 >> getWord32be) >>= \case 0x1face -> enableLEB128 >> getWord32be 0x1face64 -> enableLEB128 >> getWord32be _ -> fail $ "Invalid magic: " <> showHex m "" traceGet ("Magic: " ++ showHex magic "") -- empty field (removed in 9.0...) case magic of 0x1face -> do e <- lookAhead getWord32be if e == 0 then void getWord32be else enableLEB128 -- > 9.0 0x1face64 -> do e <- lookAhead getWord64be if e == 0 then void getWord64be else enableLEB128 -- > 9.0 _ -> return () -- ghc version version <- getString traceGet ("Version: " ++ version) let !ifaceVersion | version >= "9081" = V9081 | version >= "9045" = V9045 | version >= "9041" = V9041 | version >= "9001" = V9001 | version >= "8101" = V8101 | version >= "8061" = V8061 | version >= "8041" = V8041 | version >= "8021" = V8021 | version >= "8001" = V8001 | version >= "7081" = V7081 | version >= "7061" = V7061 | version >= "7041" = V7041 | version >= "7021" = V7021 | otherwise = error $ "Unsupported version: " <> version -- way way <- getString traceGet ("Ways: " ++ show way) -- source hash (GHC >= 9.4) when (ifaceVersion >= V9041) $ void getFP -- extensible fields (GHC >= 9.0) when (ifaceVersion >= V9001) $ void getPtr -- dict_ptr dictPtr <- getPtr traceGet ("Dict ptr: " ++ show dictPtr) -- dict dict <- lookAhead $ getDictionary $ fromIntegral dictPtr -- symtable_ptr void getPtr case ifaceVersion of V9081 -> getInterfaceRecent ifaceVersion dict V9045 -> getInterfaceRecent ifaceVersion dict V9041 -> getInterfaceRecent ifaceVersion dict V9001 -> getInterfaceRecent ifaceVersion dict V8101 -> getInterfaceRecent ifaceVersion dict V8061 -> getInterface861 dict V8041 -> getInterface841 dict V8021 -> getInterface821 dict V8001 -> getInterface801 dict V7081 -> getInterface781 dict V7061 -> getInterface761 dict V7041 -> getInterface741 dict V7021 -> getInterface721 dict fromFile :: FilePath -> IO (Either String Interface) fromFile fp = withBinaryFile fp ReadMode go where go h = let feed (G.Done _ _ iface) = pure $ Right iface feed (G.Fail _ _ msg) = pure $ Left msg feed (G.Partial k) = do chunk <- hGetSome h defaultChunkSize feed $ k $ if B.null chunk then Nothing else Just chunk in feed $ runGetIncremental getInterface getULEB128 :: forall a. (Integral a, FiniteBits a) => Get a getULEB128 = go 0 0 where go :: Int -> a -> Get a go shift w = do b <- getWord8 let !hasMore = testBit b 7 let !val = w .|. (clearBit (fromIntegral b) 7 `unsafeShiftL` shift) :: a if hasMore then do go (shift+7) val else return $! val getSLEB128 :: forall a. (Integral a, FiniteBits a) => Get a getSLEB128 = do (val,shift,signed) <- go 0 0 if signed && (shift < finiteBitSize val ) then return $! ((complement 0 `unsafeShiftL` shift) .|. val) else return val where go :: Int -> a -> Get (a,Int,Bool) go shift val = do byte <- getWord8 let !byteVal = fromIntegral (clearBit byte 7) :: a let !val' = val .|. (byteVal `unsafeShiftL` shift) let !more = testBit byte 7 let !shift' = shift+7 if more then go shift' val' else do let !signed = testBit byte 6 return (val',shift',signed) hi-file-parser-0.1.6.0/test/Spec.hs0000644000000000000000000000005514275240514015062 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hi-file-parser-0.1.6.0/test/HiFileParserSpec.hs0000644000000000000000000000534014521442134017316 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module HiFileParserSpec (spec) where import qualified HiFileParser as Iface import RIO import Test.Hspec (Spec, describe, it, shouldBe) type Version = String type Directory = FilePath type Usage = String type Module = ByteString -- | GHC x.y.z is represented as \"ghcxyyz\" where yy is padded with zeros. versions32 :: [Version] versions32 = [ "ghc7103" -- Last in GHC 7.10 series, using GHC 7.8.1 format , "ghc8002" -- Last in GHC 8.0 series, using GHC 8.0.1 format , "ghc8022" -- Last in GHC 8.2 series, using GHC 8.2.1 format , "ghc8044" -- Last in GHC 8.4 series, using GHC 8.4.1 format ] -- | GHC x.y.z is represented as \"ghcxyyz\" where yy is padded with zeros. versions64 :: [Version] versions64 = [ "ghc8022" -- Last in GHC 8.2 series, using GHC 8.0.1 format , "ghc8044" -- Last in GHC 8.4 series, using GHC 8.4.1 format , "ghc8065" -- Last in GHC 8.6 series, using GHC 8.6.1 format , "ghc8084" -- Last in GHC 8.8 series, using GHC 8.6.1 format , "ghc8107" -- Last in GHC 8.10 series, using GHC 8.10.1 format , "ghc9002" -- Last in GHC 9.0 series, using GHC 9.0.1 format , "ghc9027" -- Last in GHC 9.2 series, using GHC 9.0.1 format , "ghc9044" -- Last using GHC 9.4.1 format , "ghc9047" -- Last in GHC 9.4 series, using GHC 9.4.5 format , "ghc9063" -- Last in GHC 9.6 series, using GHC 9.4.5 format , "ghc9081" -- First in GHC 9.8 series, using GHC 9.8.1 format ] spec :: Spec spec = describe "should successfully deserialize interface for" $ do traverse_ (deserialize check32 . ("x32/" <>)) versions32 traverse_ (deserialize check64 . ("x64/" <>)) versions64 check32 :: Iface.Interface -> IO () check32 iface = do hasExpectedUsage "some-dependency.txt" iface `shouldBe` True check64 :: Iface.Interface -> IO () check64 iface = do hasExpectedUsage "Test.h" iface `shouldBe` True hasExpectedUsage "README.md" iface `shouldBe` True hasExpectedModule "X" iface `shouldBe` True deserialize :: (Iface.Interface -> IO ()) -> Directory -> Spec deserialize check d = do it d $ do let ifacePath = "test-files/iface/" <> d <> "/Main.hi" result <- Iface.fromFile ifacePath case result of (Left msg) -> fail msg (Right iface) -> check iface -- | `Usage` is the name given by GHC to TH dependency hasExpectedUsage :: Usage -> Iface.Interface -> Bool hasExpectedUsage u = elem u . fmap Iface.unUsage . Iface.unList . Iface.usage hasExpectedModule :: Module -> Iface.Interface -> Bool hasExpectedModule m = elem m . fmap fst . Iface.unList . Iface.dmods . Iface.deps hi-file-parser-0.1.6.0/README.md0000644000000000000000000000064214275244676014153 0ustar0000000000000000# hi-file-parser Provide data types and functions for parsing the binary `.hi` files produced by GHC. Intended to support multiple versions of GHC, so that tooling can: * Support multiple versions of GHC * Avoid linking against the `ghc` library * Not need to use `ghc`'s textual dump file format. Note that this code was written for Stack's usage initially, though it is intended to be general purpose. hi-file-parser-0.1.6.0/ChangeLog.md0000644000000000000000000000237214521471445015035 0ustar0000000000000000# Changelog for `hi-file-parser` All notable changes to this project will be documented in this file. The format is based on [Keep a Changelog](https://keepachangelog.com/en/1.0.0/), and this project adheres to the [Haskell Package Versioning Policy](https://pvp.haskell.org/). ## 0.1.6.0 - 2023-11-04 * Add further support for GHC 9.8 (GHC 9.8.1 onward). See [#20](https://github.com/commercialhaskell/hi-file-parser/pull/20) ## 0.1.5.0 - 2023-10-11 * Add support for GHC 9.8 (GHC 9.8.1 onward). See [#17](https://github.com/commercialhaskell/hi-file-parser/pull/17) ## 0.1.4.0 - 2023-04-28 * Add further support for GHC 9.4 (GHC 9.4.5 onward) and support for GHC 9.6. See [#14](https://github.com/commercialhaskell/hi-file-parser/pull/14) ## 0.1.3.0 - 2022-08-12 * Allow dependency on `mtl` >= 2.3. See [#6](https://github.com/commercialhaskell/hi-file-parser/pull/6) * Add support for GHC 9.4 (up to GHC 9.4.4). See [#7](https://github.com/commercialhaskell/hi-file-parser/pull/7) ## 0.1.2.0 - 2021-04-09 * Add support for GHC 8.10 and 9.0. See [#2](https://github.com/commercialhaskell/hi-file-parser/pull/2) ## 0.1.1.0 - 2021-03-24 * Add `NFData` instances ## 0.1.0.0 - 2019-06-08 * Initial release hi-file-parser-0.1.6.0/test-files/iface/x32/ghc7103/Main.hi0000644000000000000000000000147314275240513020705 0ustar00000000000000007103Z"mi-t AIxi>2T|u?n;Yp     ?&+LNѼA?[ܤD)+k'?ZDe %Z|~{4(R(some-dependency.txtuk'$7DV!nrCwNX٢#I?67ēLMi>M=d[^.mainMainbaseghc-prim integer-gmptemplate-haskellGHC.Base GHC.FloatControl.Applicative Data.Either Data.MonoidData.Type.Equality GHC.GenericsLanguage.Haskell.TH.SyntaxPrelude GHC.Typeshi-file-parser-0.1.6.0/test-files/iface/x32/ghc8002/Main.hi0000644000000000000000000000205314275240513020677 0ustar00000000000000008002K6BU N@ wCGXH =Ҹ4KTո      Jqtmi.zY S`= D9OX kzyN(@4some-dependency.txtuk'$7DV!PӼ)A]-~$$)5'RaYM h"qa#,ALri>M=d[^.mainMainbaseghc-boot-th-8.0.2ghc-prim integer-gmptemplate-haskellGHC.Base GHC.FloatControl.Applicative Data.EitherData.Functor.Const Data.MonoidData.Type.Equality Data.Version GHC.GenericsGHC.IO.Exception GHC.TypeLitsGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude GHC.Types $trModulehi-file-parser-0.1.6.0/test-files/iface/x32/ghc8022/Main.hi0000644000000000000000000000230114275240513020675 0ustar00000000000000008022m B0Sn J>pÿƶw84j>`oZfR     d f4jO@T2ljٌCR8+[#BN;d.J)hwsome-dependency.txtuk'$7DV!X2xuq֤%UQhp<S%~' `?&밁xMrTi>M=d[^.mainMainbaseghc-boot-th-8.2.2ghc-prim integer-gmptemplate-haskell GHC.FloatGHC.BaseControl.Applicative Data.EitherData.Functor.ConstData.Functor.Identity Data.MonoidData.Type.Equality Data.Version GHC.GenericsGHC.IO.Exception GHC.TypeLits GHC.TypeNatsGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude GHC.Types $trModulehi-file-parser-0.1.6.0/test-files/iface/x32/ghc8044/Main.hi0000644000000000000000000000222014275240513020701 0ustar00000000000000008044rhX9ר *`L%+@JW"f/E\ʧEfɫug1B 4O՟q      .@5d7,nwb;J)X3$]C7[ YY2mcsome-dependency.txtuk'$7DV!oK=L :vb̚-*~:'N.3XRrYi>M=d[^.mainMainbaseghc-boot-th-8.4.4ghc-prim integer-gmptemplate-haskell GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Version GHC.GenericsGHC.IO.ExceptionGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude GHC.Types $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc8022/Main.hi0000644000000000000000000000420214275240513020704 0ustar0000000000000000d80220'$!5X5&^p^C5A~ ]yʻ       x/ٛ^6i&Id1[}3GRPm:@ n[7 qX#ΤDPt8{p3'S+ MDʜv|xQ=6 5,DUHph'/.܃yTest.hȝ^ YDQ7X/nix/store/6014lmjlvwqj8q5ykz0hhblvmx7ycskl-ghc-8.2.2/lib/ghc-8.2.2/include/ghcversion.hPݐ-vP/nix/store/sr4253np2gz2bpha4gn8gqlmiw604155-glibc-2.27-dev/include/stdc-predef.hdjDvX0q'sE#A README.md)_\CsQu\.3%UQhp<SW~X&mYi.ɫ;z' `?&밁xri>M=d[^. mainMainXbaseghc-boot-th-8.2.2ghc-prim integer-gmptemplate-haskell GHC.FloatGHC.BaseControl.Applicative Data.EitherData.Functor.ConstData.Functor.Identity Data.MonoidData.Type.Equality Data.Version GHC.GenericsGHC.IO.Exception GHC.TypeLits GHC.TypeNatsGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Libf $trModuleStringhi-file-parser-0.1.6.0/test-files/iface/x64/ghc8022/X.hi0000644000000000000000000000154214275240513020233 0ustar0000000000000000d8022Av^rw"РXp3'S+ MDʜNnfE};      !1[}3GRPm:@ _H,3.ìtdΖv|xQ=6 >C2uSs0pվ g~&p: ە΋,i>M=d[^.mainXbaseghc-prim integer-gmp GHC.FloatGHC.BaseControl.Applicative Data.EitherData.Functor.ConstData.Functor.Identity Data.MonoidData.Type.Equality GHC.GenericsGHC.IO.Exception GHC.TypeLits GHC.TypeNatsPreludeGHC.Integer.Typex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc8044/Main.hi0000644000000000000000000000422414275240513020714 0ustar0000000000000000d8044".9gPG.uN̉%-3;/2 5'Efɫug1B 4O՟q     ,  `AP(w~rud;PU⷗x)B=9@UɞS?'ٳ=JSCUC+b;0ߖp omϷKU7~D2m+9.QV7&:ଯIM؂;"S7vTest.hȝ^ YDQ7X/nix/store/30n64hjjzrvfbzs0z8wf9mkcjnmqlfbm-ghc-8.4.4/lib/ghc-8.4.4/include/ghcversion.hܕ1=mP/nix/store/sr4253np2gz2bpha4gn8gqlmiw604155-glibc-2.27-dev/include/stdc-predef.hdjDvX0q'sE#A README.md)_\CsQ|=;it+hlNS :vb̚-w~X&mYi.ɫ;:'N.3Xri>M=d[^. mainMainXbaseghc-boot-th-8.4.4ghc-prim integer-gmptemplate-haskell GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Version GHC.GenericsGHC.IO.ExceptionGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModuleStringhi-file-parser-0.1.6.0/test-files/iface/x64/ghc8044/X.hi0000644000000000000000000000146114275240513020237 0ustar0000000000000000d8044> j> #∄+b;0ߖp粔 O ē"Efɫug1B 4O՟q     &PU⷗x)B=9=80KV[&T omϷKCHUn)(l~ț&RR_=/,i>M=d[^.mainXbaseghc-prim integer-gmp GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal GHC.GenericsGHC.IO.ExceptionPreludeGHC.Integer.Typex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc8065/Main.hi0000644000000000000000000000355514423004263020720 0ustar0000000000000000d8065 vfJ#fE4SP/ @&G Iոvz0jЧ{4O@k\uᖓ 4O՟q@ֱIB4X /       eK>Bh˙$ɂQ..ǵU|WL{ .6a\ zD$&^Lʯȳi%G]ODOc SεyhWs/c(f6Test.h0!gPnX#g\C:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-8.6.5\lib\include\ghcversion.hCDI /3 README.mdش6#>v2޹%." :vb̚-F~X&mYi.ɫ;i:'N.3Xri>M=d[^. mainMainXbaseghc-boot-th-8.6.5ghc-prim integer-gmptemplate-haskell GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Version GHC.GenericsGHC.IO.ExceptionGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModuleStringhi-file-parser-0.1.6.0/test-files/iface/x64/ghc8065/X.hi0000644000000000000000000000151414423004262020233 0ustar0000000000000000d8065R('AiE4zD$&4$nnt Ч{4O@k\uᖓ 4O՟q@ֱIB4X      7h˙$ɂX\9^Lʯȳi%GTYUn)(}~{Be= i =,i>M=d[^.mainXbaseghc-prim integer-gmp GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal GHC.GenericsGHC.IO.ExceptionPreludeGHC.Integer.Typex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc8084/Main.hi0000644000000000000000000000366614275240513020731 0ustar0000000000000000d8084ƈ|8Fi)B'209I@xq|H7] -v'@> 4O՟q@ֱIB4X A       ?r , `渺Hm9!_t3=Iq}žq\șe7p<"4EE~sv[&vp]Np28i)q8p(+T>P_ܔ]ېLH`rj\ZY"^J:"_ zG- 8#ݏTest.hȝ^ YDQ7@/home/hsyl20/.ghcup/ghc/8.8.4/lib/ghc-8.8.4/include/ghcversion.h*0*~,/usr/include/stdc-predef.hm3qRy+# README.md)_\CsQ7Ni F? "%zВb~KϹeQ[ }?$Ck4qo)`ri>M=d[^. mainMainXbaseghc-boot-th-8.8.4ghc-priminteger-wired-intemplate-haskell GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Version Data.Void GHC.GenericsGHC.IO.ExceptionGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModuleStringhi-file-parser-0.1.6.0/test-files/iface/x64/ghc8084/X.hi0000644000000000000000000000152114275240513020240 0ustar0000000000000000d8084 Rβ"wzGDE~sv[&vpB4u op -v'@> 4O՟q@ֱIB4X      7m9!_t3=IqNZroe],]Np28i)q8p(+TY{2hZL79}~Zvu߁0i>M=d[^.mainXbaseghc-priminteger-wired-in GHC.FloatGHC.BaseControl.ApplicativeData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal GHC.GenericsGHC.IO.ExceptionPreludeGHC.Integer.Typex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc8107/Main.hi0000644000000000000000000000236314423005013020703 0ustar00000000000000008107&Ї⒛.㮯휐 딝/̶ƌNߵܓǵ̈B     Q  ֍δĹ$▥oڃˋû«pw좉𥱖EÏܝ!߸Uљ° 觭âٮͬӻ͈ޓ=Test.hǩúĐ0羒nC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-8.10.7\lib\include\ghcversion.hѻꑎ README.md΀}贈՝8ŕŗ̔qvȃ׊ s ˮ˹ߦiޅ   mainMainXbaseghc-boot-th-8.10.7ghc-priminteger-wired-intemplate-haskell GHC.FloatGHC.BaseControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Version Data.Void GHC.GenericsGHC.IO.ExceptionGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModuleStringhi-file-parser-0.1.6.0/test-files/iface/x64/ghc8107/X.hi0000644000000000000000000000117214423005012020222 0ustar00000000000000008107ڽݗ荇:w좉؃딝/̶ƌNߵܓǵ̈B     ▥oܠ۶m𥱖EÏܝ! ۙ貴3әӬW^ߦiޅy~mainXbaseghc-priminteger-wired-in GHC.FloatGHC.BaseControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal GHC.GenericsGHC.IO.ExceptionPreludeGHC.Integer.Typex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9002/Main.hi0000644000000000000000000000244714423005225020706 0ustar0000000000000000d9002&P@Àڣ߮뇼ۮ"ڃ֥ߦfߵܓǵ̈B     ~  ™졈ɀ׆΀Bԑyˎ6꒪gक़帐#ՃIߞ돳芲ٹ}ȬܽcާIJTest.hǩúĐ0羒nC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.0.2\lib\x86_64-windows-ghc-9.0.2\rts-1.0.2\include\ghcversion.hˤ README.md΀}贈՝8оۨ/ʌЖ0⑍Sوߦiޅ6;@ !mainMainXbase ghc-bignumghc-boot-th-9.0.2ghc-primtemplate-haskell GHC.FloatGHC.BaseControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Version Data.VoidGHC.Exts GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9002/X.hi0000644000000000000000000000113514423005225020222 0ustar0000000000000000d9002\ynʒٴ+ #ć5ڃ֥ߦfߵܓǵ̈B      ׆΀BԑyՃIߞi聊}%䶞BIߦiޅdinmainXbase ghc-bignumghc-prim GHC.FloatGHC.BaseControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsPreludex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9027/Main.hi0000644000000000000000000000247514422752106020724 0ustar0000000000000000d9027<XH㏞βĀ嫀U߱/Ҥߵܓǵ̈B       ۢܯը݂!ΘؤVߗՔ˂נމĢމڴz鎘@ӣᖬ1ޛkɻ6Test.hǩúĐ0羒nC:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.2.7\lib\x86_64-windows-ghc-9.2.7\rts-1.0.2\include\ghcversion.h쁟࢟ README.md됒GަLٝÒ߭ʑ莦ϧЖ0܍X#ߦiޅ>CH !"mainMainXbase ghc-bignumghc-boot-th-9.2.7ghc-primtemplate-haskell GHC.FloatGHC.BaseControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Type.Ord Data.Version Data.VoidGHC.Exts GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsGHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9027/X.hi0000644000000000000000000000116414422752106020241 0ustar0000000000000000d9027swӢҲމڴz夬Lߵܓǵ̈B      ݂!Θ鎘@ӣB‘b'%䶞KRߦiޅmrwmainXbase ghc-bignumghc-prim GHC.FloatGHC.BaseControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Type.Ord GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsPreludex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9044/Main.hi0000644000000000000000000000513614422752106020720 0ustar0000000000000000d9044˴Τ ]eUýǯ^򝖀Ĺסɘŋ؁$Ӻ񪏧aߵܓǵ̈B     ԩ֡Ύڠݹ˃߼Փwᩋ˥jӞH뀚ф ڳW ԉՙ]ІǞ[Test.hǩúĐ0羒nC:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\rts-1.0.2\include\ghcversion.hމҜȕ README.md됒GަLC:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\ghc-prim-0.9.0\libHSghc-prim-0.9.0.aΑړ͌C:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\ghc-bignum-1.3\libHSghc-bignum-1.3.a菫ͦ͌C:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\base-4.17.0.0\libHSbase-4.17.0.0.a™Śˁ[C:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\ghc-boot-th-9.4.4\libHSghc-boot-th-9.4.4.aXɞ߷#C:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\array-0.5.4.0\libHSarray-0.5.4.0.a՞⌄C:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\deepseq-1.4.8.0\libHSdeepseq-1.4.8.0.aͮº;ݝC:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\pretty-1.1.3.6\libHSpretty-1.1.3.6.aܹۑqC:\Users\mikep\AppData\Local\Programs\stack\x86_64-windows\ghc-9.4.4\lib\x86_64-windows-ghc-9.4.4\template-haskell-2.19.0.0\libHStemplate-haskell-2.19.0.0.aݳŢǿՕQʑ莦ϧҁЖ0 ʍ"梹7>ߦiޅ!"#mainMainXbaseghc-primtemplate-haskellGHC.Base GHC.Float GHC.Prim.ExtControl.Applicative Control.ArrowData.Array.ByteData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Type.Ord Data.Version Data.Void GHC.GenericsGHC.IO.Exception GHC.IsList GHC.RTS.Flagsghc-boot-th-9.4.4GHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9044/X.hi0000644000000000000000000000117314422752106020240 0ustar0000000000000000d9044ĜԾ@”Sz|͍#͂ࡺFᩋ˥jӞ̈⚤Ӻ񪏧aߵܓǵ̈B      Ύڠݹ˃H뀚фB‘b:ҁ%䶞^eߦiޅmainXbaseGHC.Base GHC.Floatghc-prim GHC.Prim.ExtControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Type.Ord GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsPreludex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9047/Main.hi0000644000000000000000000000464614521442134020725 0ustar0000000000000000d9045߅ܰ>Յu „ː8ם׮ŋ؁$Ӻ񪏧aߵܓǵ̈B     򞑔瞚8’)ᴴ“ٺڞא閉2̦+›dϺܴ÷爜۶h :Ѵjl›րTest.h٘屧/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/rts-1.0.2/include/ghcversion.h∀Ø堵/usr/include/stdc-predef.h簚ڴ README.md)£ø/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSghc-prim-0.9.0-ghc9.4.5.soıק߉D/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSghc-bignum-1.3-ghc9.4.5.soϑʫs/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSbase-4.17.1.0-ghc9.4.5.soՕΡ˵{/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSghc-boot-th-9.4.5-ghc9.4.5.so0/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSarray-0.5.4.0-ghc9.4.5.soչ}ۂ΃߽/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSdeepseq-1.4.8.0-ghc9.4.5.soϫ?/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHSpretty-1.1.3.6-ghc9.4.5.soı߅7/home/hsyl20/.ghcup/ghc/9.4.5/lib/ghc-9.4.5/lib/../lib/x86_64-linux-ghc-9.4.5/libHStemplate-haskell-2.19.0.0-ghc9.4.5.so˳LɣȬ˲Ѻݝ ʑ莦ϧ3ҁЖ0Uʍ"梹ߦiޅ!"#mainMainXbaseghc-primtemplate-haskellGHC.Base GHC.Float GHC.Prim.ExtControl.Applicative Control.ArrowData.Array.ByteData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Type.Ord Data.Version Data.Void GHC.GenericsGHC.IO.Exception GHC.IsList GHC.RTS.Flagsghc-boot-th-9.4.5GHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9047/X.hi0000644000000000000000000000117614521442134020243 0ustar0000000000000000d9045ؚ̙҄Δ%}߄.Ϻܴ̈⚤Ӻ񪏧aߵܓǵ̈B      ’)ᴴ“ٺ÷爜B‘b=ҁ%䶞ahߦiޅmainXbaseGHC.Base GHC.Floatghc-prim GHC.Prim.ExtControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Type.Ord GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsPreludex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9063/Main.hi0000644000000000000000000000463614521442134020722 0ustar0000000000000000d9061߅ܰ>Յu ¬։ƭд$բח7潳Њߵܓǵ̈B     чĂɭʭ>㳄VţLJˆ΃ݵɖӅ(ǒ9֥rҔЀݸL䋸ʻV𘋊mTest.h٘屧/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/rts-1.0.2/include/ghcversion.h΢k≒/usr/include/stdc-predef.h簚ڴ README.md)£ø/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSghc-prim-0.10.0-ghc9.6.1.so☾Ń/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSghc-bignum-1.3-ghc9.6.1.soɈ򀕾њu/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSbase-4.18.0.0-ghc9.6.1.soMݐ/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSghc-boot-th-9.6.1-ghc9.6.1.soڈؔﰈ/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSarray-0.5.5.0-ghc9.6.1.soҽ*뤔9/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSdeepseq-1.4.8.1-ghc9.6.1.soםM/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHSpretty-1.1.3.6-ghc9.6.1.so싪͟Ù/home/hsyl20/.ghcup/ghc/9.6.1/lib/ghc-9.6.1/lib/../lib/x86_64-linux-ghc-9.6.1/libHStemplate-haskell-2.20.0.0-ghc9.6.1.soǣ3Љ˿ ɢȣQ5ҁЖ0WG˜8ߦiޅ !"mainMainXbaseghc-primtemplate-haskellGHC.Base GHC.Float GHC.Prim.ExtControl.Applicative Control.ArrowData.Array.ByteData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Type.Ord Data.Version GHC.GenericsGHC.IO.Exception GHC.IsList GHC.RTS.Flagsghc-boot-th-9.6.1GHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.Internalf $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9063/X.hi0000644000000000000000000000117614521442134020241 0ustar0000000000000000d9061ؚ̙҄Δ%}Ʈ΃ݵ꓁kż蕄ߵܓǵ̈B      ʭ>㳄ɖӅ(ǒ9Ʈϡކفŋ<ҁ%䶞`hߦiޅmainXbaseGHC.Base GHC.Floatghc-prim GHC.Prim.ExtControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Type.Ord GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsPreludex $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9081/Main.hi0000644000000000000000000000525414521442134020717 0ustar0000000000000000d9081˴Τ rUʓѳxư׍`߯/Ѹ\ߵܓǵ̈B     ͂ǐۄۄ觡ƮTꭗϘl֏ð7̇מMȞꇄHǟҎ'ԅܺͮIٺ뛺ҍ ǩúĐ0羒n!ޔ0"ڴ#ʈū[$Ղ␫Ţ&%㒷&*ˠϠ'ӛ㨃(իǀۓįꑞ)쎺菗R*񭆒ܮԍ\ɢȣQҁЖ0(߿ɑS[ߦiޅ+,-mainMainXbaseghc-primtemplate-haskellGHC.Base GHC.Float GHC.Prim.ExtControl.Applicative Control.ArrowData.Array.ByteData.Functor.ConstData.Functor.Identity Data.MonoidData.SemigroupData.Semigroup.Internal Data.Type.Ord Data.Version GHC.GenericsGHC.IO.Exception GHC.IsList GHC.RTS.Flagsghc-boot-th-9.8.1-d8a4GHC.ForeignSrcLang.TypeGHC.LanguageExtensions.TypeLanguage.Haskell.TH.SyntaxPrelude System.IO GHC.TypesLanguage.Haskell.TH.Lib Language.Haskell.TH.Lib.InternalTest.hC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\rts-1.0.2\include\ghcversion.h README.mdC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\ghc-prim-0.11.0-6ef2\libHSghc-prim-0.11.0-6ef2.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\ghc-bignum-1.3-7ca5\libHSghc-bignum-1.3-7ca5.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\base-4.19.0.0-1e7d\libHSbase-4.19.0.0-1e7d.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\ghc-boot-th-9.8.1-d8a4\libHSghc-boot-th-9.8.1-d8a4.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\array-0.5.6.0-eeeb\libHSarray-0.5.6.0-eeeb.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\deepseq-1.5.0.0-940f\libHSdeepseq-1.5.0.0-940f.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\pretty-1.1.3.6-39a4\libHSpretty-1.1.3.6-39a4.aC:\Users\mike\AppData\Local\Programs\stack\x86_64-windows\ghc-9.8.1\lib\x86_64-windows-ghc-9.8.1\template-haskell-2.21.0.0-9348\libHStemplate-haskell-2.21.0.0-9348.af $trModulehi-file-parser-0.1.6.0/test-files/iface/x64/ghc9081/X.hi0000644000000000000000000000120014521442134020225 0ustar0000000000000000d9081ĜԾ@”SᇟR֏ð7ޗ̋᤟Ѹ\ߵܓǵ̈B      觡ƮṪמMƮϡކفŋ>ҁ%䶞bjߦiޅmainXbaseGHC.Base GHC.Floatghc-prim GHC.Prim.ExtControl.Applicative Control.ArrowData.Functor.ConstData.Functor.Identity Data.MonoidData.Semigroup.Internal Data.Type.Ord GHC.GenericsGHC.IO.Exception GHC.RTS.FlagsPreludex $trModulehi-file-parser-0.1.6.0/LICENSE0000644000000000000000000000276114275240513013667 0ustar0000000000000000Copyright (c) 2015-2019, Stack contributors All rights reserved. Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met: * Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer. * Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution. * Neither the name of Stack nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission. THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL STACK CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. hi-file-parser-0.1.6.0/Setup.hs0000644000000000000000000000006014275240513014304 0ustar0000000000000000import Distribution.Simple main = defaultMain hi-file-parser-0.1.6.0/hi-file-parser.cabal0000644000000000000000000000544214521471445016460 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.36.0. -- -- see: https://github.com/sol/hpack name: hi-file-parser version: 0.1.6.0 synopsis: Parser for GHC's hi files description: Please see the README on Github at category: Development homepage: https://github.com/commercialhaskell/hi-file-parser#readme bug-reports: https://github.com/commercialhaskell/hi-file-parser/issues author: Hussein Ait-Lahcen maintainer: michael@snoyman.com license: BSD3 license-file: LICENSE build-type: Simple extra-source-files: README.md ChangeLog.md test-files/iface/x32/ghc7103/Main.hi test-files/iface/x32/ghc8002/Main.hi test-files/iface/x32/ghc8022/Main.hi test-files/iface/x32/ghc8044/Main.hi test-files/iface/x64/ghc8022/Main.hi test-files/iface/x64/ghc8022/X.hi test-files/iface/x64/ghc8044/Main.hi test-files/iface/x64/ghc8044/X.hi test-files/iface/x64/ghc8065/Main.hi test-files/iface/x64/ghc8065/X.hi test-files/iface/x64/ghc8084/Main.hi test-files/iface/x64/ghc8084/X.hi test-files/iface/x64/ghc8107/Main.hi test-files/iface/x64/ghc8107/X.hi test-files/iface/x64/ghc9002/Main.hi test-files/iface/x64/ghc9002/X.hi test-files/iface/x64/ghc9027/Main.hi test-files/iface/x64/ghc9027/X.hi test-files/iface/x64/ghc9044/Main.hi test-files/iface/x64/ghc9044/X.hi test-files/iface/x64/ghc9047/Main.hi test-files/iface/x64/ghc9047/X.hi test-files/iface/x64/ghc9063/Main.hi test-files/iface/x64/ghc9063/X.hi test-files/iface/x64/ghc9081/Main.hi test-files/iface/x64/ghc9081/X.hi source-repository head type: git location: https://github.com/commercialhaskell/hi-file-parser library exposed-modules: HiFileParser other-modules: Paths_hi_file_parser hs-source-dirs: src ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints build-depends: base >=4.10 && <5 , binary , bytestring , mtl , rio , text , vector default-language: Haskell2010 test-suite hi-file-parser-test type: exitcode-stdio-1.0 main-is: Spec.hs other-modules: HiFileParserSpec Paths_hi_file_parser hs-source-dirs: test ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Wincomplete-uni-patterns -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N build-depends: base >=4.10 && <5 , binary , bytestring , hi-file-parser , hspec , mtl , rio , text , vector default-language: Haskell2010