Add support for ghc-9.0.1 (#31)

* Add non-backwards compatible support for ghc-9.0.1

* Make changes backwards-compatible

* Fix warnings and tests

* Restore accidentally deleted project file

* Link the versions needed to build on ghc-9.0.1 in cabal.project

* Add ghc-9.0.1 to github actions

* Regenerate haskell-ci from cabal.project

.github/workflows/haskell-ci.yml

@@ -1,46 +1,48 @@
 # This GitHub workflow config has been generated by a script via
 #
-#   haskell-ci 'github' 'hiedb.cabal'
+#   haskell-ci 'github' 'cabal.project'
 #
 # To regenerate the script (for example after adjusting tested-with) run
 #
 #   haskell-ci regenerate
 #
 # For more information, see https://github.com/haskell-CI/haskell-ci
 #
-# version: 0.11.20210222
+# version: 0.12.1
 #
-# REGENDATA ("0.11.20210222",["github","hiedb.cabal"])
+# REGENDATA ("0.12.1",["github","cabal.project"])
 #
 name: Haskell-CI
 on:
   - push
   - pull_request
 jobs:
   linux:
-    name: Haskell-CI - Linux - GHC ${{ matrix.ghc }}
+    name: Haskell-CI - Linux - ${{ matrix.compiler }}
     runs-on: ubuntu-18.04
     container:
       image: buildpack-deps:bionic
     continue-on-error: ${{ matrix.allow-failure }}
     strategy:
       matrix:
         include:
-          - ghc: 8.10.4
+          - compiler: ghc-9.0.1
             allow-failure: false
-          - ghc: 8.10.3
+          - compiler: ghc-8.10.4
             allow-failure: false
-          - ghc: 8.10.2
+          - compiler: ghc-8.10.3
             allow-failure: false
-          - ghc: 8.10.1
+          - compiler: ghc-8.10.2
             allow-failure: false
-          - ghc: 8.8.4
+          - compiler: ghc-8.10.1
             allow-failure: false
-          - ghc: 8.8.3
+          - compiler: ghc-8.8.4
             allow-failure: false
-          - ghc: 8.8.2
+          - compiler: ghc-8.8.3
             allow-failure: false
-          - ghc: 8.8.1
+          - compiler: ghc-8.8.2
+            allow-failure: false
+          - compiler: ghc-8.8.1
             allow-failure: false
       fail-fast: false
     steps:
@@ -50,29 +52,31 @@ jobs:
           apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common
           apt-add-repository -y 'ppa:hvr/ghc'
           apt-get update
-          apt-get install -y ghc-$GHC_VERSION cabal-install-3.4
+          apt-get install -y $CC cabal-install-3.4
         env:
-          GHC_VERSION: ${{ matrix.ghc }}
+          CC: ${{ matrix.compiler }}
       - name: Set PATH and environment variables
         run: |
           echo "$HOME/.cabal/bin" >> $GITHUB_PATH
           echo "LANG=C.UTF-8" >> $GITHUB_ENV
           echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV
           echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV
-          HC=/opt/ghc/$GHC_VERSION/bin/ghc
+          HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')
+          HCNAME=ghc
+          HC=$HCDIR/bin/$HCNAME
           echo "HC=$HC" >> $GITHUB_ENV
-          echo "HCPKG=/opt/ghc/$GHC_VERSION/bin/ghc-pkg" >> $GITHUB_ENV
-          echo "HADDOCK=/opt/ghc/$GHC_VERSION/bin/haddock" >> $GITHUB_ENV
+          echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV
+          echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV
           echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV
           HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
           echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV
           echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV
           echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV
           echo "HEADHACKAGE=false" >> $GITHUB_ENV
-          echo "ARG_COMPILER=--ghc --with-compiler=$HC" >> $GITHUB_ENV
+          echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV
           echo "GHCJSARITH=0" >> $GITHUB_ENV
         env:
-          GHC_VERSION: ${{ matrix.ghc }}
+          CC: ${{ matrix.compiler }}
       - name: env
         run: |
           env
@@ -140,6 +144,21 @@ jobs:
           echo "package hiedb" >> cabal.project
           echo "    ghc-options: -Werror=missing-methods" >> cabal.project
           cat >> cabal.project <<EOF
+          source-repository-package
+            type:     git
+            location: https://github.com/jwaldmann/blaze-textual.git
+            tag:      d8ee6cf80e27f9619d621c936bb4bda4b99a183f
+
+          source-repository-package
+            type:     git
+            location: https://github.com/hsyl20/ghc-api-compat
+            tag:      6178d75772c7d923918dfffa0b1f503dfb36d0a6
+
+          source-repository-package
+            type:     git
+            location: https://github.com/anka-213/haskell-language-server
+            tag:      5b3aeb9f4e76624c0b293b4fb8bf855c02f73d3d
+            subdir:   hie-compat
           EOF
           $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(hiedb)$/; }' >> cabal.project.local
           cat cabal.project
