Merge pull request #735 from gibiansky/ghc821-nix

Work with GHC 8.2
This commit is contained in:
Vaibhav Sagar 2017-10-15 16:55:23 +08:00 committed by GitHub
commit 6dad1002af
12 changed files with 88 additions and 11 deletions

View File

@ -33,7 +33,7 @@ library
-- other-modules:
-- other-extensions:
build-depends: base >=4.6 && < 5,
ghc >=7.6 && <8.1
ghc >=7.6 && <8.3
if impl(ghc >= 7.6) && impl(ghc < 7.8)
hs-source-dirs: generic-src src-7.6

View File

@ -53,7 +53,7 @@ library
-- other-modules:
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.10,
build-depends: base >=4.6 && <4.11,
here,
text,
bytestring,

View File

@ -54,7 +54,7 @@ library
other-modules: IHaskell.Display.Diagrams.Animation
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.10,
build-depends: base >=4.6 && <4.11,
text,
bytestring,
directory,

View File

@ -54,7 +54,7 @@ library
-- other-modules:
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.10,
build-depends: base >=4.6 && <4.11,
bytestring,
gnuplot >= 0.5.4,
ihaskell >= 0.6.2

View File

@ -14,7 +14,7 @@ cabal-version: >=1.16
library
exposed-modules: IHaskell.Display.Hatex
build-depends: base >=4.6 && <4.10,
build-depends: base >=4.6 && <4.11,
text,
HaTeX >= 3.9,
ihaskell >= 0.5

View File

@ -57,7 +57,7 @@ library
-- other-modules:
-- Other library packages from which modules are imported.
build-depends: base >=4.6 && <4.10,
build-depends: base >=4.6 && <4.11,
magic >= 1.0.8,
text,
bytestring,

View File

@ -92,7 +92,7 @@ library
build-depends: bin-package-db
if impl(ghc >= 8.0)
build-depends: ghc-boot >=8.0 && <8.1
build-depends: ghc-boot >=8.0 && <8.3
exposed-modules: IHaskell.Display
IHaskell.Convert
@ -134,7 +134,7 @@ executable ihaskell
default-language: Haskell2010
build-depends:
ihaskell -any,
base >=4.6 && < 4.10,
base >=4.6 && < 4.11,
text >=0.11,
transformers -any,
ghc >=7.6 || < 7.11,

View File

@ -29,7 +29,9 @@ import Data.Maybe (fromJust)
import System.Environment (getEnv)
import GHC hiding (Qualified)
#if MIN_VERSION_ghc(7,10,0)
#if MIN_VERSION_ghc(8,2,0)
import GHC.PackageDb
#elif MIN_VERSION_ghc(7,10,0)
import GHC.PackageDb (ExposedModule(exposedName))
#endif
import DynFlags
@ -61,6 +63,9 @@ data CompletionType = Empty
| KernelOption String
| Extension String
deriving (Show, Eq)
#if MIN_VERSION_ghc(8,2,0)
exposedName = fst
#endif
#if MIN_VERSION_ghc(7,10,0)
extName (FlagSpec { flagSpecName = name }) = name
#else

View File

@ -188,7 +188,13 @@ interpret libdir allowedStdin action = runGhc (Just libdir) $ do
packageIdString' :: DynFlags -> PackageConfig -> String
packageIdString' dflags pkg_cfg =
#if MIN_VERSION_ghc(8,0,0)
#if MIN_VERSION_ghc(8,2,0)
case (lookupPackage dflags $ packageConfigId pkg_cfg) of
Nothing -> "(unknown)"
Just cfg -> let
PackageName name = packageName cfg
in unpackFS name
#elif MIN_VERSION_ghc(8,0,0)
fromMaybe "(unknown)" (unitIdPackageIdString dflags $ packageConfigId pkg_cfg)
#elif MIN_VERSION_ghc(7,10,2)
fromMaybe "(unknown)" (packageKeyPackageIdString dflags $ packageConfigId pkg_cfg)
@ -222,8 +228,13 @@ initializeImports = do
initStr = "ihaskell-"
#if MIN_VERSION_ghc(8,2,0)
-- Name of the ihaskell package, i.e. "ihaskell"
iHaskellPkgName = "ihaskell"
#else
-- Name of the ihaskell package, e.g. "ihaskell-1.2.3.4"
iHaskellPkgName = initStr ++ intercalate "." (map show (versionBranch version))
#endif
#if !MIN_VERSION_ghc(8,0,0)
unitId = packageId
@ -254,7 +265,11 @@ initializeImports = do
dropFirstAndLast = reverse . drop 1 . reverse . drop 1
toImportStmt :: String -> String
#if MIN_VERSION_ghc(8,2,0)
toImportStmt = printf importFmt . concatMap capitalize . drop 1 . split "-"
#else
toImportStmt = printf importFmt . concatMap capitalize . dropFirstAndLast . split "-"
#endif
displayImports = map toImportStmt displayPkgs
@ -841,16 +856,28 @@ evalCommand output (Expression expr) state = do
-- is no appropriate typeclass instance, this will throw an exception and thus `attempt` will return
-- False, and we just resort to plaintext.
let displayExpr = printf "(IHaskell.Display.display (%s))" expr :: String
#if MIN_VERSION_ghc(8,2,0)
canRunDisplay <- attempt $ exprType TM_Inst displayExpr
#else
canRunDisplay <- attempt $ exprType displayExpr
#endif
-- Check if this is a widget.
let widgetExpr = printf "(IHaskell.Display.Widget (%s))" expr :: String
#if MIN_VERSION_ghc(8,2,0)
isWidget <- attempt $ exprType TM_Inst widgetExpr
#else
isWidget <- attempt $ exprType widgetExpr
#endif
-- Check if this is a template haskell declaration
let declExpr = printf "((id :: IHaskellTH.DecsQ -> IHaskellTH.DecsQ) (%s))" expr :: String
let anyExpr = printf "((id :: IHaskellPrelude.Int -> IHaskellPrelude.Int) (%s))" expr :: String
#if MIN_VERSION_ghc(8,2,0)
isTHDeclaration <- liftM2 (&&) (attempt $ exprType TM_Inst declExpr) (not <$> attempt (exprType TM_Inst anyExpr))
#else
isTHDeclaration <- liftM2 (&&) (attempt $ exprType declExpr) (not <$> attempt (exprType anyExpr))
#endif
write state $ "Can Display: " ++ show canRunDisplay
write state $ "Is Widget: " ++ show isWidget
@ -946,7 +973,11 @@ evalCommand output (Expression expr) state = do
then display :: Display
else removeSvg display
#if MIN_VERSION_ghc(8,2,0)
isIO expr = attempt $ exprType TM_Inst $ printf "((\\x -> x) :: IO a -> IO a) (%s)" expr
#else
isIO expr = attempt $ exprType $ printf "((\\x -> x) :: IO a -> IO a) (%s)" expr
#endif
postprocessShowError :: EvalOut -> EvalOut
postprocessShowError evalOut = evalOut { evalResult = Display $ map postprocess disps }
@ -996,7 +1027,11 @@ evalCommand _ (Declaration decl) state = wrapExecution state $ do
-- Get all the type strings.
dflags <- getSessionDynFlags
types <- forM nonDataNames $ \name -> do
#if MIN_VERSION_ghc(8,2,0)
theType <- showSDocUnqual dflags . ppr <$> exprType TM_Inst name
#else
theType <- showSDocUnqual dflags . ppr <$> exprType name
#endif
return $ name ++ " :: " ++ theType
return $ Display [html $ unlines $ map formatGetType types]
@ -1309,7 +1344,11 @@ evalStatementOrIO publish state cmd = do
else do
-- Get all the type strings.
types <- forM nonItNames $ \name -> do
#if MIN_VERSION_ghc(8,2,0)
theType <- showSDocUnqual dflags . ppr <$> exprType TM_Inst name
#else
theType <- showSDocUnqual dflags . ppr <$> exprType name
#endif
return $ name ++ " :: " ++ theType
let joined = unlines types

