blob: f9dbfff86c67b027876a8b313d263b6d60481ac6 (
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
|
{-# LANGUAGE PatternGuards #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}
module Main where
import System.IO
import GHC
import GHC.Utils.Monad
import GHC.Utils.Outputable
import GHC.Data.Bag (filterBag,isEmptyBag)
import System.Directory (removeFile)
import System.Environment( getArgs )
main::IO()
main = do
let c="module Test where\ndata DataT=MkData {name :: String}\n"
writeFile "Test.hs" c
[libdir] <- getArgs
ok<- runGhc (Just libdir) $ do
dflags <- getSessionDynFlags
setSessionDynFlags dflags
let mn =mkModuleName "Test"
addTarget Target { targetId = TargetModule mn
, targetAllowObjCode = True
, targetUnitId = homeUnitId_ dflags
, targetContents = Nothing}
load LoadAllTargets
modSum <- getModSummary mn
p <- parseModule modSum
t <- typecheckModule p
d <- desugarModule t
let ts=typecheckedSource d
-- liftIO (putStr (showSDocDebug (ppr ts)))
let fs=filterBag isDataCon ts
return $ not $ isEmptyBag fs
removeFile "Test.hs"
print ok
where
isDataCon (L _ (XHsBindsLR (AbsBinds { abs_binds = bs })))
= not (isEmptyBag (filterBag isDataCon bs))
isDataCon (L l (f@FunBind {}))
| (MG _ (L _ (m:_)) _) <- fun_matches f,
((L _ (c@ConPat{})):_)<-hsLMatchPats m,
(L l _)<-pat_con c
= isGoodSrcSpan (locA l) -- Check that the source location is a good one
isDataCon _
= False
|
