Fix GHC<7.10

This commit is contained in:
Daniel Gröber 2016-01-09 23:39:04 +01:00
parent 16b63cf22c
commit 363aa10fcd
2 changed files with 20 additions and 7 deletions

View File

@ -24,8 +24,8 @@ import Control.Exception
import Control.Concurrent import Control.Concurrent
import Data.List import Data.List
import Data.Binary import Data.Binary
import Data.ByteString (ByteString)
import Data.IORef import Data.IORef
import qualified Data.ByteString as BS
import qualified Data.ByteString.Lazy as LBS import qualified Data.ByteString.Lazy as LBS
import qualified GHC as G import qualified GHC as G
import FastString import FastString
@ -51,19 +51,19 @@ import System.Directory
import System.Directory.ModTime import System.Directory.ModTime
import System.FilePath ((</>)) import System.FilePath ((</>))
import System.IO import System.IO
import System.IO.Unsafe (unsafeInterleaveIO) import System.IO.Unsafe (unsafeInterleaveIO, unsafePerformIO)
import Prelude import Prelude
import Data.Map.Strict (Map) import Data.Map (Map)
import qualified Data.Map.Strict as M import qualified Data.Map as M
import Data.Set (Set) import Data.Set (Set)
import qualified Data.Set as S import qualified Data.Set as S
---------------------------------------------------------------- ----------------------------------------------------------------
-- | Type of function and operation names. -- | Type of function and operation names.
type Symbol = ByteString type Symbol = BS.ByteString
type ModuleNameBS = ByteString type ModuleNameBS = BS.ByteString
-- | Database from 'Symbol' to \['ModuleString'\]. -- | Database from 'Symbol' to \['ModuleString'\].
data SymbolDb = SymbolDb data SymbolDb = SymbolDb
@ -90,7 +90,7 @@ lookupSymbol :: IOish m => String -> SymbolDb -> GhcModT m String
lookupSymbol sym db = convert' $ lookupSym (fastStringToByteString $ mkFastString sym) db lookupSymbol sym db = convert' $ lookupSym (fastStringToByteString $ mkFastString sym) db
lookupSym :: Symbol -> SymbolDb -> [ModuleString] lookupSym :: Symbol -> SymbolDb -> [ModuleString]
lookupSym sym db = map (ModuleString . unpackFS . mkFastStringByteString) $ M.findWithDefault [] sym $ table db lookupSym sym db = map (ModuleString . unpackFS . mkFastStringByteString') $ M.findWithDefault [] sym $ table db
--------------------------------------------------------------- ---------------------------------------------------------------
@ -173,6 +173,18 @@ extractBindings (Just inf) mdl = M.fromList $ do
mdls = S.singleton $ fastStringToByteString $ moduleNameFS $ moduleName mdl mdls = S.singleton $ fastStringToByteString $ moduleNameFS $ moduleName mdl
return (sym, mdls) return (sym, mdls)
mkFastStringByteString' :: BS.ByteString -> FastString
#if !MIN_VERSION_ghc(7,8,0)
fastStringToByteString :: FastString -> BS.ByteString
fastStringToByteString = BS.pack . bytesFS
mkFastStringByteString' = mkFastStringByteList . BS.unpack
#elif __GLASGOW_HASKELL__ == 708
mkFastStringByteString' = unsafePerformIO . mkFastStringByteString
#else
mkFastStringByteString' = mkFastStringByteString
#endif
---------------------------------------------------------------- ----------------------------------------------------------------
data AsyncSymbolDb = AsyncSymbolDb FilePath (MVar (Either SomeException SymbolDb)) data AsyncSymbolDb = AsyncSymbolDb FilePath (MVar (Either SomeException SymbolDb))

View File

@ -1,3 +1,4 @@
{-# LANGUAGE OverloadedStrings #-}
module FindSpec where module FindSpec where
import Language.Haskell.GhcMod.Find import Language.Haskell.GhcMod.Find