Date: Friday, July 9, 2021 @ 04:56:50 Author: felixonmars Revision: 975893
upgpkg: haskell-hiedb 0.4.0.0-1: rebuild with ghcide 1.4.0.3, hiedb 0.4.0.0 Modified: haskell-hiedb/trunk/PKGBUILD Deleted: haskell-hiedb/trunk/ghc9.patch ------------+ PKGBUILD | 31 - ghc9.patch | 1061 ----------------------------------------------------------- 2 files changed, 12 insertions(+), 1080 deletions(-) Modified: PKGBUILD =================================================================== --- PKGBUILD 2021-07-09 04:38:13 UTC (rev 975892) +++ PKGBUILD 2021-07-09 04:56:50 UTC (rev 975893) @@ -2,8 +2,8 @@ _hkgname=hiedb pkgname=haskell-hiedb -pkgver=0.3.0.1 -pkgrel=48 +pkgver=0.4.0.0 +pkgrel=1 pkgdesc="Generates a references DB from .hie files" url="https://github.com/wz1000/HieDb" license=("BSD") @@ -10,24 +10,18 @@ arch=('x86_64') depends=('ghc-libs' 'haskell-algebraic-graphs' 'haskell-ansi-terminal' 'haskell-extra' 'haskell-ghc' 'haskell-ghc-api-compat' 'haskell-ghc-paths' 'haskell-hie-compat' 'haskell-lucid' - 'haskell-optparse-applicative' 'haskell-sqlite-simple') -makedepends=('ghc' 'uusi' 'haskell-hspec' 'haskell-temporary') -# https://github.com/wz1000/HieDb/pull/27 -#source=("https://hackage.haskell.org/packages/archive/$_hkgname/$pkgver/$_hkgname-$pkgver.tar.gz") -source=("https://github.com/wz1000/HieDb/archive/$pkgver/$pkgname-$pkgver.tar.gz" - ghc9.patch) -sha256sums=('7c0d3c56f7c0ea9b5af84f9c9f8547dc2a12abf0ab3e599c9ebdff3d2bf7b980' - '2c86858d805a69603ffa4680b2a989b5732f43ec47ab42e5de1d37794b097372') + 'haskell-optparse-applicative' 'haskell-sqlite-simple' 'haskell-terminal-size') +makedepends=('ghc' 'haskell-hspec' 'haskell-temporary') +source=("https://hackage.haskell.org/packages/archive/$_hkgname/$pkgver/$_hkgname-$pkgver.tar.gz") +sha512sums=('b45bb1e08544379c61a9bd3f38613be844320cd5bed65d181cc01c7f77724daf63e4cf6930db7f14873de8f2122efe7e10b933bd5d53d3a4df4c55f8343c0d7b') prepare() { - cd HieDb-$pkgver - patch -p1 -i ../ghc9.patch - sed -i 's/callProcess "ghc" \$/callProcess "ghc" $ "-dynamic" :/' test/Main.hs - uusi -u base $_hkgname.cabal + cd hiedb-$pkgver + sed -i 's/callProcess hc args/callProcess hc (["-dynamic"] ++ args)/' test/Main.hs } build() { - cd HieDb-$pkgver + cd hiedb-$pkgver runhaskell Setup configure -O --enable-shared --enable-executable-dynamic --disable-library-vanilla \ --prefix=/usr --docdir=/usr/share/doc/$pkgname --enable-tests \ @@ -43,13 +37,12 @@ } check() { - cd HieDb-$pkgver - # https://github.com/wz1000/HieDb/issues/28 - PATH="$PWD/dist/build/hiedb:$PATH" LD_LIBRARY_PATH="$PWD/dist/build" runhaskell Setup test || echo "Tests failed" + cd hiedb-$pkgver + PATH="$PWD/dist/build/hiedb:$PATH" LD_LIBRARY_PATH="$PWD/dist/build" runhaskell Setup test --show-details=direct } package() { - cd HieDb-$pkgver + cd hiedb-$pkgver install -D -m744 register.sh "$pkgdir"/usr/share/haskell/register/$pkgname.sh install -D -m744 unregister.sh "$pkgdir"/usr/share/haskell/unregister/$pkgname.sh Deleted: ghc9.patch =================================================================== --- ghc9.patch 2021-07-09 04:38:13 UTC (rev 975892) +++ ghc9.patch 2021-07-09 04:56:50 UTC (rev 975893) @@ -1,1061 +0,0 @@ -From ddd3c1ee822c2759f9b67a6e199770e6097b5ef0 Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= <anka....@gmail.com> -Date: Tue, 30 Mar 2021 00:52:11 +0800 -Subject: [PATCH 1/7] Add non-backwards compatible support for ghc-9.0.1 - ---- - hiedb.cabal | 4 +++- - src/HieDb/Create.hs | 15 +++++++++------ - src/HieDb/Query.hs | 28 ++++++++++++++-------------- - src/HieDb/Run.hs | 41 +++++++++++++++++++++-------------------- - src/HieDb/Types.hs | 25 ++++++++++++++++--------- - src/HieDb/Utils.hs | 34 ++++++++++++++++++++++++++-------- - test/Main.hs | 26 ++++++++++++++------------ - test/Test/Orphans.hs | 4 ++-- - 8 files changed, 105 insertions(+), 72 deletions(-) - -diff --git a/hiedb.cabal b/hiedb.cabal -index 82fc7b6..f198504 100644 ---- a/hiedb.cabal -+++ b/hiedb.cabal -@@ -25,7 +25,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 -@@ -69,6 +69,7 @@ library - , optparse-applicative - , extra - , ansi-terminal -+ , ghc-api-compat - - test-suite hiedb-tests - import: common-options -@@ -85,3 +86,4 @@ test-suite hiedb-tests - , hspec - , process - , temporary -+ , ghc-api-compat -diff --git a/src/HieDb/Create.hs b/src/HieDb/Create.hs -index 3572843..57c3fac 100644 ---- a/src/HieDb/Create.hs -+++ b/src/HieDb/Create.hs -@@ -34,6 +34,7 @@ import Database.SQLite.Simple - - import HieDb.Types - import HieDb.Utils -+import GHC.Data.FastString as FS ( FastString ) - - sCHEMA_VERSION :: Integer - sCHEMA_VERSION = 5 -@@ -60,7 +61,7 @@ checkVersion k db@(getConn -> conn) = do - withHieDb :: FilePath -> (HieDb -> IO a) -> IO a - withHieDb fp f = withConnection fp (checkVersion f . HieDb) - --{-| Given GHC LibDir and path to @.hiedb@ file, -+{-| Given GHC LibDir and path to @.hiedb@ file, - constructs DynFlags (required for printing info from @.hie@ files) - and 'HieDb' and passes them to given function. - -} -@@ -150,7 +151,7 @@ initConn (getConn -> conn) = do - execute_ conn "CREATE INDEX IF NOT EXISTS typerefs_mod ON typerefs(hieFile)" - - {-| Add names of types from @.hie@ file to 'HieDb'. --Returns an Array mapping 'TypeIndex' to database ID assigned to the -+Returns an Array mapping 'TypeIndex' to database ID assigned to the - corresponding record in DB. - -} - addArr :: HieDb -> A.Array TypeIndex HieTypeFlat -> IO (A.Array TypeIndex (Maybe Int64)) -@@ -166,7 +167,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,7 +180,9 @@ 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 -@@ -187,7 +190,7 @@ addTypeRefs db path hf ixs = mapM_ addTypesFromAst asts - $ 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'. -@@ -219,7 +222,7 @@ addRefsFromLoaded db@(getConn -> conn) path sourceFile hash hf = liftIO $ withTr - - 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 -@@ -243,7 +246,7 @@ addRefsFromLoaded db@(getConn -> conn) path sourceFile hash hf = liftIO $ withTr - No action is taken if the corresponding @.hie@ file has not been indexed yet. - -} - addSrcFile -- :: HieDb -+ :: HieDb - -> FilePath -- ^ Path to @.hie@ file - -> FilePath -- ^ Path to .hs file to be added to DB - -> Bool -- ^ Is this a real source file? I.e. does it come from user's project (as opposed to from project's dependency)? -diff --git a/src/HieDb/Query.hs b/src/HieDb/Query.hs -index 93f6132..9fe9913 100644 ---- a/src/HieDb/Query.hs -+++ b/src/HieDb/Query.hs -@@ -41,11 +41,11 @@ import qualified HieDb.Html as Html - getAllIndexedMods :: HieDb -> IO [HieModuleRow] - getAllIndexedMods (getConn -> conn) = query_ conn "SELECT * FROM mods" - --{-| Lookup UnitId associated with given ModuleName. -+{-| Lookup Unit associated with given ModuleName. - HieDbErr is returned if no module with given name has been indexed - or if ModuleName is ambiguous (i.e. there are multiple packages containing module with given name) - -} --resolveUnitId :: HieDb -> ModuleName -> IO (Either HieDbErr UnitId) -+resolveUnitId :: HieDb -> ModuleName -> IO (Either HieDbErr Unit) - resolveUnitId (getConn -> conn) mn = do - luid <- query conn "SELECT mod, unit, is_boot, hs_src, is_real, hash FROM mods WHERE mod = ? and is_boot = 0" (Only mn) - return $ case luid of -@@ -53,7 +53,7 @@ resolveUnitId (getConn -> conn) mn = do - [x] -> Right $ modInfoUnit x - (x:xs) -> Left $ AmbiguousUnitId $ x :| xs - --findReferences :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe UnitId -> [FilePath] -> IO [Res RefRow] -+findReferences :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe Unit -> [FilePath] -> IO [Res RefRow] - findReferences (getConn -> conn) isReal occ mn uid exclude = - queryNamed conn thisQuery ([":occ" := occ, ":mod" := mn, ":unit" := uid, ":real" := isReal] ++ excludedFields) - where -@@ -65,8 +65,8 @@ findReferences (getConn -> conn) isReal occ mn uid exclude = - \((NOT :real) OR (mods.is_real AND mods.hs_src IS NOT NULL))" - <> " AND mods.hs_src NOT IN (" <> Query (T.intercalate "," (map (\(l := _) -> l) excludedFields)) <> ")" - --{-| Lookup 'HieModule' row from 'HieDb' given its 'ModuleName' and 'UnitId' -} --lookupHieFile :: HieDb -> ModuleName -> UnitId -> IO (Maybe HieModuleRow) -+{-| Lookup 'HieModule' row from 'HieDb' given its 'ModuleName' and 'Unit' -} -+lookupHieFile :: HieDb -> ModuleName -> Unit -> IO (Maybe HieModuleRow) - lookupHieFile (getConn -> conn) mn uid = do - files <- query conn "SELECT * FROM mods WHERE mod = ? AND unit = ? AND is_boot = 0" (mn, uid) - case files of -@@ -89,7 +89,7 @@ lookupHieFileFromSource (getConn -> conn) fp = do - ++ show fp ++ ". Entries: " - ++ intercalate ", " (map (show . toRow) xs) - --findTypeRefs :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe UnitId -> [FilePath] -> IO [Res TypeRef] -+findTypeRefs :: HieDb -> Bool -> OccName -> Maybe ModuleName -> Maybe Unit -> [FilePath] -> IO [Res TypeRef] - findTypeRefs (getConn -> conn) isReal occ mn uid exclude - = queryNamed conn thisQuery ([":occ" := occ, ":mod" := mn, ":unit" := uid, ":real" := isReal] ++ excludedFields) - where -@@ -103,14 +103,14 @@ findTypeRefs (getConn -> conn) isReal occ mn uid exclude - <> " AND mods.hs_src NOT IN (" <> Query (T.intercalate "," (map (\(l := _) -> l) excludedFields)) <> ")" - <> " ORDER BY typerefs.depth ASC" - --findDef :: HieDb -> OccName -> Maybe ModuleName -> Maybe UnitId -> IO [Res DefRow] -+findDef :: HieDb -> OccName -> Maybe ModuleName -> Maybe Unit -> IO [Res DefRow] - findDef conn occ mn uid - = queryNamed (getConn conn) "SELECT defs.*, mods.mod,mods.unit,mods.is_boot,mods.hs_src,mods.is_real,mods.hash \ - \FROM defs JOIN mods USING (hieFile) \ - \WHERE occ = :occ AND (:mod IS NULL OR mod = :mod) AND (:unit IS NULL OR unit = :unit)" - [":occ" := occ,":mod" := mn, ":unit" := uid] - --findOneDef :: HieDb -> OccName -> Maybe ModuleName -> Maybe UnitId -> IO (Either HieDbErr (Res DefRow)) -+findOneDef :: HieDb -> OccName -> Maybe ModuleName -> Maybe Unit -> IO (Either HieDbErr (Res DefRow)) - findOneDef conn occ mn muid = wrap <$> findDef conn occ mn muid - where - wrap [x] = Right x -@@ -126,7 +126,7 @@ searchDef conn cs - \LIMIT 200" (Only $ '_':cs++"%") - - {-| @withTarget db t f@ runs function @f@ with HieFile specified by HieTarget @t@. --In case the target is given by ModuleName (and optionally UnitId) it is first resolved -+In case the target is given by ModuleName (and optionally Unit) it is first resolved - from HieDb, which can lead to error if given file is not indexed/Module name is ambiguous. - -} - withTarget -@@ -151,7 +151,7 @@ withTarget conn target f = case target of - nc <- newIORef =<< makeNc - runDbM nc $ do - Right <$> withHieFile fp' (return . f) -- -+ - - type Vertex = (String, String, String, Int, Int, Int, Int) - -@@ -197,7 +197,7 @@ getVertices (getConn -> conn) ss = Set.toList <$> foldM f Set.empty ss - one s = do - let n = toNsChar (occNameSpace $ symName s) : occNameString (symName s) - m = moduleNameString $ moduleName $ symModule s -- u = unitIdString (moduleUnitId $ symModule s) -+ u = unitString (moduleUnit $ symModule s) - query conn "SELECT mods.mod, decls.hieFile, decls.occ, decls.sl, decls.sc, decls.el, decls.ec \ - \FROM decls JOIN mods USING (hieFile) \ - \WHERE ( decls.occ = ? AND mods.mod = ? AND mods.unit = ? ) " (n, m, u) -@@ -224,9 +224,9 @@ getAnnotations db symbols = do - m2 = foldl' (f Html.Unreachable) m1 us - return m2 - where -- f :: Html.Color -- -> Map FilePath (ModuleName, Set Html.Span) -- -> Vertex -+ f :: Html.Color -+ -> Map FilePath (ModuleName, Set Html.Span) -+ -> Vertex - -> Map FilePath (ModuleName, Set Html.Span) - f c m v = - let (fp, mod', sp) = g c v -diff --git a/src/HieDb/Run.hs b/src/HieDb/Run.hs -index 1184748..0c98134 100644 ---- a/src/HieDb/Run.hs -+++ b/src/HieDb/Run.hs -@@ -14,6 +14,7 @@ import Name - import Module - import Outputable ((<+>),hang,showSDoc,ppr,text) - import IfaceType (IfaceType) -+import SrcLoc - - import qualified FastString as FS - -@@ -86,15 +87,15 @@ data Options - data Command - = Init - | Index [FilePath] -- | NameRefs String (Maybe ModuleName) (Maybe UnitId) -- | TypeRefs String (Maybe ModuleName) (Maybe UnitId) -- | NameDef String (Maybe ModuleName) (Maybe UnitId) -- | TypeDef String (Maybe ModuleName) (Maybe UnitId) -+ | NameRefs String (Maybe ModuleName) (Maybe Unit) -+ | TypeRefs String (Maybe ModuleName) (Maybe Unit) -+ | NameDef String (Maybe ModuleName) (Maybe Unit) -+ | TypeDef String (Maybe ModuleName) (Maybe Unit) - | Cat HieTarget - | Ls - | Rm [HieTarget] - | ModuleUIDs ModuleName -- | LookupHieFile ModuleName (Maybe UnitId) -+ | LookupHieFile ModuleName (Maybe Unit) - | RefsAtPoint HieTarget (Int,Int) (Maybe (Int,Int)) - | TypesAtPoint HieTarget (Int,Int) (Maybe (Int,Int)) - | DefsAtPoint HieTarget (Int,Int) (Maybe (Int,Int)) -@@ -195,9 +196,9 @@ cmdParser - posParser :: Char -> Parser (Int,Int) - posParser c = (,) <$> argument auto (metavar $ c:"LINE") <*> argument auto (metavar $ c:"COL") - --maybeUnitId :: Parser (Maybe UnitId) -+maybeUnitId :: Parser (Maybe Unit) - maybeUnitId = -- optional (stringToUnitId <$> strOption (short 'u' <> long "unit-id" <> metavar "UNITID")) -+ optional (stringToUnit <$> strOption (short 'u' <> long "unit-id" <> metavar "UNITID")) - - symbolParser :: Parser Symbol - symbolParser = argument auto $ metavar "SYMBOL" -@@ -299,7 +300,7 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - putStr "\t" - putStr $ moduleNameString $ modInfoName $ hieModInfo mod - putStr "\t" -- putStrLn $ unitIdString $ modInfoUnit $ hieModInfo mod -+ putStrLn $ unitString $ modInfoUnit $ hieModInfo mod - Rm targets -> do - forM_ targets $ \target -> do - case target of -@@ -330,7 +331,7 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - Nothing -> return $ Left (NotIndexed mn $ Just uid) - Just x -> Right <$> putStrLn (hieModuleHieFile x) - RefsAtPoint target sp mep -> hieFileCommand conn opts target $ \hf -> do -- let names = concat $ pointCommand hf sp mep $ rights . M.keys . nodeIdentifiers . nodeInfo -+ let names = concat $ pointCommand hf sp mep $ rights . M.keys . nodeIdentifiers . nodeInfo' - when (null names) $ - reportAmbiguousErr opts (Left $ NoNameAtPoint target sp) - forM_ names $ \name -> do -@@ -339,7 +340,7 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - hPutStrLn stderr "" - case nameModule_maybe name of - Just mod -> do -- reportRefs opts =<< findReferences conn False (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) [] -+ reportRefs opts =<< findReferences conn False (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) [] - Nothing -> do - let refmap = generateReferencesMap (getAsts $ hie_asts hf) - refs = map (toRef . fst) $ M.findWithDefault [] (Right name) refmap -@@ -349,19 +350,19 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - ,Just $ Right (hie_hs_src hf)) - reportRefSpans opts refs - TypesAtPoint target sp mep -> hieFileCommand conn opts target $ \hf -> do -- let types' = concat $ pointCommand hf sp mep $ nodeType . nodeInfo -+ let types' = concat $ pointCommand hf sp mep $ nodeType . nodeInfo' - types = map (flip recoverFullType $ hie_types hf) types' - when (null types) $ - reportAmbiguousErr opts (Left $ NoNameAtPoint target sp) - forM_ types $ \typ -> do - putStrLn $ renderHieType dynFlags typ - DefsAtPoint target sp mep -> hieFileCommand conn opts target $ \hf -> do -- let names = concat $ pointCommand hf sp mep $ rights . M.keys . nodeIdentifiers . nodeInfo -+ let names = concat $ pointCommand hf sp mep $ rights . M.keys . nodeIdentifiers . nodeInfo' - when (null names) $ - reportAmbiguousErr opts (Left $ NoNameAtPoint target sp) - forM_ names $ \name -> do - case nameSrcSpan name of -- RealSrcSpan dsp -> do -+ RealSrcSpan dsp _ -> do - unless (quiet opts) $ - hPutStrLn stderr $ unwords ["Name", ppName opts (nameOccName name),"at",ppSpan opts sp,"is defined at:"] - contents <- case nameModule_maybe name of -@@ -369,7 +370,7 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - Just mod - | mod == hie_module hf -> pure $ Just $ Right $ hie_hs_src hf - | otherwise -> unsafeInterleaveIO $ do -- loc <- findOneDef conn (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) -+ loc <- findOneDef conn (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) - pure $ case loc of - Left _ -> Nothing - Right (row:._) -> Just $ Left $ defSrc row -@@ -384,7 +385,7 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - case nameModule_maybe name of - Just mod -> do - (row:.inf) <- reportAmbiguousErr opts -- =<< findOneDef conn (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnitId mod) -+ =<< findOneDef conn (nameOccName name) (Just $ moduleName mod) (Just $ moduleUnit mod) - unless (quiet opts) $ - hPutStrLn stderr $ unwords ["Name", ppName opts (nameOccName name),"at",ppSpan opts sp,"is defined at:"] - reportRefSpans opts -@@ -394,10 +395,10 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - ,Just $ Left $ defSrc row - )] - Nothing -> do -- reportAmbiguousErr opts $ Left $ NameUnhelpfulSpan name (FS.unpackFS msg) -+ reportAmbiguousErr opts $ Left $ NameUnhelpfulSpan name (FS.unpackFS $ unhelpfulSpanFS msg) - InfoAtPoint target sp mep -> hieFileCommand conn opts target $ \hf -> do - mapM_ (uncurry $ printInfo dynFlags) $ pointCommand hf sp mep $ \ast -> -- (hieTypeToIface . flip recoverFullType (hie_types hf) <$> nodeInfo ast, nodeSpan ast) -+ (hieTypeToIface . flip recoverFullType (hie_types hf) <$> nodeInfo' ast, nodeSpan ast) - RefGraph -> declRefs conn - Dump path -> do - nc <- newIORef =<< makeNc -@@ -450,13 +451,13 @@ showHieDbErr :: Options -> HieDbErr -> String - showHieDbErr opts e = case e of - NoNameAtPoint t spn -> unwords ["No symbols found at",ppSpan opts spn,"in",either id (\(mn,muid) -> ppMod opts mn ++ maybe "" (\uid -> "("++ppUnit opts uid++")") muid) t] - NotIndexed mn muid -> unwords ["Module", ppMod opts mn ++ maybe "" (\uid -> "("++ppUnit opts uid++")") muid, "not indexed."] -- AmbiguousUnitId xs -> unlines $ "UnitId could be any of:" : map ((" - "<>) . unitIdString . modInfoUnit) (toList xs) -+ AmbiguousUnitId xs -> unlines $ "Unit could be any of:" : map ((" - "<>) . unitString . modInfoUnit) (toList xs) - <> ["Use --unit-id to disambiguate"] - NameNotFound occ mn muid -> unwords - ["Couldn't find name:", ppName opts occ, maybe "" (("from module " ++) . moduleNameString) mn ++ maybe "" (\uid ->"("++ppUnit opts uid++")") muid] - NameUnhelpfulSpan nm msg -> unwords - ["Got no helpful spans for:", occNameString (nameOccName nm), "\nMsg:", msg] -- -+ - reportRefSpans :: Options -> [(Module,(Int,Int),(Int,Int),Maybe (Either FilePath BS.ByteString))] -> IO () - reportRefSpans opts xs = do - nc <- newIORef =<< makeNc -@@ -530,7 +531,7 @@ ppName = colouredPP Red occNameString - ppMod :: Options -> ModuleName -> String - ppMod = colouredPP Green moduleNameString - --ppUnit :: Options -> UnitId -> String -+ppUnit :: Options -> Unit -> String - ppUnit = colouredPP Yellow show - - ppSpan :: Options -> (Int,Int) -> String -diff --git a/src/HieDb/Types.hs b/src/HieDb/Types.hs -index 3e1717a..11ee355 100644 ---- a/src/HieDb/Types.hs -+++ b/src/HieDb/Types.hs -@@ -5,6 +5,7 @@ - {-# LANGUAGE BlockArguments #-} - {-# LANGUAGE GeneralizedNewtypeDeriving #-} - {-# LANGUAGE StandaloneDeriving #-} -+{-# LANGUAGE FlexibleInstances #-} - {-# OPTIONS_GHC -Wno-orphans #-} - module HieDb.Types where - -@@ -55,7 +56,7 @@ data SourceFile = RealFile FilePath | FakeFile (Maybe FilePath) - data ModuleInfo - = ModuleInfo - { modInfoName :: ModuleName -- , modInfoUnit :: UnitId -- ^ Identifies the package this module is part of -+ , modInfoUnit :: Unit -- ^ Identifies the package this module is part of - , modInfoIsBoot :: Bool -- ^ True, when this ModuleInfo was created by indexing @.hie-boot@ file; - -- False when it was created from @.hie@ file - , modInfoSrcFile :: Maybe FilePath -- ^ The path to the haskell source file, from which the @.hie@ file was created -@@ -79,6 +80,11 @@ instance ToField ModuleName where - instance FromField ModuleName where - fromField fld = mkModuleName . T.unpack <$> fromField fld - -+instance ToField (GenUnit UnitId) where -+ toField uid = SQLText $ T.pack $ unitString uid -+instance FromField (GenUnit UnitId) where -+ fromField fld = stringToUnit . T.unpack <$> fromField fld -+ - instance ToField UnitId where - toField uid = SQLText $ T.pack $ unitIdString uid - instance FromField UnitId where -@@ -139,7 +145,7 @@ data RefRow - { refSrc :: FilePath - , refNameOcc :: OccName - , refNameMod :: ModuleName -- , refNameUnit :: UnitId -+ , refNameUnit :: Unit - , refSLine :: Int - , refSCol :: Int - , refELine :: Int -@@ -175,7 +181,7 @@ instance FromRow DeclRow where - data TypeName = TypeName - { typeName :: OccName - , typeMod :: ModuleName -- , typeUnit :: UnitId -+ , typeUnit :: Unit - } - - data TypeRef = TypeRef -@@ -233,9 +239,9 @@ instance MonadIO m => NameCacheMonad (DbMonadT m) where - - - data HieDbErr -- = NotIndexed ModuleName (Maybe UnitId) -+ = NotIndexed ModuleName (Maybe Unit) - | AmbiguousUnitId (NonEmpty ModuleInfo) -- | NameNotFound OccName (Maybe ModuleName) (Maybe UnitId) -+ | NameNotFound OccName (Maybe ModuleName) (Maybe Unit) - | NoNameAtPoint HieTarget (Int,Int) - | NameUnhelpfulSpan Name String - -@@ -251,7 +257,8 @@ instance Show Symbol where - <> ":" - <> moduleNameString (moduleName $ symModule s) - <> ":" -- <> unitIdString (moduleUnitId $ symModule s) -+ -- <> unitIdString (moduleUnit $ symModule s) -+ <> unitString (moduleUnit $ symModule s) - - instance Read Symbol where - readsPrec = const $ R.readP_to_S readSymbol -@@ -275,7 +282,7 @@ readSymbol = do - u <- R.many1 R.get - R.eof - let mn = mkModuleName m -- uid = stringToUnitId u -+ uid = stringToUnit u - sym = Symbol - { symName = mkOccName ns n - , symModule = mkModule uid mn -@@ -288,5 +295,5 @@ newtype LibDir = LibDir FilePath - - -- | A way to specify which HieFile to operate on. - -- Either the path to @.hie@ file is given in the Left ---- Or ModuleName (with optional UnitId) is given in the Right --type HieTarget = Either FilePath (ModuleName, Maybe UnitId) -+-- Or ModuleName (with optional Unit) is given in the Right -+type HieTarget = Either FilePath (ModuleName, Maybe Unit) -diff --git a/src/HieDb/Utils.hs b/src/HieDb/Utils.hs -index 9e5b34e..1ca1cab 100644 ---- a/src/HieDb/Utils.hs -+++ b/src/HieDb/Utils.hs -@@ -26,6 +26,7 @@ import DynFlags - import SysTools - - import qualified Data.Map as M -+import qualified Data.Set as S - - import qualified FastString as FS - -@@ -71,7 +72,8 @@ addTypeRef (getConn -> conn) hf arr ixs sp = go 0 - #endif - HTyConApp _ (HieArgs xs) -> mapM_ (next . snd) xs - HForAllTy ((_ , a),_) b -> mapM_ next [a,b] -- HFunTy a b -> mapM_ next [a,b] -+ -- HFunTy a b -> mapM_ next [a,b] -+ HFunTy a b _ -> mapM_ next [a,b] - HQualTy a b -> mapM_ next [a,b] - HLitTy _ -> pure () - HCastTy a -> go d a -@@ -115,9 +117,9 @@ findDefInFile occ mdl file = do - nc <- readIORef ncr - return $ case lookupOrigNameCache (nsNames nc) mdl occ of - Just name -> case nameSrcSpan name of -- RealSrcSpan sp -> Right (sp, mdl) -- UnhelpfulSpan msg -> Left $ NameUnhelpfulSpan name (FS.unpackFS msg) -- Nothing -> Left $ NameNotFound occ (Just $ moduleName mdl) (Just $ moduleUnitId mdl) -+ RealSrcSpan sp _ -> Right (sp, mdl) -+ UnhelpfulSpan msg -> Left $ NameUnhelpfulSpan name (FS.unpackFS $ unhelpfulSpanFS msg) -+ Nothing -> Left $ NameNotFound occ (Just $ moduleName mdl) (Just $ moduleUnit mdl) - - pointCommand :: HieFile -> (Int, Int) -> Maybe (Int, Int) -> (HieAST TypeIndex -> a) -> [a] - pointCommand hf (sl,sc) mep k = -@@ -158,7 +160,7 @@ genRefsAndDecls path smdl refmap = genRows $ flat $ M.toList refmap - - goRef (Right name, (sp,_)) - | Just mod <- nameModule_maybe name = Just $ -- RefRow path occ (moduleName mod) (moduleUnitId mod) sl sc el ec -+ RefRow path occ (moduleName mod) (moduleUnit mod) sl sc el ec - where - occ = nameOccName name - sl = srcSpanStartLine sp -@@ -198,7 +200,7 @@ genDefRow path smod refmap = genRows $ M.toList refmap - where - genRows = mapMaybe go - getSpan name dets -- | RealSrcSpan sp <- nameSrcSpan name = Just sp -+ | RealSrcSpan sp _ <- nameSrcSpan name = Just sp - | otherwise = do - (sp, _dets) <- find defSpan dets - pure sp -@@ -222,8 +224,24 @@ genDefRow path smod refmap = genRows $ M.toList refmap - go _ = Nothing - - identifierTree :: HieTypes.HieAST a -> Data.Tree.Tree ( HieTypes.HieAST a ) --identifierTree HieTypes.Node{ nodeInfo, nodeSpan, nodeChildren } = -+identifierTree n...@hietypes.node{ nodeChildren } = - Data.Tree.Node -- { rootLabel = HieTypes.Node{ nodeInfo, nodeSpan, nodeChildren = mempty } -+ { rootLabel = nd { nodeChildren = mempty } - , subForest = map identifierTree nodeChildren - } -+ -+-- 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 -diff --git a/test/Main.hs b/test/Main.hs -index c9023d2..42d2850 100644 ---- a/test/Main.hs -+++ b/test/Main.hs -@@ -6,7 +6,7 @@ import HieDb.Query (getAllIndexedMods, lookupHieFile, resolveUnitId, lookupHieFi - import HieDb.Run (Command (..), Options (..), runCommand) - import HieDb.Types (HieDbErr (..), SourceFile(..), runDbM) - import HieDb.Utils (makeNc) --import Module (mkModuleName, moduleNameString, stringToUnitId) -+import Module (mkModuleName, moduleNameString, stringToUnit) - import System.Directory (findExecutable, getCurrentDirectory, removeDirectoryRecursive) - import System.Exit (ExitCode (..), die) - import System.FilePath ((</>)) -@@ -53,7 +53,7 @@ apiSpec = describe "api" $ - res <- resolveUnitId conn (mkModuleName "Module1") - case res of - Left e -> fail $ "Unexpected error: " <> show e -- Right unitId -> unitId `shouldBe` stringToUnitId "main" -+ Right unit -> unit `shouldBe` stringToUnit "main" - - it "returns NotIndexed error on not-indexed module" $ \conn -> do - let notIndexedModule = mkModuleName "NotIndexed" -@@ -61,12 +61,12 @@ apiSpec = describe "api" $ - case res of - Left (NotIndexed modName Nothing) -> modName `shouldBe` notIndexedModule - Left e -> fail $ "Unexpected error: " <> show e -- Right unitId -> fail $ "Unexpected success: " <> show unitId -+ Right unit -> fail $ "Unexpected success: " <> show unit - - describe "lookupHieFile" $ do - it "Should lookup indexed Module" $ \conn -> do - let modName = mkModuleName "Module1" -- res <- lookupHieFile conn modName (stringToUnitId "main") -+ res <- lookupHieFile conn modName (stringToUnit "main") - case res of - Just modRow -> do - hieModuleHieFile modRow `shouldEndWith` "Module1.hie" -@@ -75,7 +75,7 @@ apiSpec = describe "api" $ - modInfoName modInfo `shouldBe` modName - Nothing -> fail "Should have looked up indexed file" - it "Should return Nothing for not indexed Module" $ \conn -> do -- res <- lookupHieFile conn (mkModuleName "NotIndexed") (stringToUnitId "main") -+ res <- lookupHieFile conn (mkModuleName "NotIndexed") (stringToUnit "main") - case res of - Nothing -> pure () - Just _ -> fail "Lookup suceeded unexpectedly" -@@ -203,18 +203,20 @@ cliSpec = - , "Identifiers:" - , "Symbol:c:Data1Constructor1:Sub.Module2:main" - , "Data1Constructor1 defined at test/data/Sub/Module2.hs:10:7-23" -- , " IdentifierDetails Nothing {Decl ConDec (Just SrcSpanOneLine \"test/data/Sub/Module2.hs\" 10 7 24)}" -+ , " Details: Nothing {declaration of constructor bound at: test/data/Sub/Module2.hs:10:7-23}" - , "Types:\n" - ] - it "correctly prints type signatures" $ - runHieDbCli ["point-info", "Module1", "10", "10"] - `suceedsWithStdin` unlines - [ "Span: test/data/Module1.hs:10:8-11" -- , "Constructors: {(HsVar, HsExpr), (HsWrap, HsExpr)}" -+ , "Constructors: {(HsVar, HsExpr), (XExpr, HsExpr)}" - , "Identifiers:" - , "Symbol:v:even:GHC.Real:base" - , "even defined at <no location info>" -- , " IdentifierDetails Just forall a. Integral a => a -> Bool {Use}" -+ , " Details: Just forall a. Integral a => a -> Bool {usage}" -+ , "$dIntegral defined at <no location info>" -+ , " Details: Just Integral Int {usage of evidence variable}" - , "Types:" - , "Int -> Bool" - , "forall a. Integral a => a -> Bool" -@@ -252,7 +254,7 @@ cliSpec = - it "lists uids for given module" $ - runHieDbCli ["module-uids", "Module1"] - `suceedsWithStdin` "main\n" -- -+ - describe "rm" $ - it "removes given module from DB" $ do - runHieDbCli ["rm", "Module1"] -@@ -260,7 +262,7 @@ cliSpec = - -- Check with 'ls' comand that there's just one module left - cwd <- getCurrentDirectory - runHieDbCli ["ls"] `suceedsWithStdin` (cwd </> testTmp </> "Sub/Module2.hie\tSub.Module2\tmain\n") -- -+ - - - suceedsWithStdin :: IO (ExitCode, String, String) -> String -> Expectation -diff --git a/test/Test/Orphans.hs b/test/Test/Orphans.hs -index af1124a..3d7684b 100644 ---- a/test/Test/Orphans.hs -+++ b/test/Test/Orphans.hs -@@ -3,7 +3,7 @@ - module Test.Orphans where - - import HieDb.Types --import Module (ModuleName, moduleName, moduleNameString, moduleUnitId) -+import Module (ModuleName, moduleName, moduleNameString, moduleUnit) - import Name (Name, nameModule, nameOccName) - import OccName (OccName, occNameString) - -@@ -14,7 +14,7 @@ instance Show Name where - let occ = nameOccName n - mod' = nameModule n - mn = moduleName mod' -- uid = moduleUnitId mod' -+ uid = moduleUnit mod' - in show uid <> ":" <> show mn <> ":" <> show occ - - deriving instance Show HieDbErr - -From 511dbb8dfe85d7c1625cb92051948d550c69b5c1 Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= <anka....@gmail.com> -Date: Tue, 30 Mar 2021 01:55:37 +0800 -Subject: [PATCH 2/7] Make changes backwards-compatible - ---- - hiedb.cabal | 1 + - src/HieDb/Compat.hs | 49 +++++++++++++++++++++++++++++++++++++++++++++ - src/HieDb/Create.hs | 3 ++- - src/HieDb/Query.hs | 1 + - src/HieDb/Run.hs | 6 ++++++ - src/HieDb/Types.hs | 11 ++++------ - src/HieDb/Utils.hs | 33 +++++++++++++----------------- - 7 files changed, 77 insertions(+), 27 deletions(-) - create mode 100644 src/HieDb/Compat.hs - -diff --git a/hiedb.cabal b/hiedb.cabal -index f198504..540a278 100644 ---- a/hiedb.cabal -+++ b/hiedb.cabal -@@ -49,6 +49,7 @@ library - HieDb.Utils, - HieDb.Create, - HieDb.Query, -+ HieDb.Compat, - HieDb.Types, - HieDb.Dump, - HieDb.Html, -diff --git a/src/HieDb/Compat.hs b/src/HieDb/Compat.hs -new file mode 100644 -index 0000000..9fe8b6c ---- /dev/null -+++ b/src/HieDb/Compat.hs -@@ -0,0 +1,49 @@ -+ -+{-# LANGUAGE CPP #-} -+module HieDb.Compat where -+ -+import Compat.HieTypes -+ -+#if __GLASGOW_HASKELL__ >= 900 -+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 -+ -+import Module -+ -+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 -diff --git a/src/HieDb/Create.hs b/src/HieDb/Create.hs -index 57c3fac..47e76a5 100644 ---- a/src/HieDb/Create.hs -+++ b/src/HieDb/Create.hs -@@ -32,9 +32,10 @@ import System.Directory - - import Database.SQLite.Simple - -+import HieDb.Compat - import HieDb.Types - import HieDb.Utils --import GHC.Data.FastString as FS ( FastString ) -+import FastString as FS ( FastString ) - - sCHEMA_VERSION :: Integer - sCHEMA_VERSION = 5 -diff --git a/src/HieDb/Query.hs b/src/HieDb/Query.hs -index 9fe9913..29f44d5 100644 ---- a/src/HieDb/Query.hs -+++ b/src/HieDb/Query.hs -@@ -33,6 +33,7 @@ import Data.IORef - import Database.SQLite.Simple - - import HieDb.Dump (sourceCode) -+import HieDb.Compat - import HieDb.Types - import HieDb.Utils - import qualified HieDb.Html as Html -diff --git a/src/HieDb/Run.hs b/src/HieDb/Run.hs -index 0c98134..b92adb2 100644 ---- a/src/HieDb/Run.hs -+++ b/src/HieDb/Run.hs -@@ -1,3 +1,4 @@ -+{-# LANGUAGE CPP #-} - {-# LANGUAGE FlexibleContexts #-} - {-# LANGUAGE OverloadedStrings #-} - {-# LANGUAGE BlockArguments #-} -@@ -49,6 +50,7 @@ import qualified Data.ByteString.Char8 as BS - import Options.Applicative - - import HieDb -+import HieDb.Compat - import HieDb.Dump - - hiedbMain :: LibDir -> IO () -@@ -362,7 +364,11 @@ runCommand libdir opts cmd = withHieDbAndFlags libdir (database opts) $ \dynFlag - reportAmbiguousErr opts (Left $ NoNameAtPoint target sp) - forM_ names $ \name -> do - case nameSrcSpan name of -+#if __GLASGOW_HASKELL__ >= 900 - RealSrcSpan dsp _ -> do -+#else -+ RealSrcSpan dsp -> do -+#endif - unless (quiet opts) $ - hPutStrLn stderr $ unwords ["Name", ppName opts (nameOccName name),"at",ppSpan opts sp,"is defined at:"] - contents <- case nameModule_maybe name of -diff --git a/src/HieDb/Types.hs b/src/HieDb/Types.hs -index 11ee355..3bc2ec7 100644 ---- a/src/HieDb/Types.hs -+++ b/src/HieDb/Types.hs -@@ -35,6 +35,8 @@ import Database.SQLite.Simple.FromField - - import qualified Text.ParserCombinators.ReadP as R - -+import HieDb.Compat -+ - newtype HieDb = HieDb { getConn :: Connection } - - data HieDbException -@@ -80,16 +82,11 @@ instance ToField ModuleName where - instance FromField ModuleName where - fromField fld = mkModuleName . T.unpack <$> fromField fld - --instance ToField (GenUnit UnitId) where -+instance ToField Unit where - toField uid = SQLText $ T.pack $ unitString uid --instance FromField (GenUnit UnitId) where -+instance FromField Unit where - fromField fld = stringToUnit . T.unpack <$> fromField fld - --instance ToField UnitId where -- toField uid = SQLText $ T.pack $ unitIdString uid --instance FromField UnitId where -- fromField fld = stringToUnitId . T.unpack <$> fromField fld -- - instance ToField Fingerprint where - toField hash = SQLText $ T.pack $ show hash - instance FromField Fingerprint where -diff --git a/src/HieDb/Utils.hs b/src/HieDb/Utils.hs -index 1ca1cab..d47a8b2 100644 ---- a/src/HieDb/Utils.hs -+++ b/src/HieDb/Utils.hs -@@ -26,7 +26,6 @@ import DynFlags - import SysTools - - import qualified Data.Map as M --import qualified Data.Set as S - - import qualified FastString as FS - -@@ -46,6 +45,7 @@ import Data.Monoid - import Data.IORef - - import HieDb.Types -+import HieDb.Compat - import Database.SQLite.Simple - - addTypeRef :: HieDb -> FilePath -> A.Array TypeIndex HieTypeFlat -> A.Array TypeIndex (Maybe Int64) -> RealSrcSpan -> TypeIndex -> IO () -@@ -72,8 +72,11 @@ addTypeRef (getConn -> conn) hf arr ixs sp = go 0 - #endif - HTyConApp _ (HieArgs xs) -> mapM_ (next . snd) xs - HForAllTy ((_ , a),_) b -> mapM_ next [a,b] -- -- HFunTy a b -> mapM_ next [a,b] -- HFunTy a b _ -> mapM_ next [a,b] -+#if __GLASGOW_HASKELL__ >= 900 -+ HFunTy a b c -> mapM_ next [a,b,c] -+#else -+ HFunTy a b -> mapM_ next [a,b] -+#endif - HQualTy a b -> mapM_ next [a,b] - HLitTy _ -> pure () - HCastTy a -> go d a -@@ -117,7 +120,11 @@ findDefInFile occ mdl file = do - nc <- readIORef ncr - return $ case lookupOrigNameCache (nsNames nc) mdl occ of - Just name -> case nameSrcSpan name of -+#if __GLASGOW_HASKELL__ >= 900 - RealSrcSpan sp _ -> Right (sp, mdl) -+#else -+ RealSrcSpan sp -> Right (sp, mdl) -+#endif - UnhelpfulSpan msg -> Left $ NameUnhelpfulSpan name (FS.unpackFS $ unhelpfulSpanFS msg) - Nothing -> Left $ NameNotFound occ (Just $ moduleName mdl) (Just $ moduleUnit mdl) - -@@ -200,7 +207,11 @@ genDefRow path smod refmap = genRows $ M.toList refmap - where - genRows = mapMaybe go - getSpan name dets -+#if __GLASGOW_HASKELL__ >= 900 - | RealSrcSpan sp _ <- nameSrcSpan name = Just sp -+#else -+ | RealSrcSpan sp <- nameSrcSpan name = Just sp -+#endif - | otherwise = do - (sp, _dets) <- find defSpan dets - pure sp -@@ -229,19 +240,3 @@ identifierTree n...@hietypes.node{ nodeChildren } = - { rootLabel = nd { nodeChildren = mempty } - , subForest = map identifierTree nodeChildren - } -- ---- 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 - -From 06db1ed8e2d97ba64b88d928f622c5a8adc7389d Mon Sep 17 00:00:00 2001 -From: =?UTF-8?q?Andreas=20K=C3=A4llberg?= <anka....@gmail.com> -Date: Tue, 30 Mar 2021 02:41:59 +0800 -Subject: [PATCH 3/7] Fix warnings and tests - ---- - cabal.project | 3 --- - src/HieDb/Compat.hs | 15 ++++++++++++--- - src/HieDb/Query.hs | 2 +- - src/HieDb/Run.hs | 2 -- - test/Main.hs | 16 +++++++++++++++- - test/Test/Orphans.hs | 3 ++- - 6 files changed, 30 insertions(+), 11 deletions(-) - delete mode 100644 cabal.project - -diff --git a/cabal.project b/cabal.project -deleted file mode 100644 -index 5aaedaa..0000000 ---- a/cabal.project -+++ /dev/null -@@ -1,3 +0,0 @@ --packages: . ---- package hiedb ---- ghc-options: -fwrite-ide-info -hiedir /home/zubin/hiedb/.hie/ -diff --git a/src/HieDb/Compat.hs b/src/HieDb/Compat.hs -index 9fe8b6c..98c224a 100644 ---- a/src/HieDb/Compat.hs -+++ b/src/HieDb/Compat.hs -@@ -1,10 +1,21 @@ - - {-# LANGUAGE CPP #-} --module HieDb.Compat where -+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 -@@ -29,8 +40,6 @@ combineNodeInfo' :: Ord a => NodeInfo a -> NodeInfo a -> NodeInfo a - #else - import qualified FastString as FS - --import Module -- - nodeInfo' :: HieAST TypeIndex -> NodeInfo TypeIndex - nodeInfo' = nodeInfo - type Unit = UnitId -diff --git a/src/HieDb/Query.hs b/src/HieDb/Query.hs -index 29f44d5..cde533e 100644 ---- a/src/HieDb/Query.hs -+++ b/src/HieDb/Query.hs -@@ -12,7 +12,7 @@ import qualified Algebra.Graph.Export.Dot as G - - import GHC - import Compat.HieTypes --import Module -+-- import Module - import Name - - import System.Directory -diff --git a/src/HieDb/Run.hs b/src/HieDb/Run.hs -index b92adb2..b0e737e 100644 ---- a/src/HieDb/Run.hs -+++ b/src/HieDb/Run.hs -@@ -12,10 +12,8 @@ import GHC - import Compat.HieTypes - import Compat.HieUtils - import Name --import Module - import Outputable ((<+>),hang,showSDoc,ppr,text) - import IfaceType (IfaceType) --import SrcLoc - - import qualified FastString as FS - -diff --git a/test/Main.hs b/test/Main.hs -index 42d2850..a88d520 100644 ---- a/test/Main.hs -+++ b/test/Main.hs -@@ -1,3 +1,4 @@ -+{-# LANGUAGE CPP #-} - module Main where - - import GHC.Paths (libdir) -@@ -6,7 +7,8 @@ import HieDb.Query (getAllIndexedMods, lookupHieFile, resolveUnitId, lookupHieFi - import HieDb.Run (Command (..), Options (..), runCommand) - import HieDb.Types (HieDbErr (..), SourceFile(..), runDbM) - import HieDb.Utils (makeNc) --import Module (mkModuleName, moduleNameString, stringToUnit) -+import HieDb.Compat (stringToUnit) -+import Module (mkModuleName, moduleNameString) - import System.Directory (findExecutable, getCurrentDirectory, removeDirectoryRecursive) - import System.Exit (ExitCode (..), die) - import System.FilePath ((</>)) -@@ -203,20 +205,32 @@ cliSpec = - , "Identifiers:" - , "Symbol:c:Data1Constructor1:Sub.Module2:main" - , "Data1Constructor1 defined at test/data/Sub/Module2.hs:10:7-23" -+#if __GLASGOW_HASKELL__ >= 900 - , " Details: Nothing {declaration of constructor bound at: test/data/Sub/Module2.hs:10:7-23}" -+#else -+ , " IdentifierDetails Nothing {Decl ConDec (Just SrcSpanOneLine \"test/data/Sub/Module2.hs\" 10 7 24)}" -+#endif - , "Types:\n" - ] - it "correctly prints type signatures" $ - runHieDbCli ["point-info", "Module1", "10", "10"] - `suceedsWithStdin` unlines - [ "Span: test/data/Module1.hs:10:8-11" -+#if __GLASGOW_HASKELL__ >= 900 - , "Constructors: {(HsVar, HsExpr), (XExpr, HsExpr)}" -+#else -+ , "Constructors: {(HsVar, HsExpr), (HsWrap, HsExpr)}" -+#endif - , "Identifiers:" - , "Symbol:v:even:GHC.Real:base" - , "even defined at <no location info>" -+#if __GLASGOW_HASKELL__ >= 900 - , " Details: Just forall a. Integral a => a -> Bool {usage}" - , "$dIntegral defined at <no location info>" - , " Details: Just Integral Int {usage of evidence variable}" -+#else -+ , " IdentifierDetails Just forall a. Integral a => a -> Bool {Use}" -+#endif - , "Types:" - , "Int -> Bool" - , "forall a. Integral a => a -> Bool" -diff --git a/test/Test/Orphans.hs b/test/Test/Orphans.hs -index 3d7684b..b114dc4 100644 ---- a/test/Test/Orphans.hs -+++ b/test/Test/Orphans.hs -@@ -2,8 +2,9 @@ - {-# OPTIONS_GHC -fno-warn-orphans #-} - module Test.Orphans where - -+import HieDb.Compat - import HieDb.Types --import Module (ModuleName, moduleName, moduleNameString, moduleUnit) -+import Module (ModuleName, moduleName, moduleNameString) - import Name (Name, nameModule, nameOccName) - import OccName (OccName, occNameString) - -