blob: d6b7bba1b06127e22578f61e74bfba276404b416 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
|
{-# LANGUAGE ScopedTypeVariables #-}
module Main where
import System.Environment
import GHC.Types.Name.Cache
import GHC.Types.SrcLoc
import GHC.Types.Unique.Supply
import GHC.Types.Name
import Data.Tree
import GHC.Iface.Ext.Binary
import GHC.Iface.Ext.Types
import GHC.Iface.Ext.Utils
import Data.Maybe (fromJust)
import GHC.Driver.Session
import GHC.SysTools
import GHC.Utils.Outputable ( Outputable, renderWithContext, ppr, defaultUserStyle, text)
import qualified Data.Map as M
import Data.Foldable
class C a where
f :: a -> Char
instance C Char where
f x = x
instance C a => C [a] where
f x = 'a'
foo :: C a => a -> Char
foo x = f [x]
-- ^ this is the point
point :: (Int,Int)
point = (31,9)
bar :: Show x => x -> String
bar x = show [(1,x,A)]
-- ^ this is the point'
point' :: (Int,Int)
point' = (37,9)
data A = A deriving Show
makeNc :: IO NameCache
makeNc = initNameCache 'z' []
dynFlagsForPrinting :: String -> IO DynFlags
dynFlagsForPrinting libdir = do
systemSettings <- initSysTools libdir
return $ defaultDynFlags systemSettings
main = do
libdir:_ <- getArgs
df <- dynFlagsForPrinting libdir
nc <- makeNc
hfr <- readHieFile nc "HieQueries.hie"
let hf = hie_file_result hfr
refmap = generateReferencesMap $ getAsts $ hie_asts hf
explainEv df hf refmap point
explainEv df hf refmap point'
return ()
explainEv :: DynFlags -> HieFile -> RefMap Int -> (Int,Int) -> IO ()
explainEv df hf refmap point = do
putStrLn $ replicate 26 '='
putStrLn $ "At point " ++ show point ++ ", we found:"
putStrLn $ replicate 26 '='
putStr $ drawForest ptrees
where
trees = getEvidenceTreesAtPoint hf refmap point
ptrees = fmap (pprint . fmap expandType) <$> trees
expandType = text . renderHieType df .
flip recoverFullType (hie_types hf)
pretty = unlines . (++["└"]) . ("┌":) . map ("│ "++) . lines
pprint = pretty . renderWithContext (initSDocContext df sty) . ppr
sty = defaultUserStyle
|
