buildwrapper 0.6.1 → 0.6.2

raw patch · 13 files changed

+460/−183 lines, 13 filesdep +timePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: time

API changes (from Hackage documentation)

Files

• buildwrapper.cabal +12/−2
• src-exe/Language/Haskell/BuildWrapper/CMD.hs +23/−20
• src/Language/Haskell/BuildWrapper/API.hs +61/−38
• src/Language/Haskell/BuildWrapper/Base.hs +29/−8
• src/Language/Haskell/BuildWrapper/Cabal.hs +34/−13
• src/Language/Haskell/BuildWrapper/GHC.hs +104/−51
• src/Language/Haskell/BuildWrapper/GHCStorage.hs +80/−36
• src/Language/Haskell/BuildWrapper/Packages.hs +2/−1
• test/Language/Haskell/BuildWrapper/APITest.hs +7/−6
• test/Language/Haskell/BuildWrapper/CMDTests.hs +1/−0
• test/Language/Haskell/BuildWrapper/Tests.hs +105/−6
• test/Language/Haskell/BuildWrapper/UsagesTests.hs +1/−1
• test/Main.hs +1/−1

@@ -1,5 +1,5 @@ name:           buildwrapper
-version:        0.6.1
+version:        0.6.2
 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3
@@ -53,7 +53,11 @@                    Language.Haskell.BuildWrapper.GHCStorage,
                    Language.Haskell.BuildWrapper.Packages,
                    Language.Haskell.BuildWrapper.Src
+  if impl(ghc >= 7.6)
+    build-depends: 
+                    time
 
+
 executable buildwrapper
   hs-source-dirs:  src-exe
   main-is:         Main.hs
@@ -82,7 +86,10 @@                    transformers
   ghc-options:     -Wall -fno-warn-unused-do-bind -optl -s
   other-modules:   Language.Haskell.BuildWrapper.CMD
-  
+  if impl(ghc >= 7.6)
+    build-depends: 
+                    time
+
 test-suite buildwrapper-test
   type:            exitcode-stdio-1.0
   hs-source-dirs:  test
@@ -115,6 +122,9 @@                    Language.Haskell.BuildWrapper.CMDTests,
                    Language.Haskell.BuildWrapper.GHCTests,
                    Language.Haskell.BuildWrapper.UsagesTests
+  if impl(ghc >= 7.6)
+    build-depends: 
+                    time
 
 source-repository head
   type:     git

@@ -35,15 +35,15 @@         | Write {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, contents::String}  
         | Configure {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], verbosity::Verbosity,cabalTarget::WhichCabal}
         | Build {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], verbosity::Verbosity,output::Bool,cabalTarget::WhichCabal}
-        | Build1 {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath}
-        | Outline {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} 
-        | TokenTypes {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} 
-        | Occurrences {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath,token::String}
-        | ThingAtPointCmd {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, line::Int, column::Int}
-        | NamesInScope {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath} 
+        | Build1 {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String}
+        | Outline {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String} 
+        | TokenTypes {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String} 
+        | Occurrences {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath,token::String, component:: Maybe String}
+        | ThingAtPointCmd {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, line::Int, column::Int, component:: Maybe String}
+        | NamesInScope {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String} 
         | Dependencies {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String]}
         | Components {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String]}
-        | GetBuildFlags {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath}
+        | GetBuildFlags {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String}
         | GenerateUsage {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], returnAll:: Bool, cabalComponent::String}
     deriving (Show,Read,Data,Typeable)    
   
@@ -71,6 +71,9 @@ cc :: String
 cc=def &= help "cabal component"
 
+mcc :: Maybe String
+mcc=def &= help "cabal component"
+
 ra :: Bool
 ra=def &= help "return all source paths"
 
@@ -85,21 +88,21 @@ mbuild :: BWCmd
 mbuild = Build tf cp cf uf co v (def &= help "output compilation and linking result") wc
 mbuild1 :: BWCmd
-mbuild1 = Build1 tf cp cf uf co fp
+mbuild1 = Build1 tf cp cf uf co fp mcc
 mgetbf :: BWCmd
-mgetbf = GetBuildFlags tf cp cf uf co fp
+mgetbf = GetBuildFlags tf cp cf uf co fp mcc
 moutline :: BWCmd
-moutline = Outline tf cp cf uf co fp
+moutline = Outline tf cp cf uf co fp mcc
 mtokenTypes :: BWCmd
-mtokenTypes= TokenTypes tf cp cf uf co fp
+mtokenTypes= TokenTypes tf cp cf uf co fp mcc
 moccurrences :: BWCmd
-moccurrences=Occurrences tf cp cf uf co fp (def &= help "text to search occurrences of" &= name "token")
+moccurrences=Occurrences tf cp cf uf co fp (def &= help "text to search occurrences of" &= name "token") mcc
 mthingAtPoint :: BWCmd
 mthingAtPoint=ThingAtPointCmd tf cp cf uf co fp 
         (def &= help "line" &= name "line")
-        (def &= help "column" &= name "column")
+        (def &= help "column" &= name "column") mcc
 mnamesInScope :: BWCmd
-mnamesInScope=NamesInScope tf cp cf uf co fp 
+mnamesInScope=NamesInScope tf cp cf uf co fp mcc
 mdependencies :: BWCmd
 mdependencies=Dependencies tf cp cf uf co
 mcomponents :: BWCmd
@@ -127,13 +130,13 @@                 handle c@Write{file=fi,contents=s}=runCmd c (write fi s)
                 handle c@Configure{cabalTarget=w}=runCmd c (configure w)
                 handle c@Build{verbosity=ve,output=o,cabalTarget=w}=runCmdV ve c (build o w)
-                handle c@Build1{file=fi}=runCmd c (build1 fi)
-                handle c@GetBuildFlags{file=fi}=runCmd c (getBuildFlags fi)
-                handle c@Outline{file=fi}=runCmd c (getOutline fi)
+                handle c@Build1{file=fi,component=mcomp}=runCmd c (build1 fi mcomp)
+                handle c@GetBuildFlags{file=fi,component=mcomp}=runCmd c (getBuildFlags fi mcomp)
+                handle c@Outline{file=fi,component=mcomp}=runCmd c (getOutline fi mcomp)
                 handle c@TokenTypes{file=fi}=runCmd c (getTokenTypes fi)
-                handle c@Occurrences{file=fi,token=t}=runCmd c (getOccurrences fi t)
-                handle c@ThingAtPointCmd{file=fi,line=l,column=col}=runCmd c (getThingAtPoint fi l col)
-                handle c@NamesInScope{file=fi}=runCmd c (getNamesInScope fi)
+                handle c@Occurrences{file=fi,token=t,component=mcomp}=runCmd c (getOccurrences fi t mcomp)
+                handle c@ThingAtPointCmd{file=fi,line=l,column=col,component=mcomp}=runCmd c (getThingAtPoint fi l col mcomp)
+                handle c@NamesInScope{file=fi,component=mcomp}=runCmd c (getNamesInScope fi mcomp)
                 handle c@Dependencies{}=runCmd c getCabalDependencies
                 handle c@Components{}=runCmd c getCabalComponents
                 handle c@GenerateUsage{returnAll=reta,cabalComponent=comp}=runCmd c (generateUsage reta comp)

@@ -30,7 +30,8 @@ import Prelude hiding (readFile, writeFile)
 import qualified Data.Vector as V
 
-import System.IO.UTF8
+--import System.IO.UTF8 hiding (readFile, writeFile)
+--import Codec.Binary.UTF8.String
 
 import Control.Monad.State
 import Language.Haskell.Exts.Annotated hiding (String)
@@ -38,13 +39,17 @@ import Data.Maybe
 import System.Directory
 import System.FilePath
-import GHC (RenamedSource, TypecheckedSource, TypecheckedModule(..), Ghc, ms_mod, pm_mod_summary, moduleName)
+import GHC (TypecheckedSource, TypecheckedModule(..), Ghc, ms_mod, pm_mod_summary, moduleName, getSessionDynFlags)
 import Data.Aeson
-import Outputable (showSDoc,ppr)
+import Outputable (ppr)
 import Data.Foldable (foldrM)
 
 --import qualified MonadUtils as GMU
 
+
+
+
+
 -- | copy all files from the project to the temporary folder
 synchronize ::  Bool -- ^ if true copy all files, if false only copy files newer than their corresponding temp files
         -> BuildWrapper(OpResult ([FilePath],[FilePath])) -- ^ return the list of files copied, the list of files deleted
@@ -135,32 +140,33 @@                 getModule :: T.Text -- ^ the current package name
                         ->  FilePath -- ^ the file to process
                         -> TypecheckedModule -- ^ the GHC typechecked module
-                        -> Ghc(FilePath,T.Text,RenamedSource,[Usage])
+                        -> Ghc(FilePath,T.Text,Value,[Usage])
                 getModule pkg f tm=do