View File

@ -1,4 +1,4 @@
{-# LANGUAGE NoImplicitPrelude, OverloadedStrings #-}
{-# LANGUAGE CPP, NoImplicitPrelude, OverloadedStrings #-}
{- | Description : Inspect type and function information and documentation. -}
module IHaskell.Eval.Info (info) where
@ -19,7 +19,11 @@ import Exception
info :: String -> Interpreter String
info name = ghandle handler $ do
dflags <- getSessionDynFlags
#if MIN_VERSION_ghc(8,2,0)
result <- exprType TM_Inst name
#else
result <- exprType name
#endif
return $ typeCleaner $ showPpr dflags result
where
handler :: SomeException -> Interpreter String

View File

@ -224,7 +224,11 @@ doc :: GhcMonad m => O.SDoc -> m String
doc sdoc = do
flags <- getSessionDynFlags
unqual <- getPrintUnqual
#if MIN_VERSION_ghc(8,2,0)
let style = O.mkUserStyle flags unqual O.AllTheWay
#else
let style = O.mkUserStyle unqual O.AllTheWay
#endif
let cols = pprCols flags
d = O.runSDoc sdoc (O.initSDocContext flags style)
return $ Pretty.fullRender Pretty.PageMode cols 1.5 string_txt "" d
@ -256,6 +260,21 @@ initGhci sandboxPackages = do
#else
dflags = flag Opt_ExtendedDefaultRules . unflag Opt_MonomorphismRestriction $ originalFlags
#endif
#if MIN_VERSION_ghc(8,2,0)
pkgFlags =
case sandboxPackages of
Nothing -> packageDBFlags originalFlags
Just path ->
let pkg = PackageDB $ PkgConfFile path
in packageDBFlags originalFlags ++ [pkg]
void $ setSessionDynFlags $ dflags
{ hscTarget = HscInterpreted
, ghcLink = LinkInMemory
, pprCols = 300
, packageDBFlags = pkgFlags
}
#else
pkgConfs =
case sandboxPackages of
Nothing -> extraPkgConfs originalFlags
@ -269,6 +288,7 @@ initGhci sandboxPackages = do
, pprCols = 300
, extraPkgConfs = pkgConfs
}
#endif
-- | Evaluate a single import statement. If this import statement is importing a module which was
-- previously imported implicitly (such as `Prelude`) or if this module has a `hiding` annotation,
@ -359,7 +379,11 @@ cleanUpDuplicateInstances = modifySession $ \hscEnv ->
-- | Get the type of an expression and convert it to a string.
getType :: GhcMonad m => String -> m String
getType expr = do
#if MIN_VERSION_ghc(8,2,0)
result <- exprType TM_Inst expr
#else
result <- exprType expr
#endif
flags <- getSessionDynFlags
let typeStr = O.showSDocUnqual flags $ O.ppr result
return typeStr

View File

@ -159,6 +159,11 @@ testEval =
"putStrLn \"Привет!\"" `becomes` ["Привет!"]
it "evaluates directives" $ do
#if MIN_VERSION_ghc(8,2,0)
-- It's `p` instead of `t` for some reason
":typ 3" `becomes` ["3 :: forall p. Num p => p"]
#else
":typ 3" `becomes` ["3 :: forall t. Num t => t"]
#endif
":k Maybe" `becomes` ["Maybe :: * -> *"]
":in String" `pages` ["type String = [Char] \t-- Defined in \8216GHC.Base\8217"]