Ticket #6145: Main.hs

{-# LANGUAGE PatternGuards #-}
module Main where

import GHC
import GHC.Paths ( libdir )
import Bag (filterBag,isEmptyBag)
import System.Directory (removeFile)

main::IO()
main = do
        let c="module Test where\ndata DataT=MkData {name :: String}\n"
        writeFile "Test.hs" c
        ok<-    runGhc (Just libdir) $ do
                        dflags <- getSessionDynFlags
                        setSessionDynFlags dflags
                        let mn =mkModuleName "Test"
                        addTarget Target { targetId = TargetModule mn, targetAllowObjCode = True, targetContents = Nothing }
                        load LoadAllTargets
                        modSum <- getModSummary mn
                        p <- parseModule modSum
                        t <- typecheckModule p
                        d <- desugarModule t
                        l <- loadModule d
                        let ts=typecheckedSource l
                        let fs=filterBag getDataCon ts
                        return $ not $ isEmptyBag fs
        removeFile "Test.hs"
        print ok
        where 
                getDataCon (L _ (f@FunBind {}))
                        | (MatchGroup (m:_) _)<-fun_matches f,
                          (L _ (c@ConPatOut{}):_)<-hsLMatchPats m,
                          (L l _)<-pat_con c
                           =isGoodSrcSpan l
                getDataCon _=False