-                        let rs@(_,imps,mexps,_)=fromJust $ tm_renamed_source tm
+                        let (hsg,imps,mexps,_)=fromJust $ tm_renamed_source tm
                         (ius,aliasMap)<-foldrM (BwGHC.ghcImportToUsage pkg) ([],DM.empty) imps
                         -- GMU.liftIO $ Prelude.print $ showSDoc $ ppr aliasMap
-                        let modu=T.pack $ showSDoc $ ppr $ moduleName $ ms_mod $ pm_mod_summary $ tm_parsed_module tm
-                        eus<-mapM (BwGHC.ghcExportToUsage pkg modu aliasMap) (fromMaybe [] mexps)
+                        df <- getSessionDynFlags
+                        let modu=T.pack $ showSD True df $ ppr $ moduleName $ ms_mod $ pm_mod_summary $ tm_parsed_module tm
+                        eus<-mapM (BwGHC.ghcExportToUsage df pkg modu aliasMap) (fromMaybe [] mexps)
                         --ms_mod $ pm_mod_summary $ tm_parsed_module tm
-                        return (f,modu,rs,ius ++ concat eus)
+                        return (f,modu,dataToJSON df hsg,ius ++ concat eus)
                 -- | generate all usage information and stores it to file
                 generate :: T.Text  -- ^ the current package name
-                        -> (FilePath,T.Text,RenamedSource,[Usage]) -> BuildWrapper()
-                generate pkg (fp,modu,(hsg,_,_,_),ius) 
+                        -> (FilePath,T.Text,Value,[Usage]) -> BuildWrapper()
+                generate pkg (fp,modu,v,ius) 
                         | modu=="Main" && ccn=="" = return () -- Main inside a library: do nothing
                         | otherwise = do
                                 -- liftIO $ Prelude.putStrLn (show modu ++ ":" ++ show ccn) 
                                 tgt<-getTargetPath fp
                                 --mv<-liftIO $ readGHCInfo tgt
-                                let v = dataToJSON hsg
+                                -- let v = dataToJSON hsg
                                 -- liftIO $ Prelude.putStrLn tgt
                                 -- liftIO $ Prelude.putStrLn $ formatJSON $ BSC.unpack $ encode v
                                 --case mv of
                                 --        Just v->do
                                 let vals=extractUsages v
                                 --liftIO $ mapM_ (Prelude.putStrLn . formatJSON . BSC.unpack . encode) vals
-                                (mast,_)<-getAST fp
+                                (mast,_)<-getAST fp (Just ccn)
                                 case mast of
                                         Just (ParseOk ast)->do
                                                 let ods=getHSEOutline ast
@@ -282,8 +288,9 @@ 
 -- | build one source file in GHC
 build1 :: FilePath -- ^ the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> BuildWrapper (OpResult (Maybe [NameDef])) -- ^ True if build is successful
-build1 fp=withGHCAST' fp BwGHC.getGhcNameDefsInScope
+build1 fp mccn=withGHCAST' fp mccn BwGHC.getGhcNameDefsInScope
 
 
 -- | preprocess a file
@@ -299,16 +306,18 @@ 
 -- | get the build flags for a source file
 getBuildFlags :: FilePath -- ^ the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> BuildWrapper (OpResult BuildFlags)
-getBuildFlags fp=do
+getBuildFlags fp mccn=do
         tgt<-getTargetPath fp
         src<-getCabalFile Source
         modSrc<-liftIO $ getModificationTime src
         mbf<-liftIO $ readBuildFlagsInfo tgt modSrc
-        case mbf of
+        case filterBuildFlags mbf of
                 Just bf-> return bf
                 Nothing -> do
-                        (mcbi,bwns)<-getBuildInfo fp
+                        (mcbi,bwns)<-getBuildInfo fp mccn
+                        --liftIO $ print mcbi
                         ret<-case mcbi of
                                 Just cbi->do
                                         opts2<-fileGhcOptions cbi
@@ -316,7 +325,7 @@                                         -- liftIO $ Prelude.print $ cbiModulePaths $ snd cbi
                                         -- liftIO $ Prelude.print opts2
                                         let 
-                                                fullFp=(takeDirectory src) </> fp
+                                                fullFp=takeDirectory src </> fp
                                                 modName=listToMaybe $ mapMaybe fst (filter (\ (_, f) -> f == fullFp) $ cbiModulePaths $ snd cbi)
                                                 -- (modName,_)=cabalExtensions $ snd cbi
                                                 cppo=fileCppOptions (snd cbi) ++ unlitF
@@ -324,19 +333,24 @@                                         -- liftIO $ Prelude.print opts
                                         -- ghcOptions is sufficient, contains extensions and such
                                         -- opts ++
-                                        return (BuildFlags opts2 cppo modS,bwns)
-                                Nothing -> return (BuildFlags [] unlitF Nothing,[])
+                                        return (BuildFlags opts2 cppo modS (Just $ cabalComponentName $ cbiComponent $ snd cbi),bwns)
+                                Nothing -> return (BuildFlags [] unlitF Nothing Nothing,[])
                         liftIO $ storeBuildFlagsInfo tgt ret
                         return ret
-        where unlitF=let
-                lit=".lhs" == takeExtension fp
-                in ("-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__ :: Int)) : ["--unlit" | lit]
-
+        where 
+                unlitF=let
+                        lit=".lhs" == takeExtension fp
+                        in ("-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__ :: Int)) : ["--unlit" | lit]
+                filterBuildFlags :: Maybe (BuildFlags,[BWNote]) -> Maybe (BuildFlags,[BWNote])
+                filterBuildFlags (Just (bf,_)) | mccn /= bfComponent bf=Nothing
+                filterBuildFlags mbf=mbf
+                
 -- | get haskell-src-exts commented AST for source file
 getAST :: FilePath -- ^  the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> BuildWrapper (OpResult (Maybe (ParseResult (Module SrcSpanInfo, [Comment]))))
-getAST fp=do
-        (bf,ns)<-getBuildFlags fp
+getAST fp mccn=do
+        (bf,ns)<-getBuildFlags fp mccn
         tgt<-getTargetPath fp
         input<-liftIO $ preproc bf tgt
         pr<- liftIO $ getHSEAST input (bfAst bf)
@@ -344,31 +358,35 @@ 
 -- | get GHC typechecked AST for source file
 getGHCAST :: FilePath -- ^ the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> BuildWrapper (OpResult (Maybe TypecheckedSource))
-getGHCAST fp = withGHCAST' fp BwGHC.getAST
+getGHCAST fp mccn = withGHCAST' fp mccn BwGHC.getAST
 
 -- | perform an action on the GHC AST
 withGHCAST ::  FilePath -- ^ the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> (FilePath --  ^ the source file
                 -> FilePath --  ^ the base directory
                 ->  String --  ^ the module name
                 -> [String] --  ^ the GHC options
                 -> IO a)
         -> BuildWrapper (OpResult (Maybe a))
-withGHCAST fp f=withGHCAST' fp (\a b c d->do
+withGHCAST fp mccn f=withGHCAST' fp mccn (\a b c d->do
         r<- f a b c d
         return (Just r,[]))
 
 withGHCAST' ::  FilePath -- ^ the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> (FilePath --  ^ the source file
         -> FilePath --  ^ the base directory
         ->  String --  ^ the module name
         -> [String] --  ^ the GHC options
         ->  IO (OpResult (Maybe a))) -> BuildWrapper (OpResult (Maybe a))
-withGHCAST'  fp f= do
-        (bf,ns)<-getBuildFlags fp
+withGHCAST'  fp mccn f= do
+        (bf,ns)<-getBuildFlags fp mccn
+        -- liftIO $ print bf
         case bf of 
-                (BuildFlags opts _ (Just modS))-> do
+                (BuildFlags opts _ (Just modS) _)-> do
                         tgt<-getTargetPath fp
                         temp<-getFullTempDir
                         liftIO $ do
@@ -381,8 +399,9 @@ 
 -- | get outline for source file
 getOutline :: FilePath -- ^ source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> BuildWrapper (OpResult OutlineResult)
-getOutline fp=do
+getOutline fp mccn=do
        tgt<-getTargetPath fp
        let usageFile=getUsageFile tgt
        usageStale<-liftIO $ isSourceMoreRecent tgt usageFile 
@@ -398,7 +417,7 @@        case mods of
                 Just ods-> return (ods,[])
                 _ -> do   
-                       (mast,bwns)<-getAST fp
+                       (mast,bwns)<-getAST fp mccn
                        case mast of
                         Just (ParseOk ast)->do
                                 --liftIO $ Prelude.print ast
@@ -424,9 +443,10 @@ -- ^ get all occurrences of a token in the file
 getOccurrences :: FilePath -- ^ the source file
         -> String -- ^ the token to search for
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
         -> BuildWrapper (OpResult [TokenDef])
