summaryrefslogtreecommitdiff
path: root/testsuite/tests/hiefile/should_run/PatTypes.hs
blob: 7948c43473fdbc81f7bd44585dc0390bd6638217 (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
{-# LANGUAGE ScopedTypeVariables #-}
module Main where

import System.Environment

import NameCache
import SrcLoc
import UniqSupply
import Name

import HieBin
import HieTypes
import HieUtils

import DynFlags
import SysTools

import qualified Data.Map as M
import Data.Foldable

foo :: Maybe Char -> Char
foo Nothing = 'a'
--  1^
foo (Just c) | c == 'a' =  c
-- 2^    3^
foo x = 'b'
-- 4^

p1,p2,p3,p4 :: (Int,Int)
p1 = (22,6)
p2 = (24,5)
p3 = (24,11)
p4 = (26,5)

makeNc :: IO NameCache
makeNc = do
  uniq_supply <- mkSplitUniqSupply 'z'
  return $ initNameCache uniq_supply []

dynFlagsForPrinting :: String -> IO DynFlags
dynFlagsForPrinting libdir = do
  systemSettings <- initSysTools libdir
  return $ defaultDynFlags systemSettings (LlvmConfig [] [])

selectPoint :: HieFile -> (Int,Int) -> HieAST Int
selectPoint hf (sl,sc) = case M.toList (getAsts $ hie_asts hf) of
    [(fs,ast)] ->
      case selectSmallestContaining (sp fs) ast of
        Nothing -> error "point not found"
        Just ast' -> ast'
    _ -> error "map should only contain a single AST"
 where
   sloc fs = mkRealSrcLoc fs sl sc
   sp fs = mkRealSrcSpan (sloc fs) (sloc fs)

main = do
  libdir:_ <- getArgs
  df <- dynFlagsForPrinting libdir
  nc <- makeNc
  (hfr, nc') <- readHieFile nc "PatTypes.hie"
  let hf = hie_file_result hfr
  forM_ [p1,p2,p3,p4] $ \point -> do
    putStr $ "At " ++ show point ++ ", got type: "
    let types = nodeType $ nodeInfo $ selectPoint hf point
    forM_ types $ \typ -> do
      putStrLn (renderHieType df $ recoverFullType typ (hie_types hf))