diff --git a/hi-file-parser.cabal b/hi-file-parser.cabal --- a/hi-file-parser.cabal +++ b/hi-file-parser.cabal @@ -1,86 +1,90 @@ cabal-version: 1.12 - --- This file has been generated from package.yaml by hpack version 0.35.2. --- --- see: https://github.com/sol/hpack - -name: hi-file-parser -version: 0.1.4.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/ghc9045/Main.hi - test-files/iface/x64/ghc9045/X.hi - test-files/iface/x64/ghc9061/Main.hi - test-files/iface/x64/ghc9061/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 - , 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 - , vector - default-language: Haskell2010 + +-- 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.5.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 diff --git a/src/HiFileParser.hs b/src/HiFileParser.hs --- a/src/HiFileParser.hs +++ b/src/HiFileParser.hs @@ -35,6 +35,8 @@ 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) @@ -64,6 +66,7 @@ | V9001 | V9041 | V9045 + | V9081 deriving (Show,Eq,Ord,Enum) -- careful, the Ord matters! @@ -522,15 +525,17 @@ where since v = when (version >= v) + getFastString = getCachedBS d + getModule = do idType <- traceShow "Unit type:" getWord8 case idType of - 0 -> void $ getCachedBS d + 0 -> void getFastString 1 -> void $ - getCachedBS d *> getList (getTuple (getCachedBS d) getModule) + getFastString *> getList (getTuple getFastString getModule) _ -> fail $ "Invalid unit type: " <> show idType - Module <$> getCachedBS d + Module <$> getFastString getDependencies = withBlockPrefix $ do if version >= V9041 @@ -539,22 +544,22 @@ -- only direct imports! -- Modules are now prefixed with their UnitId (should have been -- ModuleWithIsBoot...) - direct_mods <- traceShow "direct_mods:" $ getList (getCachedBS d *> getTuple (getCachedBS d) getBool) - direct_pkgs <- getList (getCachedBS d) + direct_mods <- traceShow "direct_mods:" $ getList (getFastString *> getTuple getFastString getBool) + direct_pkgs <- getList getFastString -- plugin packages are now stored separately - plugin_pkgs <- getList (getCachedBS d) + 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 (getCachedBS d) + 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 (getCachedBS d *> getTuple (getCachedBS d) getBool) + _boot_mods <- getList (getFastString *> getTuple getFastString getBool) dep_orphs <- getList getModule dep_finsts <- getList getModule @@ -564,11 +569,11 @@ pure (Dependencies direct_mods all_pkgs_trust dep_orphs dep_finsts dep_plgins) else do - dep_mods <- getList (getTuple (getCachedBS d) getBool) - dep_pkgs <- getList (getTuple (getCachedBS d) getBool) + dep_mods <- getList (getTuple getFastString getBool) + dep_pkgs <- getList (getTuple getFastString getBool) dep_orphs <- getList getModule dep_finsts <- getList getModule - dep_plgins <- getList (getCachedBS d) + dep_plgins <- getList getFastString pure (Dependencies dep_mods dep_pkgs dep_orphs dep_finsts dep_plgins) getUsage = withBlockPrefix $ List . catMaybes . unList <$> getList go @@ -586,16 +591,19 @@ pure Nothing 1 -> do - void (traceShow "Home module:" (getCachedBS d)) -- usg_mod_name - since V9045 $ void (getCachedBS d) -- usg_unit_id + 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 (getList (getTuple (getWord8 *> getCachedBS d) getFP)) -- usg_entities + void (getList (getTuple (getWord8 *> getFastString) getFP)) -- usg_entities void getBool -- usg_safe pure Nothing 2 -> do - file_path <- traceShow "File:" getString -- usg_file_path + -- 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)) @@ -606,8 +614,8 @@ pure Nothing 4 | version >= V9041 -> do -- UsageHomeModuleInterface - void (getCachedBS d) -- usg_mod_name - since V9045 $ void (getCachedBS d) -- usg_unit_id + void getFastString -- usg_mod_name + since V9045 $ void getFastString -- usg_unit_id void getFP -- usg_iface_hash pure Nothing @@ -650,6 +658,7 @@ traceGet ("Version: " ++ version) let !ifaceVersion + | version >= "9081" = V9081 | version >= "9045" = V9045 | version >= "9041" = V9041 | version >= "9001" = V9001 @@ -685,6 +694,7 @@ void getPtr case ifaceVersion of + V9081 -> getInterfaceRecent ifaceVersion dict V9045 -> getInterfaceRecent ifaceVersion dict V9041 -> getInterfaceRecent ifaceVersion dict V9001 -> getInterfaceRecent ifaceVersion dict diff --git a/test-files/iface/x64/ghc9045/Main.hi b/test-files/iface/x64/ghc9045/Main.hi deleted file mode 100644 Binary files a/test-files/iface/x64/ghc9045/Main.hi and /dev/null differ diff --git a/test-files/iface/x64/ghc9045/X.hi b/test-files/iface/x64/ghc9045/X.hi deleted file mode 100644 Binary files a/test-files/iface/x64/ghc9045/X.hi and /dev/null differ diff --git a/test-files/iface/x64/ghc9047/Main.hi b/test-files/iface/x64/ghc9047/Main.hi new file mode 100644 Binary files /dev/null and b/test-files/iface/x64/ghc9047/Main.hi differ diff --git a/test-files/iface/x64/ghc9047/X.hi b/test-files/iface/x64/ghc9047/X.hi new file mode 100644 Binary files /dev/null and b/test-files/iface/x64/ghc9047/X.hi differ diff --git a/test-files/iface/x64/ghc9061/Main.hi b/test-files/iface/x64/ghc9061/Main.hi deleted file mode 100644 Binary files a/test-files/iface/x64/ghc9061/Main.hi and /dev/null differ diff --git a/test-files/iface/x64/ghc9061/X.hi b/test-files/iface/x64/ghc9061/X.hi deleted file mode 100644 Binary files a/test-files/iface/x64/ghc9061/X.hi and /dev/null differ diff --git a/test-files/iface/x64/ghc9063/Main.hi b/test-files/iface/x64/ghc9063/Main.hi new file mode 100644 Binary files /dev/null and b/test-files/iface/x64/ghc9063/Main.hi differ diff --git a/test-files/iface/x64/ghc9063/X.hi b/test-files/iface/x64/ghc9063/X.hi new file mode 100644 Binary files /dev/null and b/test-files/iface/x64/ghc9063/X.hi differ diff --git a/test-files/iface/x64/ghc9081/Main.hi b/test-files/iface/x64/ghc9081/Main.hi new file mode 100644 Binary files /dev/null and b/test-files/iface/x64/ghc9081/Main.hi differ diff --git a/test-files/iface/x64/ghc9081/X.hi b/test-files/iface/x64/ghc9081/X.hi new file mode 100644 Binary files /dev/null and b/test-files/iface/x64/ghc9081/X.hi differ diff --git a/test/HiFileParserSpec.hs b/test/HiFileParserSpec.hs --- a/test/HiFileParserSpec.hs +++ b/test/HiFileParserSpec.hs @@ -3,8 +3,6 @@ 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) @@ -34,14 +32,15 @@ , "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 - , "ghc9045" -- First using GHC 9.4.5 format; last in GHC 9.4 series - , "ghc9061" -- Last in GHC 9.6 series, using GHC 9.4.5 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) + traverse_ (deserialize check32 . ("x32/" <>)) versions32 + traverse_ (deserialize check64 . ("x64/" <>)) versions64 check32 :: Iface.Interface -> IO () check32 iface = do