-getOccurrences fp query=do
-        (BuildFlags opts _ _, _)<-getBuildFlags fp
+getOccurrences fp query mccn=do
+        (BuildFlags opts _ _ _, _)<-getBuildFlags fp mccn
         tgt<-getTargetPath fp
         input<-liftIO $ readFile tgt
         ett<-liftIO $ BwGHC.occurrences tgt input (T.pack query) (".lhs" == takeExtension fp) opts
@@ -439,18 +459,21 @@ getThingAtPoint :: FilePath -- ^ the source file
         -> Int -- ^ the line
         -> Int -- ^ the column
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
 --        -> Bool -- ^ do we want the result qualified?
 --        -> Bool -- ^ do we want the result typed?
         -> BuildWrapper (OpResult (Maybe ThingAtPoint))
-getThingAtPoint fp line col=do
-        mm<-withGHCAST fp $ BwGHC.getThingAtPointJSON line col
+getThingAtPoint fp line col mccn=do
+        mm<-withGHCAST fp mccn $ BwGHC.getThingAtPointJSON line col
         return $ case mm of 
                 (Just m,ns)->(m,ns)
                 (Nothing,ns)-> (Nothing,ns)
                 
 -- | get all names in scope (GHC API)                
-getNamesInScope :: FilePath-> BuildWrapper (OpResult (Maybe [String]))
-getNamesInScope fp=withGHCAST fp BwGHC.getGhcNamesInScope
+getNamesInScope :: FilePath
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
+        -> BuildWrapper (OpResult (Maybe [String]))
+getNamesInScope fp mccn=withGHCAST fp mccn BwGHC.getGhcNamesInScope
 
 -- | get cabal dependencies
 getCabalDependencies :: BuildWrapper (OpResult [(FilePath,[CabalPackage])])

@@ -15,7 +15,9 @@ import Control.Applicative
 import Control.Monad
 import Control.Monad.State
+import Control.Exception (bracket)
 
+
 import Data.Data
 import Data.Aeson
 import qualified Data.Text as T
@@ -28,7 +30,8 @@ import Data.List (isPrefixOf)
 import Data.Maybe (catMaybes)
 
-
+import System.IO.UTF8 (hPutStr,hGetContents)
+import System.IO (IOMode, openBinaryFile, IOMode(..), Handle, hClose)
 
 -- | State type
 type BuildWrapper=StateT BuildWrapperState IO
@@ -51,9 +54,15 @@     toJSON = toJSON . drop 2 . show 
  
 instance FromJSON BWNoteStatus where
-    parseJSON (String t) =return $ read $ T.unpack $ T.append "BW" t
+    parseJSON (String t) =return $ readObj "BWNoteStatus" $ T.unpack $ T.append "BW" t
     parseJSON _= mzero  
  
+readObj :: Read a=> String -> String -> a
+readObj msg s=let parses=reads s -- :: [(a,String)]
+        in if null parses 
+                then error (msg ++ ": " ++ s ++ ".")
+                else fst $ head parses 
+ 
 -- | location of a note/error (lines and columns start at 1)
 data BWLocation=BWLocation {
         bwlSrc::FilePath -- ^ source file 
@@ -155,7 +164,7 @@     toJSON = toJSON . show
  
 instance FromJSON OutlineDefType where
-    parseJSON (String s) =return $ read $ T.unpack s
+    parseJSON (String s) =return $ readObj "OutlineDefType" $ T.unpack s
     parseJSON _= mzero
  
 -- | Location inside a file, the file is known and doesn't need to be repeated 
@@ -310,7 +319,7 @@     toJSON = toJSON . show
  
 instance FromJSON ImportExportType where
-    parseJSON (String s) =return $ read $ T.unpack s
+    parseJSON (String s) =return $ readObj "ImportExportType" $ T.unpack s
     parseJSON _= mzero
     
 -- | definition of export
@@ -399,17 +408,19 @@         bfAst :: [String] -- ^ flags for GHC
         ,bfPreproc :: [String] -- ^ flags for preprocessor
         ,bfModName :: Maybe String -- ^ module name if known
+        ,bfComponent :: Maybe String -- ^ component used to get flags, if known
         }  
         deriving (Show,Read,Eq,Data,Typeable)
         
 instance ToJSON BuildFlags where
-        toJSON (BuildFlags ast preproc modName)=  object ["a" .= map toJSON ast, "p" .=  map toJSON preproc, "m" .= toJSON modName]
+        toJSON (BuildFlags ast preproc modName comp)=  object ["a" .= map toJSON ast, "p" .=  map toJSON preproc, "m" .= toJSON modName, "c" .= toJSON comp]
 
 instance FromJSON BuildFlags where
    parseJSON (Object v)=BuildFlags <$>
                          v .: "a" <*>
                          v .: "p" <*>
-                         v .:? "m"
+                         v .:? "m" <*>
+                         v .:? "c"
    parseJSON _= mzero  
    
 data ThingAtPoint = ThingAtPoint {
@@ -528,7 +539,7 @@         { ccTestName :: String -- ^ test suite name
         , ccBuildable :: Bool -- ^ is the test suite buildable
         } -- ^ test suite
-  deriving (Eq, Show)
+  deriving (Eq, Show, Read)
 
 instance ToJSON CabalComponent where
         toJSON (CCLibrary b)=  object ["Library" .= b]
@@ -666,4 +677,14 @@         usDef::Bool
         } 
         deriving (Show,Eq)
-                + 
+readFile :: FilePath -> IO String
+readFile n = hGetContents =<< openBinaryFile n ReadMode
+
+writeFile :: FilePath -> String -> IO ()
+writeFile n s = withBinaryFile n WriteMode (\ h -> hPutStr h s)      
+
+withBinaryFile :: FilePath -> IOMode -> (Handle -> IO a) -> IO a
+withBinaryFile n m f = bracket (openBinaryFile n m) hClose f
+
+          

@@ -22,6 +22,12 @@ import Data.Ord (comparing)
 import Data.List
 import Data.Maybe
+
+#if MIN_VERSION_Cabal(1,15,0)   
+import Data.Version (parseVersion)
+import Text.ParserCombinators.ReadP(readP_to_S)
+#endif
+
 import qualified Data.Map as DM
 
 import Exception (ghandle)
@@ -312,7 +318,7 @@                 extractLocation el=let
                         (_,_,aft,ls)=el =~ "(.+):([0-9]+):([0-9]+):" :: (String,String,String,[String])   
                         in case ls of
-                                (loc:line:col:[])-> Just $ BWNote BWError (dropWhile isSpace aft) (mkEmptySpan loc (readInt line 1) (read col))
+                                (loc:line:col:[])-> Just $ BWNote BWError (dropWhile isSpace aft) (mkEmptySpan loc (readInt line 1) (readInt col 1))
                                 _ -> let
                                       (_,_,_,ls2)=el =~ "(.+)(\\(.+\\)):(.+):(.+):" :: (String,String,String,[String])
                                       in case ls2 of
@@ -361,6 +367,7 @@         ,cbiModulePaths::[(Maybe ModuleName,FilePath)]  -- ^ the module name and corresponding source file for each contained Haskell module
         ,cbiComponent::CabalComponent -- ^  the component handle
          } 
+      deriving (Read,Show)      
             
 -- | canonicalize the paths in the build info
 canonicalizeBuildInfo :: CabalBuildInfo -> BuildWrapper CabalBuildInfo
@@ -387,26 +394,40 @@ -- | get the build info for a given source file
 -- if a source file is in several component, get the first one             
 getBuildInfo ::  FilePath  -- ^the source file
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified
         -> BuildWrapper (OpResult (Maybe (LocalBuildInfo,CabalBuildInfo)))
-getBuildInfo fp=do
-        (mmr,bwns)<-go getReferencedFiles
-        case mmr of
-                Just (Just a)->return (Just a, bwns)
+getBuildInfo fp mccn=do
+        case mccn of
+                Nothing -> do
+                        (mmr,bwns)<-go getReferencedFiles Nothing
+                        case mmr of
+                                Just (Just a)->return (Just a, bwns)
+                                _ -> do
+                                        (mmr2,bwns2)<-go getAllFiles Nothing -- no component found for the asked name
+                                        return $ case mmr2 of
+                                                Just (Just a)-> (Just a,bwns2)
+                                                _-> (Nothing,bwns)
                 _ -> do
-                        (mmr2,bwns2)<-go getAllFiles
+                        (mmr2,bwns2)<-go getAllFiles mccn
                         return $ case mmr2 of
-                                Just (Just a)-> (Just a,bwns2)
-                                _-> (Nothing,bwns)
+                                        Just (Just a)-> (Just a,bwns2)
+                                        _-> (Nothing,bwns2)
         where 