@@ -151,9 +170,9 @@ jobs:
       - name: cache
         uses: actions/cache@v2
         with:
-          key: ${{ runner.os }}-${{ matrix.ghc }}-${{ github.sha }}
+          key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
           path: ~/.cabal/store
-          restore-keys: ${{ runner.os }}-${{ matrix.ghc }}-
+          restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
       - name: install dependencies
         run: |
           $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all

cabal.project

@@ -1,3 +1,16 @@
-packages: . 
+packages: .
 -- package hiedb
 --   ghc-options: -fwrite-ide-info -hiedir /home/zubin/hiedb/.hie/
+
+
+source-repository-package
+  type: git
+  location: https://github.com/jwaldmann/blaze-textual.git
+  tag: d8ee6cf80e27f9619d621c936bb4bda4b99a183f
+  -- https://github.com/jwaldmann/blaze-textual/commit/d8ee6cf80e27f9619d621c936bb4bda4b99a183f
+  -- https://github.com/bos/blaze-textual/issues/13
+
+source-repository-package
+  type: git
+  location: https://github.com/hsyl20/ghc-api-compat
+  tag: 6178d75772c7d923918dfffa0b1f503dfb36d0a6

hiedb.cabal

@@ -17,6 +17,7 @@ extra-source-files:
   test/data/Sub/*.hs
 tested-with:         GHC ==8.8.1 || ==8.8.2  || ==8.8.3  || ==8.8.4
                      || ==8.10.1 || ==8.10.2 || ==8.10.3 || ==8.10.4
+                     || ==9.0.1
 
 
 source-repository head
@@ -25,7 +26,7 @@ source-repository head
 
 common common-options
   default-language:    Haskell2010
-  build-depends:       base >= 4.12 && < 4.15
+  build-depends:       base >= 4.12 && < 4.16
   ghc-options:         -Wall
                        -Wincomplete-uni-patterns
                        -Wincomplete-record-updates
@@ -49,6 +50,7 @@ library
                        HieDb.Utils,
                        HieDb.Create,
                        HieDb.Query,
+                       HieDb.Compat,
                        HieDb.Types,
                        HieDb.Dump,
                        HieDb.Html,
@@ -69,6 +71,7 @@ library
                      , extra
                      , ansi-terminal
                      , terminal-size
+                     , ghc-api-compat
 
 test-suite hiedb-tests
   import:             common-options
@@ -85,3 +88,4 @@ test-suite hiedb-tests
                     , hspec
                     , process
                     , temporary
+                    , ghc-api-compat

src/HieDb/Compat.hs

@@ -0,0 +1,58 @@
+
+{-# LANGUAGE CPP #-}
+module HieDb.Compat (
+    nodeInfo'
+    , Unit
+    , unitString
+    , stringToUnit
+    , moduleUnit
+    , unhelpfulSpanFS
+
+) where
+
+import Compat.HieTypes
+
+import Module
+
+#if __GLASGOW_HASKELL__ >= 900
+import GHC.Types.SrcLoc
+import Compat.HieUtils
+
+import qualified Data.Map as M
+import qualified Data.Set as S
+
+
+-- nodeInfo' :: Ord a => HieAST a -> NodeInfo a
+nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
+nodeInfo' = M.foldl' combineNodeInfo' emptyNodeInfo . getSourcedNodeInfo . sourcedNodeInfo
+
+combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a
+(NodeInfo as ai ad) `combineNodeInfo'` (NodeInfo bs bi bd) =
+  NodeInfo (S.union as bs) (mergeSorted ai bi) (M.unionWith (<>) ad bd)
+  where
+    mergeSorted :: Ord a => [a] -> [a] -> [a]
+    mergeSorted la@(a:as) lb@(b:bs) = case compare a b of
+                                        LT -> a : mergeSorted as lb
+                                        EQ -> a : mergeSorted as bs
+                                        GT -> b : mergeSorted la bs
+    mergeSorted as [] = as
+    mergeSorted [] bs = bs
+#else
+import qualified FastString as FS
+
+nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex
+nodeInfo' = nodeInfo
+type Unit = UnitId
+unitString :: Unit -> String
+unitString = unitIdString
+stringToUnit :: String -> Unit
+stringToUnit = stringToUnitId
+moduleUnit :: Module -> Unit
+moduleUnit = moduleUnitId
+unhelpfulSpanFS :: FS.FastString -> FS.FastString
+unhelpfulSpanFS = id
+#endif
+
+#if __GLASGOW_HASKELL__ >= 900
+#else
+#endif

src/HieDb/Create.hs

@@ -32,8 +32,10 @@ import System.Directory
 
 import Database.SQLite.Simple
 
+import HieDb.Compat
 import HieDb.Types
 import HieDb.Utils
+import FastString  as FS      ( FastString )
 
 sCHEMA_VERSION :: Integer
 sCHEMA_VERSION = 5
@@ -166,7 +168,7 @@ addArr (getConn -> conn) arr = do
       Just m -> do
         let occ = nameOccName n
             mod = moduleName m
-            uid = moduleUnitId m
+            uid = moduleUnit m
         execute conn "INSERT INTO typenames(name,mod,unit) VALUES (?,?,?)" (occ,mod,uid)
         Just . fromOnly . head <$> query conn "SELECT id FROM typenames WHERE name = ? AND mod = ? AND unit = ?" (occ,mod,uid)
 
@@ -179,15 +181,17 @@ addTypeRefs
   -> IO ()
 addTypeRefs db path hf ixs = mapM_ addTypesFromAst asts
   where
+    arr :: A.Array TypeIndex HieTypeFlat
     arr = hie_types hf
+    asts :: M.Map FS.FastString (HieAST TypeIndex)
     asts = getAsts $ hie_asts hf
     addTypesFromAst :: HieAST TypeIndex -> IO ()
     addTypesFromAst ast = do
       mapM_ (addTypeRef db path arr ixs (nodeSpan ast))
         $ mapMaybe (\x -> guard (any (not . isOccurrence) (identInfo x)) *> identType x)
         $ M.elems
         $ nodeIdentifiers
-        $ nodeInfo ast
+        $ nodeInfo' ast
       mapM_ addTypesFromAst $ nodeChildren ast
 
 {-| Adds all references from given @.hie@ file to 'HieDb'.
@@ -240,7 +244,7 @@ addRefsFromLoaded_unsafe
 
   let isBoot = "boot" `isSuffixOf` path
       mod    = moduleName smod
-      uid    = moduleUnitId smod
+      uid    = moduleUnit smod
       smod   = hie_module hf
       refmap = generateReferencesMap $ getAsts $ hie_asts hf
       (srcFile, isReal) = case sourceFile of