hi-file-parser-0.1.0.0/src/0000755000000000000000000000000013464033751013440 5ustar0000000000000000hi-file-parser-0.1.0.0/test/0000755000000000000000000000000013464033752013631 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/0000755000000000000000000000000013464033751014730 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/0000755000000000000000000000000013464033751015777 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x32/0000755000000000000000000000000013464603015016407 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x32/ghc7103/0000755000000000000000000000000013464033751017467 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x32/ghc802/0000755000000000000000000000000013464033751017406 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x32/ghc822/0000755000000000000000000000000013464033751017410 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x32/ghc844/0000755000000000000000000000000013464033751017414 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x64/0000755000000000000000000000000013464033752016421 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x64/ghc822/0000755000000000000000000000000013464033752017416 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x64/ghc844/0000755000000000000000000000000013464033752017422 5ustar0000000000000000hi-file-parser-0.1.0.0/test-files/iface/x64/ghc864/0000755000000000000000000000000013464033752017424 5ustar0000000000000000hi-file-parser-0.1.0.0/src/HiFileParser.hs0000644000000000000000000003501113464033751016311 0ustar0000000000000000{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} module HiFileParser ( Interface(..) , List(..) , Dictionary(..) , Module(..) , Usage(..) , Dependencies(..) , getInterface , fromFile ) where {- HLINT ignore "Reduce duplication" -} import Control.Monad (replicateM, replicateM_) import Data.Binary (Get, Word32) import Data.Binary.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.List (find) import Data.Maybe (catMaybes) import Data.Semigroup ((<>)) import qualified Data.Vector as V import GHC.IO.IOMode (IOMode (..)) import Numeric (showHex) import RIO.ByteString as B (ByteString, hGetSome, null) import System.IO (withBinaryFile) type IsBoot = Bool type ModuleName = ByteString newtype List a = List { unList :: [a] } deriving newtype (Show) newtype Dictionary = Dictionary { unDictionary :: V.Vector ByteString } deriving newtype (Show) newtype Module = Module { unModule :: ModuleName } deriving newtype (Show) newtype Usage = Usage { unUsage :: FilePath } deriving newtype (Show) data Dependencies = Dependencies { dmods :: List (ModuleName, IsBoot) , dpkgs :: List (ModuleName, Bool) , dorphs :: List Module , dfinsts :: List Module , dplugins :: List ModuleName } deriving (Show) data Interface = Interface { deps :: Dependencies , usage :: List Usage } deriving (Show) -- | Read a block prefixed with its length withBlockPrefix :: Get a -> Get a withBlockPrefix f = getWord32be *> 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 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 Dictionary <$> V.replicateM size getByteStringSized getCachedBS :: Dictionary -> Get ByteString getCachedBS d = go =<< getWord32be where go i = case unDictionary d V.!? fromIntegral i of Just bs -> pure bs Nothing -> fail $ "Invalid dictionary index: " <> show i getFP :: Get () getFP = void $ getWord64be *> getWord64be 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 getInterface :: Get Interface getInterface = do magic <- getWord32be case magic of -- x32 0x1face -> void getWord32be -- x64 0x1face64 -> void getWord64be invalidMagic -> fail $ "Invalid magic: " <> showHex invalidMagic "" -- ghc version version <- getString -- way void getString -- dict_ptr dictPtr <- getWord32be -- dict dict <- lookAhead $ getDictionary $ fromIntegral dictPtr -- symtable_ptr void getWord32be let versions = [ ("8061", getInterface861) , ("8041", getInterface841) , ("8021", getInterface821) , ("8001", getInterface801) , ("7081", getInterface781) , ("7061", getInterface761) , ("7041", getInterface741) , ("7021", getInterface721) ] case snd <$> find ((version >=) . fst) versions of Just f -> f dict Nothing -> fail $ "Unsupported version: " <> version fromFile :: FilePath -> IO (Either String Interface) fromFile fp = withBinaryFile fp ReadMode go where go h = let feed (Done _ _ iface) = pure $ Right iface feed (Fail _ _ msg) = pure $ Left msg feed (Partial k) = do chunk <- hGetSome h defaultChunkSize feed $ k $ if B.null chunk then Nothing else Just chunk in feed $ runGetIncremental getInterface hi-file-parser-0.1.0.0/test/Spec.hs0000644000000000000000000000005413464033752015056 0ustar0000000000000000{-# OPTIONS_GHC -F -pgmF hspec-discover #-} hi-file-parser-0.1.0.0/test/HiFileParserSpec.hs0000644000000000000000000000335613464033752017324 0ustar0000000000000000{-# LANGUAGE NoImplicitPrelude #-} {-# LANGUAGE OverloadedStrings #-} module HiFileParserSpec (spec) where import Data.Foldable (traverse_) import Data.Semigroup ((<>)) 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 versions32 :: [Version] versions32 = ["ghc7103", "ghc802", "ghc822", "ghc844"] versions64 :: [Version] versions64 = ["ghc822", "ghc844", "ghc864"] spec :: Spec spec = describe "should succesfully deserialize x32 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.0.0/LICENSE0000644000000000000000000000273113477023352013661 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.0.0/Setup.hs0000644000000000000000000000005613464033751014306 0ustar0000000000000000import Distribution.Simple main = defaultMain hi-file-parser-0.1.0.0/hi-file-parser.cabal0000644000000000000000000000413213477024242016443 0ustar0000000000000000cabal-version: 1.12 -- This file has been generated from package.yaml by hpack version 0.31.1. -- -- see: https://github.com/sol/hpack -- -- hash: 2313c7d2911f3c633e0e5dc904c1a47cfe30b325de4f4aeac2752a703c62823d name: hi-file-parser version: 0.1.0.0 synopsis: Parser for GHC's hi files description: Please see the README on Github at category: Development homepage: https://github.com/commercialhaskell/stack#readme bug-reports: https://github.com/commercialhaskell/stack/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/x64/ghc844/Main.hi test-files/iface/x64/ghc844/X.hi test-files/iface/x64/ghc822/Main.hi test-files/iface/x64/ghc822/X.hi test-files/iface/x64/ghc864/Main.hi test-files/iface/x64/ghc864/X.hi test-files/iface/x32/ghc844/Main.hi test-files/iface/x32/ghc802/Main.hi test-files/iface/x32/ghc7103/Main.hi test-files/iface/x32/ghc822/Main.hi source-repository head type: git location: https://github.com/commercialhaskell/stack 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 , rio , 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 , rio , vector default-language: Haskell2010 hi-file-parser-0.1.0.0/README.md0000644000000000000000000000062713464033751014135 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.0.0/ChangeLog.md0000644000000000000000000000007413464033751015023 0ustar0000000000000000# Changelog for hi-file-parser ## 0.1.0.0 Initial release hi-file-parser-0.1.0.0/test-files/iface/x64/ghc844/Main.hi0000644000000000000000000000422413464033752020632 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.0.0/test-files/iface/x64/ghc844/X.hi0000644000000000000000000000146113464033752020155 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.0.0/test-files/iface/x64/ghc822/Main.hi0000644000000000000000000000420213464033752020622 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.0.0/test-files/iface/x64/ghc822/X.hi0000644000000000000000000000154213464033752020151 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.0.0/test-files/iface/x64/ghc864/Main.hi0000644000000000000000000000425713464033752020642 0ustar0000000000000000d8064=}Ɗr+M=d[^. mainMainXbaseghc-boot-th-8.6.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.0.0/test-files/iface/x64/ghc864/X.hi0000644000000000000000000000151413464033752020156 0ustar0000000000000000d80648'GRqcJH^P;\Y֏4$nnt Ч{4O@k\uᖓ 4O՟q@ֱIB4X      7M=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.0.0/test-files/iface/x32/ghc844/Main.hi0000644000000000000000000000222013464033751020616 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.0.0/test-files/iface/x32/ghc802/Main.hi0000644000000000000000000000205313464033751020614 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.0.0/test-files/iface/x32/ghc7103/Main.hi0000644000000000000000000000147313464033751020702 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.0.0/test-files/iface/x32/ghc822/Main.hi0000644000000000000000000000230113464033751020612 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 $trModule