-             go f=withCabal Source (\lbi->do
+             go f mccn2=withCabal Source (\lbi->do
                 fps<-f lbi
-                fpC<-canonicalizeFullPath fp
                 fpsC<-mapM canonicalizeBuildInfo fps
-                let ok=filter (not . null . cbiModulePaths) $
-                        map (onModulePaths (filter (\(_,b)->equalFilePath fpC b))) fpsC
+                ok<-getComp mccn2 fpsC
                 return  $ if null ok
                         then Nothing
                         else Just (lbi, head ok))
+             getComp :: Maybe String -> [CabalBuildInfo] -> BuildWrapper [CabalBuildInfo] 
+             getComp Nothing fps=do
+                fpC<-canonicalizeFullPath fp
+                fpsC<-mapM canonicalizeBuildInfo fps
+                return $ filter (not . null . cbiModulePaths) $
+                        map (onModulePaths (filter (\(_,b)->equalFilePath fpC b))) fpsC
+             getComp (Just ccn) fps=
+                return $ filter (\cbi->cabalComponentName (cbiComponent cbi) == ccn) fps
  
 -- | get GHC options for a file            
 fileGhcOptions :: (LocalBuildInfo,CabalBuildInfo) -- ^ the cabal info
@@ -417,7 +438,7 @@         inplaceExist<-liftIO $ doesFileExist inplace
 #if MIN_VERSION_Cabal(1,15,0)   
         v<-cabalV
-        let opts l b c f=renderGhcOptions (read VERSION_ghc) $ componentGhcOptions v l b c f 
+        let opts l b c f=renderGhcOptions ((fst $ head $ readP_to_S  parseVersion  VERSION_ghc) :: Version) $ componentGhcOptions v l b c f 
 #else
         let opts=ghcOptions
 #endif        

@@ -28,7 +28,11 @@ import qualified Data.Map as DM
 
 import DynFlags
-import ErrUtils ( ErrMsg(..), WarnMsg, mkPlainErrMsg,Messages,ErrorMessages,WarningMessages, Message )
+#if __GLASGOW_HASKELL__ > 704
+import ErrUtils ( ErrMsg(..), WarnMsg, mkPlainErrMsg,Messages,ErrorMessages,WarningMessages,MsgDoc)
+#else
+import ErrUtils ( ErrMsg(..), WarnMsg, mkPlainErrMsg,Messages,ErrorMessages,WarningMessages,Message)
+#endif
 import GHC
 import GHC.Paths ( libdir )
 import HscTypes ( srcErrorMessages, SourceError, GhcApiError)
@@ -51,6 +55,7 @@ import Name (isTyVarName,isDataConName,isVarName,isTyConName)
 import Var (varType)
 import PprTyThing (pprTypeForUser)
+import Control.Monad (when)
 
 type GHCApplyFunction a=FilePath -> TypecheckedModule -> Ghc a
 
@@ -87,10 +92,13 @@         case mv of 
                 Just v-> fmap Just (f v) 
                 Nothing->do
-                        mTc<-withAST return fp base_dir modul options
-                        case mTc of
-                                Just tc->fmap Just (f (generateGHCInfo tc)) 
-                                Nothing -> return Nothing
+                        mv2<-withAST gen fp base_dir modul options
+                        case mv2 of
+                                Just v2->fmap Just (f v2) 
+                                Nothing-> return Nothing
+        where gen tc=do
+                df<-getSessionDynFlags
+                return $ generateGHCInfo df tc 
 
 -- | the main method loading the source contents into GHC
 withASTNotes ::  GHCApplyFunction a -- ^ the final action to perform on the result
@@ -114,7 +122,11 @@                 -- and it takes a while to actually generate the o and hi files for big modules
                 -- if we use CompManager, it's slower for modules with lots of dependencies but we can keep hscTarget= HscNothing which makes it better for bigger modules
                 -- we use target interpreted so that it works with TemplateHaskell
+#if __GLASGOW_HASKELL__ > 704  
                 setSessionDynFlags flg'  {hscTarget = HscInterpreted, ghcLink = NoLink , ghcMode = CompManager, log_action = logAction ref }
+#else                
+                setSessionDynFlags flg'  {hscTarget = HscInterpreted, ghcLink = NoLink , ghcMode = CompManager, log_action = logAction ref flg' }
+#endif
                 --  $ dopt_set (flg' { ghcLink = NoLink , ghcMode = CompManager }) Opt_ForceRecomp
                 let fps=getLoadFiles contents
                 mapM_ (\(fp,_)-> addTarget Target { targetId = TargetFile fp Nothing, targetAllowObjCode = True, targetContents = Nothing }) fps
@@ -136,20 +148,32 @@                                 modSum <- getModSummary $ mkModuleName m
                                 fmap Just $ workOnResult f fp modSum)
                                `gcatch` (\(se :: SourceError) -> do
-                                        GMU.liftIO $ print se 
+                                        when (processError contents (show se)) (do
+                                                GMU.liftIO $ print m
+                                                GMU.liftIO $ print se 
+                                                )
                                         return Nothing)
                                `gcatch` (\(ae :: GhcApiError) -> do
-                                        GMU.liftIO $ print ae
+                                        when (processError contents (show ae)) (do
+                                                GMU.liftIO $ print m
+                                                GMU.liftIO $ print ae 
+                                                )
                                         return Nothing)
                         ) fps
 #if __GLASGOW_HASKELL__ < 702                           
                 warns <- getWarnings
-                return (a,List.nub $ notes ++ reverse (ghcMessagesToNotes base_dir (warns, emptyBag)))
+                df <- getSessionDynFlags
+                return (a,List.nub $ notes ++ reverse (ghcMessagesToNotes df base_dir (warns, emptyBag)))
 #else
                 notes2 <- GMU.liftIO $ readIORef ref
                 return $ (a,List.nub $ notes2)
 #endif
         where
+            processError :: LoadContents -> String -> Bool
+            processError MultipleFile{} "Module not part of module graph"=False -- we ignore the error when we process several files and some we can't find
+            processError _ _=True
+            
+        
             workOnResult :: GHCApplyFunction a -> FilePath -> ModSummary -> Ghc a
             workOnResult f2 fp modSum= do
                 p <- parseModule modSum
@@ -160,17 +184,23 @@ #if __GLASGOW_HASKELL__ < 704
                 setContext [ms_mod modSum] []
 #else
+#if __GLASGOW_HASKELL__ < 706
                 setContext [IIModule $ ms_mod modSum]
+#else
+                setContext [IIModule $ moduleName  $ ms_mod modSum]       
+#endif             
 #endif                         
                 let fullfp=ff fp
+                opts<-getSessionDynFlags
                 -- GMU.liftIO $ putStrLn ("writing " ++ fullfp)
-                GMU.liftIO $ storeGHCInfo fullfp (dm_typechecked_module l)
+                GMU.liftIO $ storeGHCInfo opts fullfp (dm_typechecked_module l)
                 --GMU.liftIO $ putStrLn ("parse, typecheck load: " ++ (timeDiffToString  $ diffClockTimes c3 c2))
                 f2 fp $ dm_typechecked_module l                
         
             add_warn_err :: GhcMonad m => IORef [BWNote] -> WarningMessages -> ErrorMessages -> m()
             add_warn_err ref warns errs = do
-              let notes = ghcMessagesToNotes base_dir (warns, errs)
+              df <- getSessionDynFlags
+              let notes = ghcMessagesToNotes df base_dir (warns, errs)
               GMU.liftIO $ modifyIORef ref $
                          \ ns -> ns ++ notes
         
@@ -179,13 +209,16 @@                let errs = srcErrorMessages e
                add_warn_err ref emptyBag errs
                return Failed
-               
-            logAction :: IORef [BWNote] -> Severity -> SrcSpan -> PprStyle -> Message -> IO ()
-            logAction ref s loc style msg
+#if __GLASGOW_HASKELL__ > 704              
+            logAction :: IORef [BWNote] -> DynFlags -> Severity -> SrcSpan -> PprStyle -> MsgDoc -> IO ()
+#else
+            logAction :: IORef [BWNote] -> DynFlags -> Severity -> SrcSpan -> PprStyle -> Message -> IO ()
+#endif
+            logAction ref df s loc style msg
                 | (Just status)<-bwSeverity s=do
                         let n=BWNote { bwnLocation = ghcSpanToBWLocation base_dir loc
                                  , bwnStatus = status
-                                 , bwnTitle = removeBaseDir base_dir $ removeStatus status $ showSDocForUser (qualName style,qualModule style) msg
+                                 , bwnTitle = removeBaseDir base_dir $ removeStatus status $ showSDUser (qualName style,qualModule style) df msg
                                  }
                         modifyIORef ref $  \ ns -> ns ++ [n]
                 | otherwise=return ()
@@ -201,11 +234,12 @@ --
 -- This will mix warnings and errors, but you can split them back up
 -- by filtering the '[BWNote]' based on the 'bw_status'.
-ghcMessagesToNotes :: FilePath -- ^ base directory
+ghcMessagesToNotes :: DynFlags -> 
+        FilePath -- ^ base directory
         ->  Messages -- ^ GHC messages
         -> [BWNote]
-ghcMessagesToNotes base_dir (warns, errs) = map_bag2ms (ghcWarnMsgToNote base_dir) warns ++
-        map_bag2ms (ghcErrMsgToNote base_dir) errs
+ghcMessagesToNotes df base_dir (warns, errs) = map_bag2ms (ghcWarnMsgToNote df base_dir) warns ++
+        map_bag2ms (ghcErrMsgToNote df base_dir) errs
   where
     map_bag2ms f =  map f . Bag.bagToList   
    
@@ -220,9 +254,10 @@         names<-withAST (\_->do
                 --c1<-GMU.liftIO getClockTime
                 names<-getNamesInScope
+                df<-getSessionDynFlags
                 --c2<-GMU.liftIO getClockTime
                 --GMU.liftIO $ putStrLn ("getNamesInScope: " ++ (timeDiffToString  $ diffClockTimes c2 c1))
-                return $ map (showSDocDump . ppr ) names)  f base_dir modul options
+                return $ map (showSDDump df . ppr ) names)  f base_dir modul options
         return $ fromMaybe[] names
 
    
@@ -235,7 +270,7 @@ getGhcNameDefsInScope fp base_dir modul options=do
         (nns,ns)<-withASTNotes (\_ _->do
                 --c1<-GMU.liftIO getClockTime
-                -- GMU.liftIO $ putStrLn "getGhcNameDefsInScope"
+                --GMU.liftIO $ putStrLn "getGhcNameDefsInScope"
                 names<-getNamesInScope
                 --c2<-GMU.liftIO getClockTime
                 --GMU.liftIO $ putStrLn ("getNamesInScope: " ++ (timeDiffToString  $ diffClockTimes c2 c1))
@@ -247,10 +282,11 @@         where name2nd :: GhcMonad m=> Name -> m NameDef
               name2nd n=do
                 m<- getInfo n
+                df<-getSessionDynFlags
                 let ty=case m of
-                        Just (tyt,_,_)->ty2t tyt
+                        Just (tyt,_,_)->ty2t df tyt
                         Nothing->Nothing
-                return $ NameDef (T.pack $ showSDocDump $ ppr n) (name2t n) ty
+                return $ NameDef (T.pack $ showSDDump df $ ppr n) (name2t n) ty
               name2t :: Name -> [OutlineDefType]
               name2t n 
                         | isTyVarName n=[Type]
@@ -258,10 +294,10 @@                         | isDataConName n = [Constructor]
                         | isVarName n = [Function]
                         | otherwise =[]
-              ty2t :: TyThing -> Maybe T.Text
-              ty2t (AnId aid)=Just $ T.pack $ showSDocUnqual $ pprTypeForUser True $ varType aid
-              ty2t (ADataCon dc)=Just $ T.pack $ showSDocUnqual $ pprTypeForUser True $ dataConUserType dc
-              ty2t _ = Nothing
+              ty2t :: DynFlags -> TyThing -> Maybe T.Text
+              ty2t df (AnId aid)=Just $ T.pack $ showSD False df $ pprTypeForUser True $ varType aid
+              ty2t df (ADataCon dc)=Just $ T.pack $ showSD False df $ pprTypeForUser True $ dataConUserType dc
+              ty2t _ _ = Nothing
 
 -- | get the "thing" at a particular point (line/column) in the source
 -- this is using the saved JSON info if available
@@ -364,8 +400,14 @@                 let prTS = lexTokenStream sb lexLoc dflags1
                 case prTS of
                         POk _ toks      -> return $ Right $ filter ofInterest toks
-                        PFailed loc msg -> return $ Left $ ghcErrMsgToNote base_dir $ mkPlainErrMsg loc msg
+                        PFailed loc msg -> return $ Left $ ghcErrMsgToNote dflags1 base_dir $ 
+#if __GLASGOW_HASKELL__ < 706
+                                mkPlainErrMsg loc msg
+#else
+                                mkPlainErrMsg dflags1 loc msg
+#endif
 
+
 #if __GLASGOW_HASKELL__ < 702
 lexLoc :: SrcLoc
 lexLoc = mkSrcLoc (mkFastString "<interactive>") 1 (scionColToGhcCol 1)
@@ -510,18 +552,18 @@         deriving Eq
 
 -- | convert a GHC error message to our note type
-ghcErrMsgToNote :: FilePath -> ErrMsg -> BWNote
-ghcErrMsgToNote = ghcMsgToNote BWError
+ghcErrMsgToNote :: DynFlags -> FilePath -> ErrMsg -> BWNote
+ghcErrMsgToNote df= ghcMsgToNote df BWError
 
 -- | convert a GHC warning message to our note type
-ghcWarnMsgToNote :: FilePath -> WarnMsg -> BWNote
-ghcWarnMsgToNote = ghcMsgToNote BWWarning
+ghcWarnMsgToNote :: DynFlags -> FilePath -> WarnMsg -> BWNote
+ghcWarnMsgToNote df= ghcMsgToNote df BWWarning
 
 -- Note that we do *not* include the extra info, since that information is
 -- only useful in the case where we do not show the error location directly
 -- in the source.
-ghcMsgToNote :: BWNoteStatus -> FilePath -> ErrMsg -> BWNote
-ghcMsgToNote note_kind base_dir msg =
+ghcMsgToNote :: DynFlags -> BWNoteStatus -> FilePath -> ErrMsg -> BWNote
+ghcMsgToNote df note_kind base_dir msg =
     BWNote { bwnLocation = ghcSpanToBWLocation base_dir loc
          , bwnStatus = note_kind
          , bwnTitle = removeBaseDir base_dir $ removeStatus note_kind $ show_msg (errMsgShortDoc msg)
@@ -530,7 +572,7 @@     loc | (s:_) <- errMsgSpans msg = s
         | otherwise                    = GHC.noSrcSpan
     unqual = errMsgContext msg
-    show_msg = showSDocForUser unqual
+    show_msg = showSDUser unqual df
 
 -- | remove the initial status text from a message
 removeStatus :: BWNoteStatus -> String -> String
@@ -665,8 +707,10 @@ 
 tokenType  ITocurly="SS"                    -- special symbols
 tokenType  ITccurly="SS" 
+#if __GLASGOW_HASKELL__ < 706   
 tokenType  ITocurlybar="SS"                 -- "{|", for type applications
 tokenType  ITccurlybar="SS"                 -- "|}", for type applications
+#endif
 tokenType  ITvocurly="SS" 
 tokenType  ITvccurly="SS" 
 tokenType  ITobrack="SS" 
@@ -765,6 +809,13 @@ tokenType ITsimpleQuote="SS"
 #endif
 
+-- 7.6 new token types 
+#if __GLASGOW_HASKELL__ >= 706
+tokenType ITctype= "P"
+tokenType ITlcase= "S"
+tokenType (ITqQuasiQuote {}) = "TH" -- [Qual.quoter| quote |]
+#endif
+
 dotFS :: FastString
 dotFS = fsLit "."
 
@@ -811,10 +862,11 @@ ghcImportToUsage myPkg (L _ imp) (ls,moduMap)=(do
         let L src modu=ideclName imp
         pkg<-lookupModule modu (ideclPkgQual imp)
-        let tmod=T.pack $ showSDoc $ ppr modu
-            tpkg=T.pack $ showSDoc $ ppr $ modulePackageId pkg
+        df<-getSessionDynFlags
+        let tmod=T.pack $ showSD True df $ ppr modu
+            tpkg=T.pack $ showSD True df $ ppr $ modulePackageId pkg
             nomain=if tpkg=="main" then myPkg else tpkg
-            subs=concatMap (ghcLIEToUsage (Just nomain) tmod "import") $ maybe [] snd $ ideclHiding imp
+            subs=concatMap (ghcLIEToUsage df (Just nomain) tmod "import") $ maybe [] snd $ ideclHiding imp
             moduMap2=maybe moduMap (\alias->let
                 mlmods=DM.lookup alias moduMap
                 newlmods=case mlmods of
@@ -828,35 +880,36 @@                 GMU.liftIO $ print se
                 return ([],moduMap))
          
-ghcLIEToUsage :: Maybe T.Text -> T.Text -> T.Text -> LIE Name -> [Usage]
-ghcLIEToUsage tpkg tmod tsection (L src (IEVar nm))=[ghcNameToUsage tpkg tmod tsection nm src False]
-ghcLIEToUsage tpkg tmod tsection (L src (IEThingAbs nm))=[ghcNameToUsage tpkg tmod tsection nm src True ] 
-ghcLIEToUsage tpkg tmod tsection (L src (IEThingAll nm))=[ghcNameToUsage tpkg tmod tsection nm src True] 
-ghcLIEToUsage tpkg tmod tsection (L src (IEThingWith nm cons))=ghcNameToUsage tpkg tmod tsection nm src True :
-        map (\ x -> ghcNameToUsage tpkg tmod tsection x src False) cons 
-ghcLIEToUsage tpkg tmod tsection (L src (IEModuleContents _))= [Usage tpkg tmod "" tsection False (toJSON $ ghcSpanToLocation src) False]              
-ghcLIEToUsage _ _ _ _=[]
+ghcLIEToUsage :: DynFlags -> Maybe T.Text -> T.Text -> T.Text -> LIE Name -> [Usage]
+ghcLIEToUsage df tpkg tmod tsection (L src (IEVar nm))=[ghcNameToUsage df tpkg tmod tsection nm src False]
+ghcLIEToUsage df tpkg tmod tsection (L src (IEThingAbs nm))=[ghcNameToUsage df tpkg tmod tsection nm src True ] 
+ghcLIEToUsage df tpkg tmod tsection (L src (IEThingAll nm))=[ghcNameToUsage df tpkg tmod tsection nm src True] 
+ghcLIEToUsage df tpkg tmod tsection (L src (IEThingWith nm cons))=ghcNameToUsage df tpkg tmod tsection nm src True :
+        map (\ x -> ghcNameToUsage df tpkg tmod tsection x src False) cons 
+ghcLIEToUsage _ tpkg tmod tsection (L src (IEModuleContents _))= [Usage tpkg tmod "" tsection False (toJSON $ ghcSpanToLocation src) False]              
+ghcLIEToUsage _ _ _ _ _=[]
         
-ghcExportToUsage :: T.Text -> T.Text ->AliasMap -> LIE Name -> Ghc [Usage]        
-ghcExportToUsage myPkg myMod moduMap lie@(L _ name)=(do
+ghcExportToUsage :: DynFlags -> T.Text -> T.Text ->AliasMap -> LIE Name -> Ghc [Usage]        
+ghcExportToUsage df myPkg myMod moduMap lie@(L _ name)=(do
         ls<-case name of
                 (IEModuleContents modu)-> do
                         let realModus=fromMaybe [modu] (DM.lookup modu moduMap)
                         mapM (\modu2->do
                                 pkg<-lookupModule modu2 Nothing
-                                let tpkg=T.pack $ showSDoc $ ppr $ modulePackageId pkg
-                                let tmod=T.pack $ showSDoc $ ppr modu2
+                                df<-getSessionDynFlags
+                                let tpkg=T.pack $ showSD True df $ ppr $ modulePackageId pkg
+                                let tmod=T.pack $ showSD True df $ ppr modu2
                                 return (tpkg,tmod)
                                 ) realModus
                 _ -> return [(myPkg,myMod)]
-        return $ concatMap (\(tpkg,tmod)->ghcLIEToUsage (Just tpkg) tmod "export" lie) ls
+        return $ concatMap (\(tpkg,tmod)->ghcLIEToUsage df (Just tpkg) tmod "export" lie) ls
         )
         `gcatch` (\(se :: SourceError) -> do
                 GMU.liftIO $ print se
                 return [])
         
-ghcNameToUsage ::  Maybe T.Text -> T.Text -> T.Text -> Name -> SrcSpan -> Bool -> Usage 
-ghcNameToUsage tpkg tmod tsection nm src typ=Usage tpkg tmod (T.pack $ showSDocUnqual $ ppr nm) tsection typ (toJSON $ ghcSpanToLocation src) False
+ghcNameToUsage ::  DynFlags -> Maybe T.Text -> T.Text -> T.Text -> Name -> SrcSpan -> Bool -> Usage 
+ghcNameToUsage df tpkg tmod tsection nm src typ=Usage tpkg tmod (T.pack $ showSD False df $ ppr nm) tsection typ (toJSON $ ghcSpanToLocation src) False
         
 --getGHCOutline :: ParsedSource
 --        -> [OutlineDef]

@@ -48,7 +48,7 @@ #endif
 
 import qualified Data.ByteString.Lazy as BS
-import qualified Data.ByteString.Lazy.Char8 as BSC (putStrLn)
+-- import qualified Data.ByteString.Lazy.Char8 as BSC (putStrLn)
 import qualified Data.ByteString as BSS
 import Data.Aeson
 import Data.Maybe
@@ -57,7 +57,11 @@ import qualified Data.Map as DM
 import qualified Data.Vector as V
 import Data.Attoparsec.Number (Number(I))
+#if __GLASGOW_HASKELL__ < 706
 import System.Time (ClockTime)
+#else
+import Data.Time.Clock (UTCTime)
+#endif
 import Type (splitFunTys)
 import Unique (getUnique)
 import Data.List (sortBy)
@@ -93,14 +97,14 @@ 
 -- | generate the JSON from the typechecked module
 -- this incorporates info from the renamed source with types annotations from the typechecked source
-generateGHCInfo :: TypecheckedModule -> Value
-generateGHCInfo tcm=let
+generateGHCInfo :: DynFlags -> TypecheckedModule -> Value
+generateGHCInfo df tcm=let
         -- extract usages from typechecked source
-        tcvals=extractUsages $ dataToJSON $ typecheckedSource tcm
+        tcvals=extractUsages $ dataToJSON df $ typecheckedSource tcm
         -- store objects with type annotations in a map keyed by module, name, line and column
         tcByNameLoc=foldr buildMap DM.empty tcvals
         -- extract usages from renamed source
-        rnvals=extractUsages $ dataToJSON $ tm_renamed_source tcm
+        rnvals=extractUsages $ dataToJSON df $ tm_renamed_source tcm
         -- add type information on objects
         typedVals=map (addType tcByNameLoc) rnvals
         in (Array $ V.fromList typedVals)
@@ -139,10 +143,12 @@                 addType _ v=v
 
 -- | store the GHC generated AST
-storeGHCInfo :: FilePath -- ^ the source file
+storeGHCInfo ::
+        DynFlags
+        -> FilePath -- ^ the source file
         -> TypecheckedModule -- ^ the GHC AST
         -> IO()
-storeGHCInfo fp tcm= -- do
+storeGHCInfo df fp tcm= -- do
 --        putStrLn $ showData TypeChecker 4 $ typecheckedSource tcm
 --        putStrLn "Typechecked"
 --        BSC.putStrLn $ encode $ dataToJSON $ typecheckedSource tcm
@@ -152,7 +158,7 @@ --        BSC.putStrLn $ encode $ Array $ V.fromList tcvals
 --        let rnvals=extractUsages $ dataToJSON $ tm_renamed_source tcm 
 --        BSC.putStrLn $ encode $ Array $ V.fromList rnvals
-        setStoredInfo fp "AST" $ generateGHCInfo tcm
+        setStoredInfo fp "AST" $ generateGHCInfo df tcm
         
                 
 -- | read the GHC AST as a JSON value
@@ -164,7 +170,11 @@ 
 -- | read the build flags and notes as a JSON value
 readBuildFlagsInfo :: FilePath -- ^ the source file
+#if __GLASGOW_HASKELL__ < 706
         -> ClockTime -- ^ time the cabal file was changed. If the file was changed after the storage file, we return Nothing
+#else
+        -> UTCTime
+#endif
         -> IO (Maybe (BuildFlags,[BWNote]))
 readBuildFlagsInfo fp ct=do
        let ghcInfoFile=getInfoFile fp
@@ -227,19 +237,19 @@         
 
 -- | convert a Data into a JSON value, with specific treatment for interesting GHC AST objects, and avoiding the holes
-dataToJSON :: Data a =>a -> Value
-dataToJSON  = 
+dataToJSON :: Data a => DynFlags -> a -> Value
+dataToJSON  df = 
   generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpanToJSON 
-          `extQ` name `extQ` occName `extQ` modName `extQ` var `extQ` exprVar `extQ` dataCon
+          `extQ` name `extQ` ocName `extQ` modName `extQ` var `extQ` exprVar `extQ` dataCon
           `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
           `extQ` postTcType `extQ` fixity  `extQ` hsBind
   where generic :: Data a => a -> Value
-        generic t =arr $ gmapQ dataToJSON t
+        generic t =arr $ gmapQ (dataToJSON df) t
                 -- object [(T.pack $ showConstr (toConstr t)) .= sub ] 
         string     = Data.Aeson.String . T.pack :: String -> Value
         fastString:: FastString -> Value
         fastString fs= object ["FastString" .= T.pack (show fs)] 
-        list l     = arr $ map dataToJSON l
+        list l     = arr $ map (dataToJSON df) l
         arr a = let
                 sub=filter (/= Null) a
                 in case sub of
@@ -248,11 +258,11 @@                      _ -> toJSON sub          
         name :: Name -> Value
         name  n     = object (nameAndModule n ++["GType" .= string "Name","HType".= string (if isValOcc (nameOccName n) then "v" else "t")])
-        occName :: OccName -> Value
-        occName o   = name (mkSystemName (getUnique o) o) 
+        ocName :: OccName -> Value
+        ocName o   = name (mkSystemName (getUnique o) o) 
                 --object ["Name" .= string (OccName.occNameString o),"HType" .= string (if isValOcc o then "v" else "t")]
         modName  :: ModuleName -> Value
-        modName m= object [ "Name" .= string (showSDoc $ ppr m),"GType" .= string "ModuleName","HType" .= string "m"]
+        modName m= object [ "Name" .= string (showSD True df $ ppr m),"GType" .= string "ModuleName","HType" .= string "m"]
 
         var :: Var -> Value
         var  v     = typedVar v (varType v)
@@ -296,21 +306,52 @@                 -- allT=typesInsideType t
                 -- allT2=allT ++ concatMap (\t2->let (a,b)= splitAppTys t2 in (a:b)) allT
                 -- in
-                ["Type" .= string (showSDocUnqual $ pprTypeForUser True t),
-                "QType" .= string (showSDoc $ pprTypeForUser True t)]
+                ["Type" .= string (showSD False df $ pprTypeForUser True t),
+                "QType" .= string (showSD True df $ pprTypeForUser True t)]
               --  ,"AllTypes" .= (map string $ filter ("[]" /=) $ nubOrd $ map (showSDoc . withPprStyle (mkUserStyle ((\_ _ -> NameNotInScope2), const True) AllTheWay) . pprTypeForUser True) allT2)]
         hsBind :: HsBindLR Name Name -> Value
         --(arr [dataToJSON $ getLoc fid,dataToJSON $ unLoc fid]) :
-        hsBind (FunBind fid _ (MatchGroup matches _) _ _ _) =arr $  map (\m->arr [arr [dataToJSON $ getLoc m,dataToJSON $ unLoc fid],dataToJSON m]) matches
+        hsBind (FunBind fid _ (MatchGroup matches _) _ _ _) =arr $  map (\m->arr [arr [dataToJSON df $ getLoc m,dataToJSON df $ unLoc fid],dataToJSON df m]) matches
         hsBind a=generic a
         -- nameAndModule :: Name -> [Pair]
         nameAndModule n=let
                 mm=nameModule_maybe n
-                mn=maybe "" (showSDoc . ppr . moduleName) mm
-                pkg=maybe "" (showSDoc . ppr . modulePackageId) mm
-                na=showSDocUnqual $ ppr n
+                mn=maybe "" (showSD True df . ppr . moduleName) mm
+                pkg=maybe "" (showSD True df . ppr . modulePackageId) mm
+                na=showSD False df $ ppr n
                 in ["Module" .= string mn,"Package" .= string pkg, "Name" .= string na]
 
+showSD :: Bool
+        -> DynFlags
+        -> SDoc
+        -> String
+#if __GLASGOW_HASKELL__ < 706        
+showSD True _ =showSDoc
+showSD False _ =showSDocUnqual
+#else
+showSD True df =showSDoc df
+showSD False df =showSDocUnqual df
+#endif
+
+showSDUser :: PrintUnqualified
+        -> DynFlags
+        -> SDoc
+        -> String
+#if __GLASGOW_HASKELL__ < 706        
+showSDUser unqual _ =showSDocForUser unqual
+#else
+showSDUser unqual df =showSDocForUser df unqual
+#endif
+
+showSDDump :: DynFlags
+        -> SDoc
+        -> String
+#if __GLASGOW_HASKELL__ < 706        
+showSDDump _ =showSDocDump
+#else
+showSDDump df =showSDocDump df
+#endif
+
 srcSpanToJSON :: SrcSpan -> Value
 srcSpanToJSON src 
         | isGoodSrcSpan src   = object[ "SrcSpan" .= toJSON [srcLocToJSON $ srcSpanStart src, srcLocToJSON $ srcSpanEnd src]] 
@@ -332,20 +373,20 @@          (f1,f2)=splitFunTys t
          in f2 : concatMap typesInsideType f1
         
--- | debug function: shows on standard output the JSON representation of the given data
-debugToJSON :: Data a =>a -> IO()
-debugToJSON = BSC.putStrLn . encode . dataToJSON
-
--- | debug searching thing at point in given data
-debugFindInJSON :: Data a => Int -> Int -> a -> IO()
-debugFindInJSON l c a= do
-        let v=dataToJSON a
-        let mv=findInJSON (overlap l c) v
-        case mv of
-                Just rv->do
-                        putStrLn "something found!"
-                        BSC.putStrLn $ encode rv
-                Nothing->putStrLn "nothing found!"
+---- | debug function: shows on standard output the JSON representation of the given data
+--debugToJSON :: Data a =>a -> IO()
+--debugToJSON = BSC.putStrLn . encode . dataToJSON
+--
+---- | debug searching thing at point in given data
+--debugFindInJSON :: Data a => Int -> Int -> a -> IO()
+--debugFindInJSON l c a= do
+--        let v=dataToJSON a
+--        let mv=findInJSON (overlap l c) v
+--        case mv of
+--                Just rv->do
+--                        putStrLn "something found!"
+--                        BSC.putStrLn $ encode rv
+--                Nothing->putStrLn "nothing found!"
 
 -- | simple type for search function
 type FindFunc= Value -> Bool
@@ -542,6 +583,9 @@        reduce stck       env (AppTy typ1 typ2)    = reduce (reduce [] env typ2 : stck) env typ1 -- push argument onto stack
        reduce []         env (ForAllTy var typ)   = ForAllTy var $ reduce [] env typ
        reduce (arg:stck) env (ForAllTy var typ)   = reduce stck ((var,arg) : env) typ           -- bind argument from stack to var
+#if __GLASGOW_HASKELL__ > 704
+       reduce _         _ t@(LitTy _)   =  t
+#endif
        reduce _          env (FunTy typ1 typ2)    = 
          let rtyp1 = reduce [] env typ1
              rtyp2 = reduce [] env typ2

@@ -13,6 +13,7 @@ -- Packages from packages databases (global, user).
 module Language.Haskell.BuildWrapper.Packages ( getPkgInfos ) where
 
+import Language.Haskell.BuildWrapper.Base
 
 import Prelude hiding (Maybe)
 import qualified Config
@@ -188,7 +189,7 @@ 
       (PkgFile dbFile) -> do
         pkgStr <- readUTF8File dbFile
-        let pkgs = map convertPackageInfoIn $ read pkgStr
+        let pkgs = map convertPackageInfoIn $ readObj "InstalledPackageInfo" pkgStr
         pkgInfoList <-
           Exception.evaluate pkgs
             `catchError`

@@ -29,13 +29,14 @@         configure _ r t= runAPI r $ API.configure t
         configureWithFlags _ r t fgs= runAPIFlags r (API.configure t) fgs
         build _ r b wc= runAPI r $ API.build b wc
-        build1 _ r fp= runAPI r $ API.build1 fp
-        getBuildFlags _ r fp= runAPI r $ API.getBuildFlags fp
-        getOutline _ r fp= runAPI r $ API.getOutline fp
+        build1 _ r fp= runAPI r $ API.build1 fp Nothing
+        build1c _ r fp ccn= runAPI r $ API.build1 fp (Just ccn)
+        getBuildFlags _ r fp= runAPI r $ API.getBuildFlags fp  Nothing
+        getOutline _ r fp= runAPI r $ API.getOutline fp  Nothing
         getTokenTypes _ r fp= runAPI r $ API.getTokenTypes fp
-        getOccurrences _ r fp s= runAPI r $ API.getOccurrences fp s
-        getThingAtPoint _ r fp l c= runAPI r $ API.getThingAtPoint fp l c
-        getNamesInScope _ r fp= runAPI r $ API.getNamesInScope fp
+        getOccurrences _ r fp s= runAPI r $ API.getOccurrences fp s  Nothing
+        getThingAtPoint _ r fp l c= runAPI r $ API.getThingAtPoint fp l c  Nothing
+        getNamesInScope _ r fp= runAPI r $ API.getNamesInScope fp  Nothing
         getCabalDependencies _ r= runAPI r API.getCabalDependencies
         getCabalComponents _ r= runAPI r API.getCabalComponents
         generateUsage _ r retAll cc=runAPI r $ API.generateUsage retAll $ cabalComponentName cc

@@ -41,6 +41,7 @@         configureWithFlags _ r t fgs= runAPI r "configure" ["--cabaltarget="++ show t,"--cabalflags="++ fgs]
         build _ r b wc= runAPI r "build" ["--output="++ show b,"--cabaltarget="++ show wc]
         build1 _ r fp= runAPI r "build1" ["--file="++fp]
+        build1c _ r fp ccn= runAPI r "build1" ["--file="++fp,"--component="++ccn]
         getBuildFlags _ r fp= runAPI r "getbuildflags" ["--file="++fp]
         getOutline _ r fp= runAPI r "outline" ["--file="++fp]
         getTokenTypes _ r fp= runAPI r "tokentypes" ["--file="++fp]

@@ -12,7 +12,7 @@ -- Abstract tests of the behavior
 module Language.Haskell.BuildWrapper.Tests where
 
-import Language.Haskell.BuildWrapper.Base
+import Language.Haskell.BuildWrapper.Base hiding (writeFile,readFile)
 
 import Data.ByteString.Lazy ()
 import Data.ByteString.Lazy.Char8()
@@ -53,7 +53,7 @@         testOutlineOptions,
         testPreviewTokenTypes,
         testThingAtPoint,
-        testThingAtPointTypeReduction,
+        testThingAtPointTypeReduction, 
         testThingAtPointNotInCabal,
         testThingAtPointMain,
         testThingAtPointMainSubFolder,
@@ -64,7 +64,9 @@         testCabalDependencies,
         testNoSourceDir,
         testFlags,
-        testBuildFlags
+        testBuildFlags,
+        testExplicitComponent,
+        testExplicitComponentUnRef
         ]
 
 class APIFacade a where
@@ -75,6 +77,7 @@         configureWithFlags :: a -> FilePath -> WhichCabal -> String -> IO (OpResult Bool)
         build :: a -> FilePath -> Bool -> WhichCabal -> IO (OpResult BuildResult)
         build1 :: a -> FilePath -> FilePath -> IO (OpResult (Maybe [NameDef]))
+        build1c :: a -> FilePath -> FilePath -> String -> IO (OpResult (Maybe [NameDef]))
         getBuildFlags :: a -> FilePath -> FilePath -> IO (OpResult BuildFlags)
         getOutline :: a -> FilePath ->  FilePath -> IO (OpResult OutlineResult)
         getTokenTypes :: a -> FilePath -> FilePath -> IO (OpResult [TokenDef])
@@ -938,7 +941,7 @@         assertEqual "not htype3"  (Just "t") (tapHType $ fromJust tap3)
         assertEqual "qtype DataT" Nothing (tapQType $ fromJust tap3)
         
-#if __GLASGOW_HASKELL__ < 704
+#if __GLASGOW_HASKELL__ != 704
         -- type information for constructors at the declaration is not supported by ghc 7.4       
         (tap4,nsErrors4)<-getThingAtPoint api root rel 4 14
         assertBool ("errors or warnings on getThingAtPoint4:"++show nsErrors4) (null nsErrors4)
@@ -967,7 +970,7 @@         assertEqual "not htype6"  (Just "t") (tapHType $ fromJust tap6)
         assertEqual "qtype Toot" Nothing (tapQType $ fromJust tap6)
 
-#if __GLASGOW_HASKELL__ < 704
+#if __GLASGOW_HASKELL__ != 704
         -- type information for constructors at the declaration is not supported by ghc 7.4       
         (tap7,nsErrors7)<-getThingAtPoint api root rel 6 14
         assertBool ("errors or warnings on getThingAtPoint7:"++show nsErrors7) (null nsErrors7)
@@ -1026,9 +1029,15 @@         assertBool ("errors or warnings on getThingAtPointM:"++show nsErrorsM) (null nsErrorsM)
         assertBool "not just tapM" (isJust tapM)
         assertEqual "not insert" "insert" (tapName $ fromJust tapM)
+#if __GLASGOW_HASKELL__ >= 706
+        assertEqual "not Data.Map.Base module" (Just "Data.Map.Base") (tapModule $ fromJust tapM)
+        assertEqual "not htypeM"  (Just "v") (tapHType $ fromJust tapM)
+        assertEqual "qtype insert" (Just "GHC.Base.String -> GHC.Types.Int -> Data.Map.Base.Map GHC.Base.String GHC.Types.Int -> Data.Map.Base.Map GHC.Base.String GHC.Types.Int") (tapQType $ fromJust tapM)
+#else
         assertEqual "not Data.Map module" (Just "Data.Map") (tapModule $ fromJust tapM)
         assertEqual "not htypeM"  (Just "v") (tapHType $ fromJust tapM)
         assertEqual "qtype insert" (Just "GHC.Base.String -> GHC.Types.Int -> Data.Map.Map GHC.Base.String GHC.Types.Int -> Data.Map.Map GHC.Base.String GHC.Types.Int") (tapQType $ fromJust tapM)
+#endif
         )) 
 
 testThingAtPointNotInCabal :: (APIFacade a)=> a -> Test
@@ -1426,7 +1435,97 @@         assertBool "OverlappingInstances" ("OverlappingInstances" `notElem` ast)
         ))
         
-
+testExplicitComponent :: (APIFacade a)=> a -> Test
+testExplicitComponent api=TestLabel "testExplicitComponent" (TestCase (do
+        root<-createTestProject
+        let cf=testCabalFile root
+        writeFile cf $ unlines ["name: "++testProjectName,
+                "version:0.1",
+                "cabal-version:  >= 1.8",
+                "build-type:     Simple",
+                "",
+                "library",
+                "  hs-source-dirs:  src",
+                "  exposed-modules: A",
+                "  other-modules:  B",
+                "  build-depends:  base,containers",
+                "executable BWTest",
+                "  hs-source-dirs:  src",
+                "  main-is:         Main.hs",
+                "  other-modules:  B",
+                "  build-depends:  base,containers",
+                "",
+                "executable BWTest2",
+                "  hs-source-dirs:  src",
+                "  main-is:         Main2.hs",
+                "  other-modules:  B",
+                "  build-depends:  base"
+                ]
+        let rel="src"</>"B.hs"  
+        writeFile (root </> rel) $ unlines [
+                "module B where",
+                "import qualified Data.Map as M",
+                "ins=M.insert 'k' 0 M.empty"
+                ]
+        configure api root Source 
+        
+        synchronize1 api root True rel
+        --build1 api root rel
+        (names1,nsErrors1)<-build1c api root rel ""
+        assertBool "returned nothing on bool1" (isJust names1)
+        assertBool "errors or warnings on nsErrors1" (null nsErrors1)
+        (names2,nsErrors2)<-build1c api root rel "BWTest"
+        assertBool "returned nothing on bool2" (isJust names2)
+        assertBool "errors or warnings on nsErrors2" (null nsErrors2)
+        (names3,nsErrors3)<-build1c api root rel "BWTest2"
+        assertBool "returned nothing on bool3" (isNothing names3)
+        assertBool "no errors or warnings on nsErrors2" (not $ null nsErrors3)
+        ))
+   
+testExplicitComponentUnRef :: (APIFacade a)=> a -> Test
+testExplicitComponentUnRef api=TestLabel "testExplicitComponentUnRef" (TestCase (do
+        root<-createTestProject
+        let cf=testCabalFile root
+        writeFile cf $ unlines ["name: "++testProjectName,
+                "version:0.1",
+                "cabal-version:  >= 1.8",
+                "build-type:     Simple",
+                "",
+                "library",
+                "  hs-source-dirs:  src",
+                "  exposed-modules: A",
+                "  build-depends:  base,containers",
+                "executable BWTest",
+                "  hs-source-dirs:  src",
+                "  main-is:         Main.hs",
+                "  build-depends:  base,containers",
+                "",
+                "executable BWTest2",
+                "  hs-source-dirs:  src",
+                "  main-is:         Main2.hs",
+                "  build-depends:  base"
+                ]
+        let rel="src"</>"B.hs"  
+        writeFile (root </> rel) $ unlines [
+                "module B where",
+                "import qualified Data.Map as M",
+                "ins=M.insert 'k' 0 M.empty"
+                ]
+        configure api root Source 
+        
+        synchronize1 api root True rel
+        --build1 api root rel
+        (names1,nsErrors1)<-build1c api root rel ""
+        assertBool "returned nothing on bool1" (isJust names1)
+        assertBool "errors or warnings on nsErrors1" (null nsErrors1)
+        (names2,nsErrors2)<-build1c api root rel "BWTest"
+        assertBool "returned nothing on bool2" (isJust names2)
+        assertBool "errors or warnings on nsErrors2" (null nsErrors2)
+        (names3,nsErrors3)<-build1c api root rel "BWTest2"
+        assertBool "returned nothing on bool3" (isNothing names3)
+        assertBool "no errors or warnings on nsErrors2" (not $ null nsErrors3)
+        ))   
+        
 testProjectName :: String
 testProjectName="BWTest"         
         

@@ -1,7 +1,7 @@ {-# LANGUAGE CPP,OverloadedStrings,PatternGuards #-}
 module Language.Haskell.BuildWrapper.UsagesTests where
 
-import Language.Haskell.BuildWrapper.Base
+import Language.Haskell.BuildWrapper.Base hiding (readFile,writeFile)
 
 import Language.Haskell.BuildWrapper.Tests
 import Language.Haskell.BuildWrapper.CMDTests

@@ -26,7 +26,7 @@ tests = [
         testGroup "Unit Tests" (concatMap hUnitTestToTests unitTests),
         testGroup "GHC Tests" (concatMap hUnitTestToTests ghcTests),
-        testGroup "Command Tests" (concatMap hUnitTestToTests cmdTests),
+        testGroup "Command Tests" (concatMap hUnitTestToTests cmdTests) ,
         testGroup "Usages Tests" (concatMap hUnitTestToTests usageTests)
         ]