buildwrapper 0.5.2 → 0.6.0

raw patch · 14 files changed

+1716/−349 lines, 14 filesdep −ghc-syb-utilsdep ~vectorPVP ok

version bump matches the API change (PVP)

Dependencies removed: ghc-syb-utils

Dependency ranges changed: vector

API changes (from Hackage documentation)

Files

• buildwrapper.cabal +14/−8
• src-exe/Language/Haskell/BuildWrapper/CMD.hs +11/−1
• src/Language/Haskell/BuildWrapper/API.hs +260/−36
• src/Language/Haskell/BuildWrapper/Base.hs +206/−81
• src/Language/Haskell/BuildWrapper/Cabal.hs +75/−41
• src/Language/Haskell/BuildWrapper/GHC.hs +184/−63
• src/Language/Haskell/BuildWrapper/GHCStorage.hs +235/−50
• src/Language/Haskell/BuildWrapper/Packages.hs +18/−18
• src/Language/Haskell/BuildWrapper/Src.hs +16/−7
• test/Language/Haskell/BuildWrapper/APITest.hs +29/−0
• test/Language/Haskell/BuildWrapper/CMDTests.hs +2/−0
• test/Language/Haskell/BuildWrapper/Tests.hs +273/−41
• test/Language/Haskell/BuildWrapper/UsagesTests.hs +387/−0
• test/Main.hs +6/−3

@@ -1,5 +1,5 @@ name:           buildwrapper
-version:        0.5.2
+version:        0.6.0
 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3
@@ -29,7 +29,7 @@                    ghc,
                    ghc-paths,
                    syb,
-                   ghc-syb-utils,
+                   -- ghc-syb-utils,
                    text,
                    containers,
                    vector >= 0.8,
@@ -69,7 +69,7 @@                    cpphs,
                    haskell-src-exts,
                    old-time,
-                   ghc-syb-utils,
+                   -- ghc-syb-utils,
                    ghc-paths,
                    vector >= 0.8,
                    containers,
@@ -80,7 +80,7 @@                    aeson >=0.4,
                    bytestring,
                    transformers
-  ghc-options:     -Wall -fno-warn-unused-do-bind
+  ghc-options:     -Wall -fno-warn-unused-do-bind -optl -s
   other-modules:   Language.Haskell.BuildWrapper.CMD
   
 test-suite buildwrapper-test
@@ -102,13 +102,19 @@                    attoparsec,
                    test-framework,
                    test-framework-hunit,
-                   transformers
+                   transformers,
+                   vector,
+                   unordered-containers,
+                   containers
   main-is:         Main.hs
-  ghc-options:     -Wall -fno-warn-unused-do-bind
+  ghc-options:     -Wall -fno-warn-unused-do-bind -optl -s
   x-uses-tf:       true
   other-modules:   
-                   Language.Haskell.BuildWrapper.APITest, Language.Haskell.BuildWrapper.Tests, Language.Haskell.BuildWrapper.CMDTests,
-                   Language.Haskell.BuildWrapper.GHCTests
+                   Language.Haskell.BuildWrapper.APITest,
+                   Language.Haskell.BuildWrapper.Tests,
+                   Language.Haskell.BuildWrapper.CMDTests,
+                   Language.Haskell.BuildWrapper.GHCTests,
+                   Language.Haskell.BuildWrapper.UsagesTests
 
 source-repository head
   type:     git

@@ -44,6 +44,7 @@         | 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}
+        | GenerateUsage {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], returnAll:: Bool, cabalComponent::String}
     deriving (Show,Read,Data,Typeable)    
   
 
@@ -67,6 +68,12 @@ wc :: WhichCabal
 wc=Target &= help "which cabal file to use: original or temporary"
 
+cc :: String
+cc=def &= help "cabal component"
+
+ra :: Bool
+ra=def &= help "return all source paths"
+
 msynchronize :: BWCmd
 msynchronize = Synchronize tf cp cf uf co ff
 msynchronize1 :: BWCmd
@@ -97,6 +104,8 @@ mdependencies=Dependencies tf cp cf uf co
 mcomponents :: BWCmd
 mcomponents=Components tf cp cf uf co
+mgenerateUsage :: BWCmd
+mgenerateUsage=GenerateUsage tf cp cf uf co ra cc
 
 -- | main method for command handling
 cmdMain :: IO ()
@@ -104,7 +113,7 @@   (modes      [msynchronize, msynchronize1, mconfigure, mwrite, mbuild, mbuild1,       mgetbf, moutline, mtokenTypes, moccurrences, mthingAtPoint,-      mnamesInScope, mdependencies, mcomponents]+      mnamesInScope, mdependencies, mcomponents, mgenerateUsage]      &= helpArg [explicit, name "help", name "h"]      &= help "buildwrapper executable"      &= program "buildwrapper"@@ -128,6 +137,7 @@                 handle c@NamesInScope{file=fi}=runCmd c (getNamesInScope fi)
                 handle c@Dependencies{}=runCmd c getCabalDependencies
                 handle c@Components{}=runCmd c getCabalComponents
+                handle c@GenerateUsage{returnAll=reta,cabalComponent=comp}=runCmd c (generateUsage reta comp)
                 runCmd :: (ToJSON a) => BWCmd -> StateT BuildWrapperState IO a -> IO ()
                 runCmd=runCmdV Normal
                 runCmdV:: (ToJSON a) => Verbosity -> BWCmd -> StateT BuildWrapperState IO a -> IO ()

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, ScopedTypeVariables #-}
+{-# LANGUAGE CPP, ScopedTypeVariables, OverloadedStrings, PatternGuards #-}
 -- |
 -- Module      : Language.Haskell.BuildWrapper.API
 -- Author      : JP Moresmau
@@ -12,38 +12,52 @@ -- API entry point, with all exposed methods
 module Language.Haskell.BuildWrapper.API where
 
+import Distribution.Simple.LocalBuildInfo (localPkgDescr)
+import Distribution.Package (packageId)
+import Distribution.Text (display)
 import Language.Haskell.BuildWrapper.Base
 import Language.Haskell.BuildWrapper.Cabal
 import qualified Language.Haskell.BuildWrapper.GHC as BwGHC
 import Language.Haskell.BuildWrapper.GHCStorage
 import Language.Haskell.BuildWrapper.Src
 
+
 import qualified Data.Text as T
+import qualified Data.HashMap.Lazy as HM
+import qualified Data.Map as DM
+import Data.List (sortBy)
 
 import Prelude hiding (readFile, writeFile)
+import qualified Data.Vector as V
 
 import System.IO.UTF8
 
 import Control.Monad.State
-import Language.Haskell.Exts.Annotated
+import Language.Haskell.Exts.Annotated hiding (String)
 import Language.Preprocessor.Cpphs
 import Data.Maybe
 import System.Directory
 import System.FilePath
-import GHC (TypecheckedSource)
+import GHC (RenamedSource, TypecheckedSource, TypecheckedModule(..), Ghc, ms_mod, pm_mod_summary, moduleName)
+import Data.Aeson
+import Outputable (showSDoc,ppr)
+import Data.Foldable (foldrM)
 
+
+
 -- | 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]) -- ^ return the list of files copied
+        -> BuildWrapper(OpResult ([FilePath],[FilePath])) -- ^ return the list of files copied, the list of files deleted
 synchronize force =do
         cf<-gets cabalFile
-        m<-copyFromMain force $ takeFileName cf
         (fileList,ns)<-getFilesToCopy
-        m1<-mapM (copyFromMain force)(
+        let fullFileList=takeFileName cf :
                 "Setup.hs":
                 "Setup.lhs":
-                fileList)
-        return (catMaybes (m : m1), ns)
+                fileList
+        m1<-mapM (copyFromMain force) fullFileList
+        del<-deleteGhosts fullFileList
+        return ((catMaybes m1,del), ns)
 
 -- | synchronize one file only
 synchronize1 ::  Bool -- ^ always copy the file, if false only copy the file if it is newer than its corresponding temp file
@@ -75,20 +89,206 @@         -> BuildWrapper (OpResult BuildResult)
 build = cabalBuild
 
+-- | generate usage information files
+generateUsage :: Bool -- ^ should we return all files or only the changed ones?
+        -> String -- ^ the cabal component name
+        -> BuildWrapper(OpResult (Maybe [FilePath]))
+generateUsage returnAll ccn= 
+        withCabal Source (\lbi -> do 
+                cbis<-getAllFiles lbi
+                cf<-gets cabalFile
+                temp<-getFullTempDir
+                let dir=takeDirectory cf
+                let pkg=T.pack $ display $ packageId $ localPkgDescr lbi
+                allMps<-mapM (\cbi->do
+                        let 
+                                mps1=map (\(m,f)->(f,moduleToString $ fromJust m)) $ filter (isJust . fst) $ cbiModulePaths cbi
+                        mps<-filterM (\(f,_)->do
+                                fullSrc<-getFullSrc f
+                                fullTgt<-getTargetPath f
+                                let fullUsage=getUsageFile fullTgt
+                                liftIO $ isSourceMoreRecent fullSrc fullUsage
+                                -- liftIO $ Prelude.putStrLn (fullSrc ++ "->" ++ fullUsage ++":"++(show recent))
+                                --return recent 
+                                        ) $ filter (\(f,_)->let ext=takeExtension f
+                                                in ext `elem` [".hs",".lhs"]
+                                                )
+                                                mps1
+                        opts<-fileGhcOptions (lbi,cbi)        
+                        modules<-liftIO $ do
+                                cd<-getCurrentDirectory
+                                setCurrentDirectory dir
+                                (mods,_)<-BwGHC.withASTNotes (getModule pkg) (temp </>) dir (MultipleFile mps) opts     
+                                setCurrentDirectory cd 
+                                return mods
+                        mapM_ (generate pkg) modules
+                        return $ if returnAll then mps1 else mps
+                        ) $ filter (\cbi->cabalComponentName (cbiComponent cbi) == ccn) cbis
+                return $ map fst $ concat allMps
+                )
+        where
+                -- | get module name and import/export usage information
+                getModule :: T.Text -- ^ the current package name
+                        ->  FilePath -- ^ the file to process
+                        -> TypecheckedModule -- ^ the GHC typechecked module
+                        -> Ghc(FilePath,T.Text,RenamedSource,[Usage])
+                getModule pkg f tm=do
+                        let rs@(_,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)
+                        --ms_mod $ pm_mod_summary $ tm_parsed_module tm
+                        return (f,modu,rs,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) 
+                        | 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
+                                -- 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
+                                case mast of
+                                        Just (ParseOk ast)->do
+                                                let ods=getHSEOutline ast
+                                                --liftIO $ Prelude.print ods
+                                                let val=reconcile pkg vals ods ius
+                                                let (es,is)=getHSEImportExport ast
+                                                let modLoc=maybe Null toJSON (getModuleLocation ast) 
+                                                let valWithModule=Array $ V.fromList [toJSON pkg,toJSON modu,modLoc,val,toJSON $ OutlineResult ods es is]
+                                                liftIO $ setUsageInfo tgt valWithModule
+                                                return ()
+                                        _ -> return ()
+                                return ()
+                -- | reconcile AST, usage information and outline into one final usage object        
+                reconcile :: T.Text  -- ^ the current package name
+                        ->  [Value] -> [OutlineDef] ->  [Usage] -> Value
+                reconcile pkg vals ods ius=let
+                        mapOds=foldr mapOutline DM.empty ods
+                        in foldr usageToJSON (object []) 
+                                (ius ++ concatMap (ghcValToUsage pkg mapOds) vals)
+                -- | store outline def by line
+                mapOutline :: OutlineDef -> DM.Map Int [OutlineDef] -> DM.Map Int [OutlineDef]
+                mapOutline od m=let
+                        ifs=odLoc od
+                        lins=[(iflLine $ ifsStart ifs) .. (iflLine $ ifsEnd ifs)]
+                        m2=foldr (addOutline od) m lins
+                        in foldr mapOutline m2 (odChildren od)
+                -- | add one outline def by line
+                addOutline :: OutlineDef -> Int -> DM.Map Int [OutlineDef] -> DM.Map Int [OutlineDef]
+                addOutline od l m=let
+                        mods=DM.lookup l m
+                        newOds=case mods of
+                                Just ods->od:ods
+                                Nothing->[od]
+                        in DM.insert l newOds m   
+                -- | translate Usage structure to JSON        
+                usageToJSON :: Usage -> Value -> Value
+                usageToJSON u v@(Object pkgs) | Just pkg<-usagePackage u v=
+                        let 
+                                
+                                (Object mods) = HM.lookupDefault (object []) pkg pkgs
+                                (Object types)= HM.lookupDefault (object []) (usModule u) mods
+                                typeKey=if usType u
+                                        then "types"
+                                        else "vars"
+                                (Object names)= HM.lookupDefault (object []) typeKey  types     
+                                nameKey=usName u
+                                --  , ",", (usType u)
+                                (Array lins)= HM.lookupDefault (Array V.empty) nameKey names
+                                lineV= usLoc u  -- Number $ I $ usLine u
+                                objectV=object ["s" .= usSection u, "d" .= usDef u, "l" .= lineV]
+                                lins2=if objectV `V.elem` lins
+                                        then lins
+                                        else V.cons objectV lins
+                                names2=HM.insert nameKey (Array lins2) names
+                                types2=HM.insert typeKey (Object names2) types
+                                mods2=HM.insert (usModule u) (Object types2) mods
+                       in Object $ HM.insert pkg (Object mods2) pkgs
+                usageToJSON _ a=a
+                -- | get the package for a given usage module
+                usagePackage ::  Usage -> Value -> Maybe T.Text
+                usagePackage u (Object pkgs)=case usPackage u of
+                        Just p->Just p
+                        Nothing->let
+                                modu=usModule u
+                                matchingpkgs=HM.foldrWithKey (listPkgs modu) [] pkgs
+                                in listToMaybe matchingpkgs
+                usagePackage _ _=Nothing
+                -- | list packages possible for module
+                listPkgs :: T.Text -> T.Text -> Value -> [T.Text] -> [T.Text] 
+                listPkgs modu k (Object mods) l=if HM.member modu mods then k : l else l        
+                listPkgs _ _ _ l=l      
+                -- | translate GHC AST to Usages
+                ghcValToUsage ::  T.Text -> DM.Map Int [OutlineDef] -> Value -> [Usage]
+                ghcValToUsage pkg mapOds (Object m) |
+                        Just (String s)<-HM.lookup "Name" m,
+                        Just (String mo)<-HM.lookup "Module" m,
+                        not $ T.null mo, -- ignore local objects
+                        Just (String p)<-HM.lookup "Package" m,
+                        Just (String ht)<-HM.lookup "HType" m,
+                        Just arr<-HM.lookup "Pos" m,
+                        Success ifs <- fromJSON arr= let
+                                mods=DM.lookup (iflLine $ ifsStart ifs) mapOds
+                                (section,def)=getSection mods s ifs
+                                in [Usage (Just (if p=="main" then pkg else p)) mo s section (ht=="t") arr def]
+                ghcValToUsage _ _ _=[]
+                -- | retrieve section name for given location, and whether what we reference is actually a reference, and in that case the comment
+                getSection :: Maybe [OutlineDef]  -> T.Text -> InFileSpan -> (T.Text,Bool)
+                getSection (Just ods) objName ifs =let
+                        matchods=filter (\od-> ifsOverlap (odLoc od) ifs) ods
+                        bestods=sortBy (\od1 od2->let
+                                l1=iflLine $ ifsStart $ odLoc od1
+                                l2=iflLine $ ifsStart $ odLoc od2
+                                in case compare l2 l1 of
+                                   EQ -> let
+                                        c1=iflColumn $ ifsStart $ odLoc od1
+                                        c2=iflColumn $ ifsStart $ odLoc od2
+                                        in compare c2 c1
+                                   a-> a
+                                ) matchods
+                        in case bestods of
+                                (x:_)->let 
+                                        def=odName x == objName && 
+                                                ((iflColumn (ifsStart $ odLoc x) == iflColumn (ifsStart ifs))
+                                                || (
+                                                        (Data `elem` odType x)
+                                                    && (iflColumn (ifsStart $ odLoc x) + 5==iflColumn (ifsStart ifs))    
+                                                    )
+                                                || (
+                                                        (Type `elem` odType x)
+                                                    && (iflColumn (ifsStart $ odLoc x) + 5 == iflColumn (ifsStart ifs))    
+                                                    ))  
+                                       in (odName x,def)
+                                _->("",False)
+                getSection _ _ _=("",False)
+--                importToUsage :: ImportDef -> [Usage]
+--                importToUsage imd=[Usage (i_package imd) (i_module imd) "" False (toJSON $ i_loc imd)]
+                
+
+
 -- | build one source file in GHC
 build1 :: FilePath -- ^ the source file
-        -> BuildWrapper (OpResult Bool) -- ^ True if build is successful
-build1 fp=do
-        (mtm,msgs)<-getGHCAST fp
-        return (isJust mtm,msgs)
+        -> BuildWrapper (OpResult (Maybe [NameDef])) -- ^ True if build is successful
+build1 fp=withGHCAST' fp BwGHC.getGhcNameDefsInScope
 
+
 -- | preprocess a file
 preproc :: BuildFlags  -- ^ the build flags       
         -> FilePath -- ^ the file to preprocess
         -> IO String -- ^ the resulting code
 preproc bf tgt= do
         inputOrig<-readFile tgt
-        let epo=parseOptions $ bf_preproc bf
+        let epo=parseOptions $ bfPreproc bf
         case epo of
                     Right opts2->runCpphs opts2 tgt inputOrig
                     Left _->return inputOrig
@@ -107,16 +307,26 @@                         (mcbi,bwns)<-getBuildInfo fp
                         ret<-case mcbi of
                                 Just cbi->do
-                                        (_,opts2)<-fileGhcOptions cbi
+                                        opts2<-fileGhcOptions cbi
+                                        -- liftIO $ Prelude.print fp
+                                        -- liftIO $ Prelude.print $ cbiModulePaths $ snd cbi
+                                        -- liftIO $ Prelude.print opts2
                                         let 
-                                                (modName,opts)=cabalExtensions $ snd cbi
-                                                lit=".lhs" == takeExtension fp
-                                                cppo=fileCppOptions (snd cbi) ++ ["-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__ :: Int)] ++ ["--unlit" | lit]
-                                                modS=moduleToString modName
-                                        return (BuildFlags  (opts ++ opts2) cppo  (Just modS),bwns)
-                                Nothing -> return (BuildFlags knownExtensionNames  []  Nothing,[])
+                                                fullFp=(takeDirectory src) </> fp
+                                                modName=listToMaybe $ mapMaybe fst (filter (\ (_, f) -> f == fullFp) $ cbiModulePaths $ snd cbi)
+                                                -- (modName,_)=cabalExtensions $ snd cbi
+                                                cppo=fileCppOptions (snd cbi) ++ unlitF
+                                                modS=fmap moduleToString modName
+                                        -- liftIO $ Prelude.print opts
+                                        -- ghcOptions is sufficient, contains extensions and such
+                                        -- opts ++
+                                        return (BuildFlags opts2 cppo modS,bwns)
+                                Nothing -> return (BuildFlags [] unlitF Nothing,[])
                         liftIO $ storeBuildFlagsInfo tgt ret
                         return ret
+        where unlitF=let
+                lit=".lhs" == takeExtension fp
+                in ("-D__GLASGOW_HASKELL__=" ++ show (__GLASGOW_HASKELL__ :: Int)) : ["--unlit" | lit]
 
 -- | get haskell-src-exts commented AST for source file
 getAST :: FilePath -- ^  the source file
@@ -125,13 +335,13 @@         (bf,ns)<-getBuildFlags fp
         tgt<-getTargetPath fp
         input<-liftIO $ preproc bf tgt
-        pr<- liftIO $ getHSEAST input (bf_ast bf)
+        pr<- liftIO $ getHSEAST input (bfAst bf)
         return (Just pr,ns)
 
 -- | get GHC typechecked AST for source file
 getGHCAST :: FilePath -- ^ the source file
         -> BuildWrapper (OpResult (Maybe TypecheckedSource))
-getGHCAST fp = withGHCAST' fp (\_->BwGHC.getAST)
+getGHCAST fp = withGHCAST' fp BwGHC.getAST
 
 -- | perform an action on the GHC AST
 withGHCAST ::  FilePath -- ^ the source file
@@ -141,13 +351,12 @@                 -> [String] --  ^ the GHC options
                 -> IO a)
         -> BuildWrapper (OpResult (Maybe a))
-withGHCAST fp f=withGHCAST' fp (\n a b c d->do
+withGHCAST fp f=withGHCAST' fp (\a b c d->do
         r<- f a b c d
-        return (Just r,n))
+        return (Just r,[]))
 
 withGHCAST' ::  FilePath -- ^ the source file
-        -> ([BWNote] --  ^ the notes from getting the flags
-        -> FilePath --  ^ the source file
+        -> (FilePath --  ^ the source file
         -> FilePath --  ^ the base directory
         ->  String --  ^ the module name
         -> [String] --  ^ the GHC options
@@ -161,7 +370,7 @@                         liftIO $ do
                                 cd<-getCurrentDirectory
                                 setCurrentDirectory temp
-                                (pr,bwns2)<- f [] tgt temp modS opts
+                                (pr,bwns2)<- f tgt temp modS opts
                                 setCurrentDirectory cd
                                 return (pr,ns ++ bwns2)
                 _ -> return (Nothing,ns)
@@ -170,15 +379,30 @@ getOutline :: FilePath -- ^ source file
         -> BuildWrapper (OpResult OutlineResult)
 getOutline fp=do
-       (mast,bwns)<-getAST fp
-       case mast of
-        Just (ParseOk ast)->do
-                --liftIO $ Prelude.print ast
-                let ods=getHSEOutline ast
-                let (es,is)=getHSEImportExport ast
-                return (OutlineResult ods es is,bwns)
-        Just (ParseFailed failLoc err)->return (OutlineResult [] [] [],BWNote BWError err (BWLocation fp (srcLine failLoc) (srcColumn failLoc)) :bwns)
-        _ -> return (OutlineResult [] [] [],bwns)
+       tgt<-getTargetPath fp
+       let usageFile=getUsageFile tgt
+       usageStale<-liftIO $ isSourceMoreRecent tgt usageFile 
+       mods<-if not usageStale
+          then do
+               mv<-liftIO $ getUsageInfo tgt
+               return $ case mv of
+                        (Array arr) | V.length arr==5->let
+                                (Success r)= fromJSON (arr V.! 4)
+                                in (Just r) 
+                        _->Nothing
+          else return Nothing
+       case mods of
+                Just ods-> return (ods,[])
+                _ -> do   
+                       (mast,bwns)<-getAST fp
+                       case mast of
+                        Just (ParseOk ast)->do
+                                --liftIO $ Prelude.print ast
+                                let ods=getHSEOutline ast
+                                let (es,is)=getHSEImportExport ast
+                                return (OutlineResult ods es is,bwns)
+                        Just (ParseFailed failLoc err)->return (OutlineResult [] [] [],BWNote BWError err (BWLocation fp (srcLine failLoc) (srcColumn failLoc)) :bwns)
+                        _ -> return (OutlineResult [] [] [],bwns)
  
 -- | get lexer token types for source file 
 getTokenTypes :: FilePath -- ^ the source file

@@ -1,4 +1,4 @@-{-# LANGUAGE DeriveDataTypeable,OverloadedStrings,PatternGuards #-}
+{-# LANGUAGE DeriveDataTypeable,OverloadedStrings,PatternGuards, NamedFieldPuns #-}
 -- |
 -- Module      : Language.Haskell.BuildWrapper.GHC
 -- Author      : JP Moresmau
@@ -21,11 +21,15 @@ import qualified Data.Text as T
 import qualified Data.HashMap.Lazy as M
 import qualified Data.Vector as V
+import qualified Data.Set as S
 
 import System.Directory
 import System.FilePath
 import Data.List (isPrefixOf)
+import Data.Maybe (catMaybes)
 
+
+
 -- | State type
 type BuildWrapper=StateT BuildWrapperState IO
 
@@ -52,9 +56,9 @@  
 -- | location of a note/error
 data BWLocation=BWLocation {
-        bwl_src::FilePath -- ^ source file 
-        ,bwl_line::Int -- ^ line
-        ,bwl_col::Int -- ^ column
+        bwlSrc::FilePath -- ^ source file 
+        ,bwlLine::Int -- ^ line
+        ,bwlCol::Int -- ^ column
         }
         deriving (Show,Read,Eq)
 
@@ -70,14 +74,14 @@ 
 -- | a note on a source file
 data BWNote=BWNote {
-        bwn_status :: BWNoteStatus -- ^ status of the note
-        ,bwn_title :: String -- ^ message
-        ,bwn_location :: BWLocation -- ^ where the note is
+        bwnStatus :: BWNoteStatus -- ^ status of the note
+        ,bwnTitle :: String -- ^ message
+        ,bwnLocation :: BWLocation -- ^ where the note is
         }
         deriving (Show,Read,Eq)
       
 isBWNoteError :: BWNote -> Bool
-isBWNoteError bw=(bwn_status bw) == BWError
+isBWNoteError bw=bwnStatus bw == BWError
         
 instance ToJSON BWNote  where
     toJSON (BWNote s t l)= object ["s" .= s, "t" .= t, "l" .= l]       
@@ -105,6 +109,20 @@                          v .: "fps" 
     parseJSON _= mzero    
 
+-- | result for building one file: success + names
+--data Build1Result=Build1Result Bool [NameDef]
+--        deriving (Show,Read,Eq)
+--  
+--instance ToJSON Build1Result  where
+--    toJSON (Build1Result b ns)= object ["r" .= b, "ns" .= map toJSON ns]       
+--
+--instance FromJSON Build1Result where
+--    parseJSON (Object v) =Build1Result <$>
+--                         v .: "r" <*>
+--                         v .: "ns" 
+--    parseJSON _= mzero    
+
+
 -- | which cabal file to use operations
 data WhichCabal=
         Source   -- ^ use proper file
@@ -134,17 +152,30 @@     parseJSON _= mzero
  
 -- | Location inside a file, the file is known and doesn't need to be repeated 
-data InFileLoc=InFileLoc {ifl_line::Int -- ^ line
-        ,ifl_column::Int -- ^ column
+data InFileLoc=InFileLoc {iflLine::Int -- ^ line
+        ,iflColumn::Int -- ^ column
         }
         deriving (Show,Read,Eq,Ord)
 
 -- | Span inside a file, the file is known and doesn't need to be repeated 
-data InFileSpan=InFileSpan {ifs_start::InFileLoc -- ^ start location
-        ,ifs_end::InFileLoc  -- ^ end location
+data InFileSpan=InFileSpan {ifsStart::InFileLoc -- ^ start location
+        ,ifsEnd::InFileLoc  -- ^ end location
         }
         deriving (Show,Read,Eq,Ord)
 
+ifsOverlap :: InFileSpan -> InFileSpan -> Bool
+ifsOverlap ifs1 ifs2 = iflOverlap ifs1 $ ifsStart ifs2
+
+iflOverlap :: InFileSpan -> InFileLoc -> Bool
+iflOverlap ifs1 ifs2 =let
+        l11=iflLine $ ifsStart ifs1
+        l12=iflLine $ ifsEnd ifs1
+        c11=iflColumn $ ifsStart ifs1
+        c12=iflColumn $ ifsEnd ifs1
+        l21=iflLine ifs2
+        c21=iflColumn ifs2
+        in (l11<l21 || (l11==l21 && c11<=c21)) && (l12>l21 || (l12==l21 && c12>=c21))
+
 instance ToJSON InFileSpan  where
     toJSON  (InFileSpan (InFileLoc sr sc) (InFileLoc er ec))
         | sr==er = if ec==sc+1 
@@ -186,14 +217,32 @@         -> InFileSpan
 mkFileSpan sr sc er ec=InFileSpan (InFileLoc sr sc) (InFileLoc er ec)
 
+
+data NameDef = NameDef
+        { ndName  :: T.Text -- ^  name
+        , ndType  :: [OutlineDefType] -- ^ types: can have several to combine
+        , ndSignature  :: Maybe T.Text -- ^ type signature if any
+        }
+        deriving (Show,Read,Eq,Ord)
+
+instance ToJSON NameDef where
+        toJSON (NameDef n tps ts)=  object ["n" .= n , "t" .= map toJSON tps,"s" .= ts]
+     
+instance FromJSON NameDef where
+    parseJSON (Object v) =NameDef <$>
+                         v .: "n" <*>
+                         v .: "t" <*>
+                         v .:? "s"
+    parseJSON _= mzero    
+
 -- | element of the outline result
 data OutlineDef = OutlineDef
-  { od_name       :: T.Text -- ^  name
-  ,od_type       :: [OutlineDefType] -- ^ types: can have several to combine
-  ,od_loc        :: InFileSpan -- ^ span in source
-  ,od_children   :: [OutlineDef] -- ^ children (constructors...)
-  ,od_signature  :: Maybe T.Text -- ^ type signature if any
-  ,od_comment    :: Maybe T.Text -- ^ comment if any
+  { odName       :: T.Text -- ^  name
+  ,odType       :: [OutlineDefType] -- ^ types: can have several to combine
+  ,odLoc        :: InFileSpan -- ^ span in source
+  ,odChildren   :: [OutlineDef] -- ^ children (constructors...)
+  ,odSignature  :: Maybe T.Text -- ^ type signature if any
+  ,odComment    :: Maybe T.Text -- ^ comment if any
   }
   deriving (Show,Read,Eq,Ord)
      
@@ -221,14 +270,14 @@                          v .: "t" <*>
                          v .: "l" <*>
                          v .: "c" <*>
-                         v .: "s" <*>
-                         v .: "d"
+                         v .:? "s" <*>
+                         v .:? "d"
     parseJSON _= mzero          
      
 -- | Lexer token
 data TokenDef = TokenDef {
-        td_name :: T.Text -- ^ type of token
-        ,td_loc :: InFileSpan -- ^ location
+        tdName :: T.Text -- ^ type of token
+        ,tdLoc :: InFileSpan -- ^ location
     }
         deriving (Show,Eq)     
     
@@ -245,7 +294,7 @@ -- | Type of import/export directive    
 data ImportExportType = IEVar -- ^ Var
         | IEAbs  -- ^ Abs
-        | IEThingAll -- ^ import/export everythin
+        | IEThingAll -- ^ import/export everything
         | IEThingWith -- ^ specific import/export list
         | IEModule -- ^ reexport module
       deriving (Show,Read,Eq,Ord,Enum)
@@ -259,10 +308,10 @@     
 -- | definition of export
 data ExportDef = ExportDef {
-        e_name :: T.Text -- ^ name
-        ,e_type :: ImportExportType -- ^ type
-        ,e_loc  :: InFileSpan -- ^ location in source file
-        ,e_children :: [T.Text] -- ^ children (constructor names, etc.)
+        eName :: T.Text -- ^ name
+        ,eType :: ImportExportType -- ^ type
+        ,eLoc  :: InFileSpan -- ^ location in source file
+        ,eChildren :: [T.Text] -- ^ children (constructor names, etc.)
     }   deriving (Show,Eq)     
      
 instance ToJSON ExportDef where
@@ -278,10 +327,10 @@      
 -- | definition of an import element   
 data ImportSpecDef = ImportSpecDef {
-        is_name :: T.Text -- ^ name
-        ,is_type :: ImportExportType -- ^ type
-        ,is_loc  :: InFileSpan -- ^ location in source file
-        ,is_children :: [T.Text] -- ^ children (constructor names, etc.)
+        isName :: T.Text -- ^ name
+        ,isType :: ImportExportType -- ^ type
+        ,isLoc  :: InFileSpan -- ^ location in source file
+        ,isChildren :: [T.Text] -- ^ children (constructor names, etc.)
         }  deriving (Show,Eq)        
      
 instance ToJSON ImportSpecDef where
@@ -297,32 +346,34 @@      
 -- | definition of an import statement     
 data ImportDef = ImportDef {
-        i_module :: T.Text -- ^ module name
-        ,i_loc  :: InFileSpan -- ^ location in source file
-        ,i_qualified :: Bool -- ^ is the import qualified
-        ,i_hiding :: Bool -- ^ is the import element list for hiding or exposing 
-        ,i_alias :: T.Text -- ^ alias name
-        ,i_children :: Maybe [ImportSpecDef]  -- ^ specific import elements
+        iModule :: T.Text -- ^ module name
+        ,iPackage :: Maybe T.Text -- ^ package name
+        ,iLoc  :: InFileSpan -- ^ location in source file
+        ,iQualified :: Bool -- ^ is the import qualified
+        ,iHiding :: Bool -- ^ is the import element list for hiding or exposing 
+        ,iAlias :: T.Text -- ^ alias name
+        ,iChildren :: Maybe [ImportSpecDef]  -- ^ specific import elements
         }  deriving (Show,Eq)    
     
 instance ToJSON ImportDef where
-        toJSON (ImportDef m l q h a c)=  object ["m" .= m , "l" .= l, "q" .= q, "h" .= h, "a" .= a, "c" .=  c]
+        toJSON (ImportDef m p l q h a c)=  object ["m" .= m , "p" .= p, "l" .= l, "q" .= q, "h" .= h, "a" .= a, "c" .=  c]
      
 instance FromJSON ImportDef where
     parseJSON (Object v) =ImportDef <$>
                          v .: "m" <*>
+                         v .:? "p" <*>
                          v .: "l" <*>
                          v .: "q" <*>
                          v .: "h" <*>
                          v .: "a" <*>
-                         v .: "c"
+                         v .:? "c"
     parseJSON _= mzero     
 
 -- | complete result for outline    
 data OutlineResult = OutlineResult {
-        or_outline :: [OutlineDef] -- ^ outline contents
-        ,or_exports :: [ExportDef] -- ^ exports
-        ,or_imports :: [ImportDef] -- ^ imports
+        orOutline :: [OutlineDef] -- ^ outline contents
+        ,orExports :: [ExportDef] -- ^ exports
+        ,orImports :: [ImportDef] -- ^ imports
         }    
         deriving (Show,Eq)
         
@@ -338,9 +389,9 @@       
 -- | build flags for a specific file        
 data BuildFlags = BuildFlags {
-        bf_ast :: [String] -- ^ flags for GHC
-        ,bf_preproc :: [String] -- ^ flags for preprocessor
-        ,bf_modName :: Maybe String -- ^ module name if known
+        bfAst :: [String] -- ^ flags for GHC
+        ,bfPreproc :: [String] -- ^ flags for preprocessor
+        ,bfModName :: Maybe String -- ^ module name if known
         }  
         deriving (Show,Read,Eq,Data,Typeable)
         
@@ -351,7 +402,7 @@    parseJSON (Object v)=BuildFlags <$>
                          v .: "a" <*>
                          v .: "p" <*>
-                         v .: "m"
+                         v .:? "m"
    parseJSON _= mzero  
    
 data ThingAtPoint = ThingAtPoint {
@@ -370,11 +421,11 @@ instance FromJSON ThingAtPoint where
    parseJSON (Object v)=ThingAtPoint <$>
                          v .: "Name" <*>
-                         v .: "Module" <*>
-                         v .: "Type" <*>
-                         v .: "QType" <*>
-                         v .: "HType" <*>
-                         v .: "GType"
+                         v .:? "Module" <*>
+                         v .:? "Type" <*>
+                         v .:? "QType" <*>
+                         v .:? "HType" <*>
+                         v .:? "GType"
    parseJSON _= mzero         
    
 -- | get the full path for the temporary directory
@@ -424,24 +475,28 @@         -> BuildWrapper(Maybe FilePath) -- ^ return Just the file if copied, Nothing if no copy was done 
 copyFromMain force src=do
         fullSrc<-getFullSrc src
+        fullTgt<-getTargetPath src
         exSrc<-liftIO $ doesFileExist fullSrc
         if exSrc 
                 then do
-                        fullTgt<-getTargetPath src
-                        ex<-liftIO $ doesFileExist fullTgt
-                        shouldCopy<- if force || not ex
-                                then return True 
-                                else
-                                  do modSrc <- liftIO $ getModificationTime fullSrc
-                                     modTgt <- liftIO $ getModificationTime fullTgt
-                                     return (modSrc >= modTgt) -- if same date, we may thing precision is not good enough to be 100% sure tgt is newer, so we copy
-                        if shouldCopy
+                        moreRecent<-liftIO $ isSourceMoreRecent fullSrc fullTgt
+                        if force || moreRecent
                                 then do
                                         liftIO $ copyFile fullSrc fullTgt
                                         return $ Just src
                                 else return Nothing
-                 else return Nothing
+                else return Nothing
 
+isSourceMoreRecent :: FilePath -> FilePath -> IO Bool
+isSourceMoreRecent fullSrc fullTgt=do
+        ex<-doesFileExist fullTgt
+        if not ex 
+                then return True
+                else 
+                  do modSrc <- getModificationTime fullSrc
+                     modTgt <- getModificationTime fullTgt
+                     return (modSrc >= modTgt)
+
 -- | replace relative file path by module name      
 fileToModule :: FilePath -> String
 fileToModule fp=map rep (dropExtension fp)
@@ -456,15 +511,15 @@ -- | component in cabal file    
 data CabalComponent
   = CCLibrary
-        { cc_buildable :: Bool -- ^ is the library buildable
+        { ccBuildable :: Bool -- ^ is the library buildable
         } -- ^ library
   | CCExecutable
-        { cc_exe_name :: String -- ^ executable name
-        , cc_buildable :: Bool -- ^ is the executable buildable
+        { ccExeName :: String -- ^ executable name
+        , ccBuildable :: Bool -- ^ is the executable buildable
        }  -- ^ executable
   | CCTestSuite 
-        { cc_test_name :: String -- ^ test suite name
-        , cc_buildable :: Bool -- ^ is the test suite buildable
+        { ccTestName :: String -- ^ test suite name
+        , ccBuildable :: Bool -- ^ is the test suite buildable
         } -- ^ test suite
   deriving (Eq, Show)
 
@@ -481,13 +536,18 @@         | otherwise = mzero
     parseJSON _= mzero
 
+cabalComponentName :: CabalComponent -> String
+cabalComponentName CCLibrary{}=""
+cabalComponentName CCExecutable{ccExeName}=ccExeName
+cabalComponentName CCTestSuite{ccTestName}=ccTestName
+
 -- | a cabal package
 data CabalPackage=CabalPackage {
-        cp_name::String -- ^ name of package
-        ,cp_version::String -- ^ version
-        ,cp_exposed::Bool -- ^ is the package exposed or hidden
-        ,cp_dependent::[CabalComponent] -- ^ components in the cabal file that use this package
-        ,cp_modules::[String] -- ^ all modules. We keep all modules so that we can try to open non exposed but imported modules directly
+        cpName::String -- ^ name of package
+        ,cpVersion::String -- ^ version
+        ,cpExposed::Bool -- ^ is the package exposed or hidden
+        ,cpDependent::[CabalComponent] -- ^ components in the cabal file that use this package
+        ,cpModules::[String] -- ^ all modules. We keep all modules so that we can try to open non exposed but imported modules directly
         }
    deriving (Eq, Show)
 
@@ -503,18 +563,58 @@                          v .: "m"
     parseJSON _= mzero
 
+data LoadContents = SingleFile {
+                lmFile :: FilePath
+                ,lmModule :: String
+        } 
+        | MultipleFile {
+                lmFiles :: [(FilePath,String)]
+        }
+
+getLoadFiles :: LoadContents -> [(FilePath,String)]
+getLoadFiles SingleFile{lmFile=f,lmModule=m}=[(f,m)]
+getLoadFiles MultipleFile{lmFiles=fs}=fs
+
 -- |  http://book.realworldhaskell.org/read/io-case-study-a-library-for-searching-the-filesystem.html
 getRecursiveContents :: FilePath -> IO [FilePath]
 getRecursiveContents topdir = do
-  names <- getDirectoryContents topdir
-  let properNames = filter (not . isPrefixOf ".") names
-  paths <- forM properNames $ \name -> do
-    let path = topdir </> name
-    isDirectory <- doesDirectoryExist path
-    if isDirectory
-      then getRecursiveContents path
-      else return [path]
-  return (concat paths)         
+  ex<-doesDirectoryExist topdir
+  if ex 
+        then do
+          names <- getDirectoryContents topdir
+          let properNames = filter (not . isPrefixOf ".") names
+          paths <- forM properNames $ \name -> do
+            let path = topdir </> name
+            isDirectory <- doesDirectoryExist path
+            if isDirectory
+              then getRecursiveContents path
+              else return [path]
+          return (concat paths) 
+        else return []      
+
+-- | delete files in temp folder but not in real folder anymore
+deleteGhosts :: [FilePath] -> BuildWrapper [FilePath]
+deleteGhosts copied=do
+        root<-getFullSrc ""
+        temp<-getFullTempDir
+        fs<-liftIO $ getRecursiveContents temp
+        let copiedS=S.fromList copied
+        del<-liftIO $ mapM (deleteIfGhost root temp copiedS) fs
+        return $ catMaybes del
+        where
+                deleteIfGhost :: FilePath -> FilePath -> S.Set FilePath -> FilePath -> IO (Maybe FilePath)
+                deleteIfGhost rt tmp cs f=do
+                        let rel=makeRelative tmp f
+                        if "dist" `isPrefixOf` rel || S.member rel cs
+                                then return Nothing
+                                else do
+                                        let fullSrc=rt </> rel
+                                        ex<-doesFileExist fullSrc
+                                        if ex 
+                                                then return Nothing
+                                                else do
+                                                        removeFile (tmp </> f)
+                                                        return $ Just rel
   
 -- | debug method: fromJust with a message to display when we get Nothing 
 fromJustDebug :: String -> Maybe a -> a
@@ -533,4 +633,29 @@         then loop rest                       -- yes: drop it
         else head str : loop (tail str)      -- no: keep looking
     n = length base_dir_sep
-    base_dir_sep=base_dir ++ [pathSeparator] +    base_dir_sep=base_dir ++ [pathSeparator] 
+    
+-- | nub for Ord objects: use a set    
+nubOrd :: Ord a => [a] -> [a]
+nubOrd=S.toList . S.fromList
+
+-- | debug method to vaguely format JSON result to dump them
+formatJSON :: String -> String
+formatJSON s1=snd $ foldl f (0,"") s1
+        where 
+                f (i,s) '['=(i + 4, s ++ "\n" ++ map (const ' ') [0 .. i] ++ "[")
+                f (i,s) ']'  =(i - 4, s ++ "\n" ++ map (const ' ') [0 .. i] ++ "]")
+                f (i,s) c =(i,s++[c])
+   
+-- | Usage structure                
+data Usage = Usage {
+        usPackage::Maybe T.Text,
+        usModule::T.Text,
+        usName::T.Text,
+        usSection::T.Text,
+        usType::Bool,
+        usLoc::Value,
+        usDef::Bool
+        } 
+        deriving (Show,Eq)
+                

@@ -1,4 +1,4 @@-{-# LANGUAGE PatternGuards,ScopedTypeVariables #-}
+{-# LANGUAGE PatternGuards,ScopedTypeVariables,CPP #-}
 -- |
 -- Module      : Language.Haskell.BuildWrapper.Cabal
 -- Author      : JP Moresmau
@@ -29,13 +29,16 @@ import Distribution.ModuleName
 import Distribution.PackageDescription ( otherModules,library,executables,testSuites,Library,hsSourceDirs,libBuildInfo,Executable(..),exeName,modulePath,buildInfo,TestSuite(..),testName,TestSuiteInterface(..),testInterface,testBuildInfo,BuildInfo,cppOptions,defaultExtensions,otherExtensions,oldExtensions )
 import Distribution.Simple.GHC
+#if MIN_VERSION_Cabal(1,15,0)   
+import Distribution.Simple.Program.GHC
+#endif
 import Distribution.Simple.LocalBuildInfo
 import Distribution.Simple.Compiler(OptimisationLevel(..))
 import qualified Distribution.PackageDescription as PD 
 import Distribution.Package
 import Distribution.InstalledPackageInfo as IPI
 import Distribution.Version
-import Distribution.Text (display)
+import Distribution.Text (display,simpleParse)
 
                     
 import qualified Distribution.Simple.Configure as DSC
@@ -147,7 +150,7 @@                         setCurrentDirectory (takeDirectory cf)
                         (ex,_,err)<-readProcessWithExitCode cp args ""
                         putStrLn err
-                        let msgs=(parseCabalMessages (takeFileName cf) (takeFileName cp) err) -- ++ (parseCabalMessages (takeFileName cf) out)
+                        let msgs=parseCabalMessages (takeFileName cf) (takeFileName cp) err -- ++ (parseCabalMessages (takeFileName cf) out)
                         ret<-case ex of
                                 ExitSuccess  -> if any isBWNoteError msgs 
                                         then return (Nothing,msgs)
@@ -303,7 +306,7 @@                                        then (Just (jcn,l:msgs),ls)
                                        else (Nothing,ls++[makeNote jcn msgs])
                         --  | Just fp<-getBuiltPath l=(currentNote,ls,fp:fps)
-                        | Just n<-extractLocation l=(Just (n,[bwn_title n]),ls)
+                        | Just n<-extractLocation l=(Just (n,[bwnTitle n]),ls)
                         | Just (bw,n)<- cabalErrorLine cf cabalExe l=(Just (bw,n),addCurrent currentNote ls)
                         | otherwise =(Nothing,ls)
                 extractLocation el=let
@@ -337,8 +340,8 @@ makeNote bwn msgs=let
         title=dropWhile isSpace $ unlines $ reverse msgs
         in if "Warning:" `isPrefixOf` title
-                then bwn{bwn_title=dropWhile isSpace $ drop 8 title,bwn_status=BWWarning}    
-                else bwn{bwn_title=title}      
+                then bwn{bwnTitle=dropWhile isSpace $ drop 8 title,bwnStatus=BWWarning}    
+                else bwn{bwnTitle=title}      
 
 -- | get the path of a file getting compiled
 getBuiltPath :: String -- ^ the message line
@@ -355,7 +358,8 @@         ,cbiComponentBuildInfo :: ComponentLocalBuildInfo -- ^ the component local build info
         ,cbiBuildFolder::FilePath -- ^ the folder to build that component into
         ,cbiIsLibrary::Bool -- ^ is the component the library
-        ,cbiModulePaths::[(ModuleName,FilePath)]  -- ^ the module name and corresponding source file for each contained Haskell module
+        ,cbiModulePaths::[(Maybe ModuleName,FilePath)]  -- ^ the module name and corresponding source file for each contained Haskell module
+        ,cbiComponent::CabalComponent -- ^  the component handle
          } 
             
 -- | canonicalize the paths in the build info
@@ -366,7 +370,7 @@ 
 -- | apply a function on the build info modules and paths, in a monad
 onModulePathsM :: (Monad a) 
-        =>([(ModuleName,FilePath)] -> a [(ModuleName,FilePath)]) -- ^ the function to apply
+        =>([(Maybe ModuleName,FilePath)] -> a [(Maybe ModuleName,FilePath)]) -- ^ the function to apply
         -> CabalBuildInfo -- ^ the original build info
         -> a CabalBuildInfo  -- ^ the result
 onModulePathsM f cbi=do
@@ -375,7 +379,7 @@         return cbi{cbiModulePaths=fls}         
 
 -- | apply a function on the build info modules and paths
-onModulePaths :: ([(ModuleName,FilePath)] -> [(ModuleName,FilePath)]) -- ^ the function to apply
+onModulePaths :: ([(Maybe ModuleName,FilePath)] -> [(Maybe ModuleName,FilePath)]) -- ^ the function to apply
         -> CabalBuildInfo -- ^ the original build info
         -> CabalBuildInfo   -- ^ the result
 onModulePaths f =runIdentity . onModulePathsM (return . f)
@@ -406,19 +410,26 @@  
 -- | get GHC options for a file            
 fileGhcOptions :: (LocalBuildInfo,CabalBuildInfo) -- ^ the cabal info
-        -> BuildWrapper(ModuleName,[String]) -- ^ the module name and the options to pass GHC
-fileGhcOptions (lbi,CabalBuildInfo bi clbi fp isLib ls)=do
+        -> BuildWrapper [String] -- ^ the module name and the options to pass GHC
+fileGhcOptions (lbi,CabalBuildInfo bi clbi fp isLib _ _)=do
         dist_dir<-getDistDir
         let inplace=dist_dir </> "package.conf.inplace"
         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 
+#else
+        let opts=ghcOptions
+#endif        
         let pkg
                   | isLib =
                     ["-package-name", display $ packageId $ localPkgDescr lbi]
                   | inplaceExist = ["-package-conf", inplace]
                   | otherwise = []
-        return (fst $ head ls,pkg ++ ghcOptions (lbi{withOptimization=NoOptimisation}) bi clbi fp)
-
+        return (pkg ++ opts (lbi{withOptimization=NoOptimisation}) bi clbi fp)
+ 
 
+                
 -- | get CPP options for a file
 fileCppOptions :: CabalBuildInfo -- ^ the cabal info
         -> [String] -- ^ the list of CPP options
@@ -427,7 +438,7 @@ -- | get the cabal extensions
 cabalExtensions :: CabalBuildInfo -- ^ the cabal info
         -> (ModuleName,[String]) -- ^ the module name and cabal extensions
-cabalExtensions CabalBuildInfo{cbiBuildInfo=bi,cbiModulePaths=ls}=(fst $ head ls,map show (otherExtensions bi ++ defaultExtensions bi ++ oldExtensions bi))      
+cabalExtensions CabalBuildInfo{cbiBuildInfo=bi,cbiModulePaths=ls}=(fromJust $ fst $ head ls,map show (otherExtensions bi ++ defaultExtensions bi ++ oldExtensions bi))      
        
 -- | get the source directory from a build info
 getSourceDirs :: BuildInfo -- ^ the build info
@@ -446,43 +457,48 @@                 let libs=maybe [] extractFromLib $ library pd
                 let exes=map extractFromExe $ executables pd
                 let tests=map extractFromTest $ testSuites pd
-                mapM (\(a,b,c,isLib,d)->do
+                cbis<-mapM (\(a,b,c,isLib,d,cc)->do
                         mf<-copyAll d
-                        return (CabalBuildInfo a b c isLib mf)) (libs ++ exes ++ tests)
+                        return (CabalBuildInfo a b c isLib mf cc)) (libs ++ exes ++ tests)
+                cbis2<-getReferencedFiles lbi
+                return $ zipWith (\c1@CabalBuildInfo{cbiModulePaths=cb1} CabalBuildInfo{cbiModulePaths=cb2}->c1{cbiModulePaths=nubOrd $ cb1++cb2}) cbis cbis2
+                -- return cbis
         where 
-        extractFromLib :: Library -> [(BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath])]
+        extractFromLib :: Library -> [(BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath],CabalComponent)]
         extractFromLib l=let
                 lib=libBuildInfo l
-                in [(lib, fromJustDebug "extractFromLibAll" $ libraryConfig lbi,buildDir lbi, True, getSourceDirs lib)]
-        extractFromExe :: Executable -> (BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath])
+                in [(lib, fromJustDebug "extractFromLibAll" $ libraryConfig lbi,buildDir lbi, True, getSourceDirs lib,cabalComponentFromLibrary l)]
+        extractFromExe :: Executable -> (BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath],CabalComponent)
         extractFromExe e@Executable{exeName=exeName'}=let
                 ebi=buildInfo e
                 targetDir = buildDir lbi </> exeName'
                 exeDir    = targetDir </> (exeName' ++ "-tmp")
                 hsd=getSourceDirs ebi
-                in (ebi,fromJustDebug "extractFromExeAll" $ lookup exeName' $ executableConfigs lbi,exeDir,False, hsd) 
-        extractFromTest :: TestSuite -> (BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath])
+                in (ebi,fromJustDebug "extractFromExeAll" $ lookup exeName' $ executableConfigs lbi,exeDir,False, hsd,cabalComponentFromExecutable e) 
+        extractFromTest :: TestSuite -> (BuildInfo,ComponentLocalBuildInfo,FilePath,Bool,[FilePath],CabalComponent)
         extractFromTest t@TestSuite {testName=testName'} =let
                 tbi=testBuildInfo t
                 targetDir = buildDir lbi </> testName'
                 testDir    = targetDir </> (testName' ++ "-tmp")
                 hsd=getSourceDirs tbi
-                in (tbi,fromJustDebug "extractFromTestAll" $ lookup testName' $ testSuiteConfigs lbi,testDir,False,hsd)
-        copyAll :: [FilePath] -> BuildWrapper [(ModuleName,FilePath)]
+                in (tbi,fromJustDebug "extractFromTestAll" $ lookup testName' $ testSuiteConfigs lbi,testDir,False,hsd,cabalComponentFromTestSuite t)
+        copyAll :: [FilePath] -> BuildWrapper [(Maybe ModuleName,FilePath)]
         copyAll fps= do 
                   allF<-mapM copyAll' fps
                   return $ concat allF
-        copyAll' :: FilePath -> BuildWrapper [(ModuleName,FilePath)]
+        copyAll' :: FilePath -> BuildWrapper [(Maybe ModuleName,FilePath)]
         copyAll' fp=do
                 cf<-gets cabalFile
                 let dir=takeDirectory cf
                 fullFP<-getFullSrc fp
                 allF<-liftIO $ getRecursiveContents fullFP
                 tf<-gets tempFolder
+                let cabalDist=takeDirectory tf </> "dist"
                 -- exclude every file containing the temp folder name (".buildwrapper" by default)
                 -- which may happen if . is a source path
-                let notMyself=filter (not . isInfixOf tf) allF
-                return $ map (\f->(fromString $ fileToModule $ makeRelative fullFP f,makeRelative dir f)) notMyself
+                let notMyself=filter (not . isInfixOf cabalDist) $ filter (not . isInfixOf tf) allF
+                return $ map (\f->(simpleParse $ fileToModule $ makeRelative fullFP f,makeRelative dir f)) notMyself
+                -- return $ map (\(x,y)->(fromJust x,y)) $ filter (isJust . fst) $ map (\f->(simpleParse $ fileToModule $ makeRelative fullFP f,makeRelative dir f)) notMyself
  
 -- | get all components, referencing only the files explicitely indicated in the cabal file
 getReferencedFiles :: LocalBuildInfo -> BuildWrapper [CabalBuildInfo]
@@ -491,14 +507,19 @@                 let libs=maybe [] extractFromLib $ library pd
                 let exes=map extractFromExe $ executables pd
                 let tests=map extractFromTest $ testSuites pd
-                return (libs ++ exes ++ tests)
+                let cbis=libs ++ exes ++ tests
+                mapM (\c1@CabalBuildInfo{cbiModulePaths=cb1}->do
+                        cb2<-filterM (\(_,f)->do
+                                fs<-getFullSrc f
+                                liftIO $ doesFileExist fs) cb1
+                        return c1{cbiModulePaths=cb2}) cbis
         where 
         extractFromLib :: Library -> [CabalBuildInfo]
         extractFromLib l=let
                 lib=libBuildInfo l
                 modules=PD.exposedModules l ++ otherModules lib
                 in [CabalBuildInfo lib (fromJustDebug "extractFromLibRef" $ libraryConfig lbi)
-                        (buildDir lbi) True (copyModules modules (getSourceDirs lib))]
+                        (buildDir lbi) True (copyModules modules (getSourceDirs lib)) (cabalComponentFromLibrary l)]
         extractFromExe :: Executable ->CabalBuildInfo
         extractFromExe e@Executable{exeName=exeName'}=let
                 ebi=buildInfo e
@@ -506,7 +527,7 @@                 exeDir    = targetDir </> (exeName' ++ "-tmp")
                 modules= (otherModules ebi)
                 hsd=getSourceDirs ebi
-                in CabalBuildInfo ebi (fromJustDebug "extractFromExeRef" $ lookup exeName' $ executableConfigs lbi) exeDir False (copyMain (modulePath e) hsd ++ copyModules modules hsd ) 
+                in CabalBuildInfo ebi (fromJustDebug "extractFromExeRef" $ lookup exeName' $ executableConfigs lbi) exeDir False (copyMain (modulePath e) hsd ++ copyModules modules hsd) (cabalComponentFromExecutable e) 
         extractFromTest :: TestSuite -> CabalBuildInfo
         extractFromTest t@TestSuite {testName=testName'} =let
                 tbi=testBuildInfo t
@@ -518,13 +539,19 @@                     (TestSuiteExeV10 _ mp) -> copyMain mp hsd
                     (TestSuiteLibV09 _ mn) -> copyModules [mn] hsd
                     _ -> []
-                in CabalBuildInfo tbi (fromJustDebug ("extractFromTestRef:"++testName' ++ show (testSuiteConfigs lbi)) $ lookup testName' $ testSuiteConfigs lbi) testDir False (extras ++ copyModules modules hsd)
-        copyModules :: [ModuleName] -> [FilePath] -> [(ModuleName,FilePath)]
+                in CabalBuildInfo tbi (fromJustDebug ("extractFromTestRef:"++testName' ++ show (testSuiteConfigs lbi)) $ lookup testName' $ testSuiteConfigs lbi) testDir False (extras ++ copyModules modules hsd) (cabalComponentFromTestSuite t)
+        copyModules :: [ModuleName] -> [FilePath] -> [(Maybe ModuleName,FilePath)]
         copyModules mods=copyFiles (concatMap (\m->[toFilePath m <.> "hs", toFilePath m <.> "lhs"]) mods)
-        copyFiles :: [FilePath] -> [FilePath] -> [(ModuleName,FilePath)]
-        copyFiles mods dirs=[(fromString $ fileToModule m,d </> m)  | m<-mods, d<-dirs]    
-        copyMain :: FilePath  ->[FilePath] ->  [(ModuleName,FilePath)]
-        copyMain fs = map (\ d -> (fromString "Main", d </> fs)) 
+        copyFiles :: [FilePath] -> [FilePath] -> [(Maybe ModuleName,FilePath)]
+        copyFiles mods dirs=let
+                rmods=filter (isJust . snd ) $ map (\x->(x,simpleParse $ fileToModule x)) mods
+                in [(Just modu,d </> m)  | (m,Just modu)<-rmods, d<-dirs]    
+        copyMain :: FilePath  ->[FilePath] ->  [(Maybe ModuleName,FilePath)]
+        copyMain fs = map (\ d -> (Just $ fromString "Main", d </> fs)) 
+       
+       
+stringToModuleName :: String -> Maybe ModuleName
+stringToModuleName=simpleParse       
         
 -- | convert a ModuleName to a String        
 moduleToString :: ModuleName -> String
@@ -584,12 +611,19 @@ -- | get all components from the package description        
 cabalComponentsFromDescription :: PD.PackageDescription -- ^ the package description
         -> [CabalComponent]
-cabalComponentsFromDescription pd= [CCLibrary
-           (PD.buildable $ PD.libBuildInfo $ fromJust (PD.library pd))
+cabalComponentsFromDescription pd= [cabalComponentFromLibrary $ fromJust (PD.library pd)
          | isJust (PD.library pd)] ++
-              [ CCExecutable (PD.exeName e) (PD.buildable $ PD.buildInfo e)
-              | e <- PD.executables pd ]
-               ++ [ CCTestSuite (PD.testName e) (PD.buildable $ PD.testBuildInfo e)
-                | e <- PD.testSuites pd ]
+              map cabalComponentFromExecutable (PD.executables pd) ++
+                map cabalComponentFromTestSuite (PD.testSuites pd)
+             
+
+cabalComponentFromLibrary :: Library -> CabalComponent
+cabalComponentFromLibrary =CCLibrary . PD.buildable . PD.libBuildInfo
+
+cabalComponentFromExecutable :: Executable -> CabalComponent
+cabalComponentFromExecutable e =CCExecutable (PD.exeName e) (PD.buildable $ PD.buildInfo e)
+
+cabalComponentFromTestSuite :: TestSuite -> CabalComponent
+cabalComponentFromTestSuite ts=CCTestSuite (PD.testName ts) (PD.buildable $ PD.testBuildInfo ts)
 
 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP, OverloadedStrings, TypeSynonymInstances,StandaloneDeriving,DeriveDataTypeable,ScopedTypeVariables, MultiParamTypeClasses, PatternGuards  #-}
+{-# LANGUAGE CPP, OverloadedStrings, TypeSynonymInstances,StandaloneDeriving,DeriveDataTypeable,ScopedTypeVariables, MultiParamTypeClasses, PatternGuards, NamedFieldPuns  #-}
 {-# OPTIONS_GHC -fno-warn-orphans #-}
 -- |
 -- Module      : Language.Haskell.BuildWrapper.GHC
@@ -12,7 +12,7 @@ -- 
 -- Load relevant module in the GHC AST and get GHC messages and thing at point info. Also use the GHC lexer for syntax highlighting.
 module Language.Haskell.BuildWrapper.GHC where
-import Language.Haskell.BuildWrapper.Base hiding (Target)
+import Language.Haskell.BuildWrapper.Base hiding (Target,ImportExportType(..))
 import Language.Haskell.BuildWrapper.GHCStorage
 
 import Data.Char
@@ -25,12 +25,13 @@ import qualified Data.List as List
 import Data.Ord (comparing)
 import qualified Data.Text as T
+import qualified Data.Map as DM
 
 import DynFlags
 import ErrUtils ( ErrMsg(..), WarnMsg, mkPlainErrMsg,Messages,ErrorMessages,WarningMessages, Message )
 import GHC
 import GHC.Paths ( libdir )
-import HscTypes ( srcErrorMessages, SourceError)
+import HscTypes ( srcErrorMessages, SourceError, GhcApiError)
 import Outputable
 import FastString (FastString,unpackFS,concatFS,fsLit,mkFastString)
 import Lexer hiding (loc)
@@ -47,8 +48,11 @@ import System.FilePath
 
 import qualified MonadUtils as GMU
-import Control.Monad.IO.Class (liftIO)
+import Name (isTyVarName,isDataConName,isVarName,isTyConName)
+import Var (varType)
+import PprTyThing (pprTypeForUser)
 
+type GHCApplyFunction a=FilePath -> TypecheckedModule -> Ghc a
 
 -- | get the GHC typechecked AST
 getAST :: FilePath -- ^ the source file
@@ -56,19 +60,20 @@         ->  String -- ^ the module name 
         -> [String] -- ^ the GHC options 
         -> IO (OpResult (Maybe TypecheckedSource))
-getAST =withASTNotes (return . tm_typechecked_source
-        )
+getAST fp base_dir modul opts=do
+        (a,n)<-withASTNotes (\_ -> return . tm_typechecked_source) id base_dir (SingleFile fp modul) opts
+        return (listToMaybe a,n) 
 
 -- | perform an action on the GHC Typechecked module
 withAST ::  (TypecheckedModule -> Ghc a) -- ^ the action
         -> FilePath -- ^ the source file
         -> FilePath -- ^ the base directory
-        ->  String -- ^ the module name 
+        ->  String -- ^ the module name
         -> [String] -- ^ the GHC options
         -> IO (Maybe a)
 withAST f fp base_dir modul options= do
-        (a,_)<-withASTNotes f fp base_dir modul options
-        return a
+        (a,_)<-withASTNotes (\_ ->f) id base_dir (SingleFile fp modul) options
+        return $ listToMaybe a
 
 -- | perform an action on the GHC JSON AST
 withJSONAST :: (Value -> IO a) -- ^ the action
@@ -82,21 +87,21 @@         case mv of 
                 Just v-> fmap Just (f v) 
                 Nothing->do
-                        (mTc,_)<-getAST fp base_dir modul options
+                        mTc<-withAST return fp base_dir modul options
                         case mTc of
-                                Just tc->fmap Just (f (dataToJSON tc)) 
+                                Just tc->fmap Just (f (generateGHCInfo tc)) 
                                 Nothing -> return Nothing
 
 -- | the main method loading the source contents into GHC
-withASTNotes ::  (TypecheckedModule -> Ghc a) -- ^ the final action to perform on the result
-         -> FilePath -- ^ the source file
+withASTNotes ::  GHCApplyFunction a -- ^ the final action to perform on the result
+        -> (FilePath -> FilePath) -- ^ transform given file path to find bwinfo path
         -> FilePath -- ^ the base directory
-        ->  String -- ^ the module name 
+        ->  LoadContents -- ^ what to load
         -> [String] -- ^ the GHC options 
-        -> IO (OpResult (Maybe a))
-withASTNotes f fp base_dir modul options=do
+        -> IO (OpResult [a])
+withASTNotes f ff base_dir contents options=do
     let lflags=map noLoc options
-    --print options
+    -- print options
     (_leftovers, _) <- parseStaticFlags lflags
     runGhc (Just libdir) $ do
         flg <- getSessionDynFlags
@@ -108,53 +113,56 @@                 -- so we can't use hscTarget = HscNothing
                 -- 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
-                setSessionDynFlags flg'  {hscTarget = HscNothing,  ghcLink = NoLink , ghcMode = CompManager, log_action = logAction ref }
+                setSessionDynFlags flg'  {hscTarget = HscNothing, ghcLink = NoLink , ghcMode = CompManager, log_action = logAction ref }
                 --  $ dopt_set (flg' { ghcLink = NoLink , ghcMode = CompManager }) Opt_ForceRecomp
-                addTarget Target { targetId = TargetFile fp Nothing, targetAllowObjCode = True, targetContents = Nothing }
+                let fps=getLoadFiles contents
+                mapM_ (\(fp,_)-> addTarget Target { targetId = TargetFile fp Nothing, targetAllowObjCode = True, targetContents = Nothing }) fps
                 --c1<-GMU.liftIO getClockTime
-                let modName=mkModuleName modul
-                -- loadWithLogger (logWarnErr ref)
-                res<- load (LoadUpTo modName) -- LoadAllTargets
+                let howMuch=case contents of
+                        SingleFile{lmModule=m}->LoadUpTo $ mkModuleName m
+                        MultipleFile{}->LoadAllTargets
+                -- GMU.liftIO $ putStrLn "Loading..."
+                load howMuch
                            `gcatch` (\(e :: SourceError) -> handle_error ref e)
+                -- GMU.liftIO $ putStrLn "Loaded..."           
                 --(warns, errs) <- GMU.liftIO $ readIORef ref
                 --let notes = ghcMessagesToNotes base_dir (warns, errs)
                 notes <- GMU.liftIO $ readIORef ref
                 --c2<-GMU.liftIO getClockTime
                 --GMU.liftIO $ putStrLn ("load all targets: " ++ (timeDiffToString  $ diffClockTimes c2 c1))
-                case res of 
-                        Succeeded -> do
-                                modSum <- getModSummary modName
-                                p <- parseModule modSum
-                                --return $ showSDocDump $ ppr $ pm_mod_summary p
-                                t <- typecheckModule p
-                                d <- desugarModule t -- to get warnings
-                                l <- loadModule d
-                                --c3<-GMU.liftIO getClockTime
-#if __GLASGOW_HASKELL__ < 704
-                                setContext [ms_mod modSum] []
-#else
-                                setContext [IIModule $ ms_mod modSum]
-#endif                                
-                                GMU.liftIO $ storeGHCInfo fp (typecheckedSource $ dm_typechecked_module l)
-                                --GMU.liftIO $ putStrLn ("parse, typecheck load: " ++ (timeDiffToString  $ diffClockTimes c3 c2))
-                                a<-f (dm_typechecked_module l)
+                -- GMU.liftIO $ print fps
+                a<-fmap catMaybes $ mapM (\(fp,m)->(do
+                                --mg<-getModuleGraph
+                                modSum <- getModSummary $ mkModuleName m
+                                fmap Just $ workOnResult f fp modSum)
+                               `gcatch` (\(_ :: SourceError) -> return Nothing)
+                               `gcatch` (\(_ :: GhcApiError) -> return Nothing)
+                        ) fps
 #if __GLASGOW_HASKELL__ < 702                           
-                                warns <- getWarnings
-                                return (Just a,List.nub $ notes ++ reverse (ghcMessagesToNotes base_dir (warns, emptyBag)))
+                warns <- getWarnings
+                return (a,List.nub $ notes ++ reverse (ghcMessagesToNotes base_dir (warns, emptyBag)))
 #else
-                                notes2 <- GMU.liftIO $ readIORef ref
-                                return $ (Just a,List.nub $ notes2)
+                notes2 <- GMU.liftIO $ readIORef ref
+                return $ (a,List.nub $ notes2)
 #endif
-                        Failed -> return (Nothing, notes)
         where
---            logWarnErr :: GhcMonad m => IORef [BWNote] -> Maybe SourceError -> m ()
---            logWarnErr ref err = do
---              let errs = case err of
---                           Nothing -> mempty
---                           Just exc -> srcErrorMessages exc
---              warns <- getWarnings
---              clearWarnings
---              add_warn_err ref warns errs
+            workOnResult :: GHCApplyFunction a -> FilePath -> ModSummary -> Ghc a
+            workOnResult f2 fp modSum= do
+                p <- parseModule modSum
+                t <- typecheckModule p
+                d <- desugarModule t -- to get warnings
+                l <- loadModule d
+                --c3<-GMU.liftIO getClockTime
+#if __GLASGOW_HASKELL__ < 704
+                setContext [ms_mod modSum] []
+#else
+                setContext [IIModule $ ms_mod modSum]
+#endif                         
+                let fullfp=ff fp
+                -- GMU.liftIO $ putStrLn ("writing " ++ fullfp)
+                GMU.liftIO $ storeGHCInfo 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
@@ -166,17 +174,14 @@             handle_error ref e = do
                let errs = srcErrorMessages e
                add_warn_err ref emptyBag errs
---               warns <- getWarnings
---               add_warn_err ref warns errs
---               clearWarnings
                return Failed
                
             logAction :: IORef [BWNote] -> Severity -> SrcSpan -> PprStyle -> Message -> IO ()
             logAction ref s loc style msg
                 | (Just status)<-bwSeverity s=do
-                        let n=BWNote { bwn_location = ghcSpanToBWLocation base_dir loc
-                                 , bwn_status = status
-                                 , bwn_title = removeBaseDir base_dir $ removeStatus status $ showSDocForUser (qualName style,qualModule style) msg
+                        let n=BWNote { bwnLocation = ghcSpanToBWLocation base_dir loc
+                                 , bwnStatus = status
+                                 , bwnTitle = removeBaseDir base_dir $ removeStatus status $ showSDocForUser (qualName style,qualModule style) msg
                                  }
                         modifyIORef ref $  \ ns -> ns ++ [n]
                 | otherwise=return ()
@@ -216,6 +221,44 @@                 return $ map (showSDocDump . ppr ) names)  f base_dir modul options
         return $ fromMaybe[] names
 
+   
+-- | get all names in scope, packaged in NameDefs
+getGhcNameDefsInScope  :: FilePath -- ^ source path
+        -> FilePath -- ^ base directory
+        -> String -- ^ module name
+        -> [String] -- ^ build options
+        -> IO (OpResult (Maybe [NameDef]))
+getGhcNameDefsInScope fp base_dir modul options=do
+        (nns,ns)<-withASTNotes (\_ _->do
+                --c1<-GMU.liftIO getClockTime
+                -- GMU.liftIO $ putStrLn "getGhcNameDefsInScope"
+                names<-getNamesInScope
+                --c2<-GMU.liftIO getClockTime
+                --GMU.liftIO $ putStrLn ("getNamesInScope: " ++ (timeDiffToString  $ diffClockTimes c2 c1))
+                mapM name2nd names) id base_dir (SingleFile fp modul) options
+        return $ case nns of
+                (x:_)->(Just x,ns)
+                _->(Nothing, ns)
+                
+        where name2nd :: GhcMonad m=> Name -> m NameDef
+              name2nd n=do
+                m<- getInfo n
+                let ty=case m of
+                        Just (tyt,_,_)->ty2t tyt
+                        Nothing->Nothing
+                return $ NameDef (T.pack $ showSDocDump $ ppr n) (name2t n) ty
+              name2t :: Name -> [OutlineDefType]
+              name2t n 
+                        | isTyVarName n=[Type]
+                        | isTyConName n=[Type]
+                        | 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
+
 -- | get the "thing" at a particular point (line/column) in the source
 -- this is using the saved JSON info if available
 getThingAtPointJSON :: Int -- ^ line
@@ -231,7 +274,6 @@         mmf<-withJSONAST (\v->do
                 let f=overlap line (scionColToGhcCol col)
                 let mf=findInJSON f v
-                --return $ findInJSONFormatted qual typed mf
                 return $ findInJSONData mf  
             ) fp base_dir modul options
         return $ fromMaybe Nothing mmf
@@ -413,7 +455,7 @@      result<-  ghctokensArbitrary projectRoot ppC options
      case result of 
        Right toks ->do
-         let filterResult = filterFunc $ List.sortBy (comparing td_loc) (ppTs ++ xform toks)
+         let filterResult = filterFunc $ List.sortBy (comparing tdLoc) (ppTs ++ xform toks)
          return $ Right filterResult
        Left n -> return $ Left n
                
@@ -473,9 +515,9 @@ -- in the source.
 ghcMsgToNote :: BWNoteStatus -> FilePath -> ErrMsg -> BWNote
 ghcMsgToNote note_kind base_dir msg =
-    BWNote { bwn_location = ghcSpanToBWLocation base_dir loc
-         , bwn_status = note_kind
-         , bwn_title = removeBaseDir base_dir $ removeStatus note_kind $ show_msg (errMsgShortDoc msg)
+    BWNote { bwnLocation = ghcSpanToBWLocation base_dir loc
+         , bwnStatus = note_kind
+         , bwnTitle = removeBaseDir base_dir $ removeStatus note_kind $ show_msg (errMsgShortDoc msg)
          }
   where
     loc | (s:_) <- errMsgSpans msg = s
@@ -754,5 +796,84 @@ end (RealSrcSpan ss)= (srcSpanEndLine ss, srcSpanEndCol ss)   
 end (UnhelpfulSpan _)=error "UnhelpfulSpan in cmpOverlap start"   
 #endif
+       
+type AliasMap=DM.Map ModuleName [ModuleName]
+
+
+ghcImportToUsage :: T.Text -> LImportDecl Name ->  ([Usage],AliasMap) -> Ghc ([Usage],AliasMap)
+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
+            nomain=if tpkg=="main" then myPkg else tpkg
+            subs=concatMap (ghcLIEToUsage (Just nomain) tmod "import") $ maybe [] snd $ ideclHiding imp
+            moduMap2=maybe moduMap (\alias->let
+                mlmods=DM.lookup alias moduMap
+                newlmods=case mlmods of
+                        Just lmods->modu:lmods
+                        Nothing->[modu]
+                in DM.insert alias newlmods moduMap) $ ideclAs imp
+            usg =Usage (Just nomain) tmod "" "import" False (toJSON $ ghcSpanToLocation src) False
+        return (usg:subs++ls,moduMap2)
+        )
+        `gcatch` (\(se :: SourceError) -> do
+                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 _ _ _ _=[]
         
+ghcExportToUsage :: T.Text -> T.Text ->AliasMap -> LIE Name -> Ghc [Usage]        
+ghcExportToUsage 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
+                                return (tpkg,tmod)
+                                ) realModus
+                _ -> return [(myPkg,myMod)]
+        return $ concatMap (\(tpkg,tmod)->ghcLIEToUsage (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
+        
+--getGHCOutline :: ParsedSource
+--        -> [OutlineDef]
+--getGHCOutline (L src mod)=concatMap ldeclOutline (hsmodDecls mod)
+--        where 
+--                ldeclOutline :: LHsDecl RdrName -> [OutlineDef]
+--                ldeclOutline  (L src1 (TyClD decl))=ltypeOutline decl
+--                ldeclOutline _ = []
+--                ltypeOutline :: TyClDecl RdrName -> [OutlineDef]
+--                ltypeOutline (TyFamily{tcdLName})=[mkOutlineDef (nameDecl $ unLoc tcdLName) [Type,Family] (ghcSpanToLocation $ getLoc tcdLName)]
+--                ltypeOutline (TyData{tcdLName,tcdCons})=[mkOutlineDef (nameDecl $ unLoc tcdLName) [Data] (ghcSpanToLocation $ getLoc tcdLName)]
+--                        ++ concatMap lconOutline tcdCons
+--                lconOutline :: LConDecl RdrName -> [OutlineDef]
+--                lconOutline (L src ConDecl{con_name,con_doc,con_details})=[(mkOutlineDef (nameDecl $ unLoc con_name) [Constructor] (ghcSpanToLocation $ getLoc con_name)){od_comment=commentDecl con_doc}]
+--                        ++ detailOutline con_details
+--                detailOutline (RecCon fields)=concatMap lfieldOutline fields
+--                detailOutline _=[]
+--                lfieldOutline (ConDeclField{cd_fld_name,cd_fld_doc})=[(mkOutlineDef (nameDecl $ unLoc cd_fld_name) [Function] (ghcSpanToLocation $ getLoc cd_fld_name)){od_comment=commentDecl cd_fld_doc}]
+--                nameDecl:: RdrName -> T.Text
+--                nameDecl (Unqual occ)=T.pack $ showSDoc $ ppr occ
+--                nameDecl (Qual _ occ)=T.pack $ showSDoc $ ppr occ
+--                commentDecl :: Maybe LHsDocString -> Maybe T.Text
+--                commentDecl (Just st)=Just $ T.pack $ showSDoc $ ppr st
+--                commentDecl _=Nothing
+                -- ghcSpanToLocation
+                 
+                

@@ -22,7 +22,6 @@ import PprTyThing
 import GHC
 import Outputable
-import qualified OccName(occNameString)
 import Bag(Bag,bagToList)
 import Var(Var,varType,varName)
 import FastString(FastString)
@@ -52,9 +51,14 @@ import Data.Maybe
 import qualified Data.Text as T
 import qualified Data.HashMap.Lazy as HM
+import qualified Data.Map as DM
 import qualified Data.Vector as V
 import Data.Attoparsec.Number (Number(I))
 import System.Time (ClockTime)
+import Type (splitFunTys)
+import Unique (getUnique)
+import Data.List (sortBy)
+-- import GHC.SYB.Utils (Stage(..), showData)
 
 
 -- | get the file storing the information for the given source file
@@ -64,6 +68,13 @@         (dir,file)=splitFileName fp
         in combine dir ('.' : addExtension file ".bwinfo")
 
+-- | get the file storing the information for the given source file
+getUsageFile :: FilePath -- ^ the source file
+        -> FilePath
+getUsageFile fp= let 
+        (dir,file)=splitFileName fp
+        in combine dir ('.' : addExtension file ".bwusage")
+
 -- | remove the storage file
 clearInfo :: FilePath -- ^ the source file
         -> IO()
@@ -77,12 +88,70 @@         -> IO()
 storeBuildFlagsInfo fp bf=setStoredInfo fp "BuildFlags"  (toJSON bf)
 
+-- | 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
+        -- extract usages from typechecked source
+        tcvals=extractUsages $ dataToJSON $ 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
+        -- add type information on objects
+        typedVals=map (addType tcByNameLoc) rnvals
+        in (Array $ V.fromList typedVals)
+        where 
+                buildMap v@(Object m) dm | 
+                        Just pos<-HM.lookup "Pos" m,
+                        Success ifs <- fromJSON pos,
+                        Just (String s)<-HM.lookup "Name" m,
+                        Just (String mo)<-HM.lookup "Module" m,
+                        Just _<-HM.lookup "QType" m,
+                        Just _<-HM.lookup "Type" m,
+                        Just "v"<-HM.lookup "HType" m,
+                        Just _<-HM.lookup "GType" m=
+                                DM.insert (mo,s,iflLine $ ifsStart ifs,0) v $ -- add column 0 for some cases where the spans are funny 
+                                DM.insert (mo,s,iflLine $ ifsStart ifs,iflColumn $ ifsStart ifs) v dm
+                buildMap _ dm=dm
+                addType dm v@(Object m1) |
+                        Just pos<-HM.lookup "Pos" m1,
+                        Success ifs <- fromJSON pos,
+                        Just (String s)<-HM.lookup "Name" m1,
+                        Just (String mo)<-HM.lookup "Module" m1,
+                        Just "v"<-HM.lookup "HType" m1=let
+                                mv=DM.lookup (mo,s,iflLine $ ifsStart ifs,iflColumn $ ifsStart ifs) dm
+                                mv2=case mv of
+                                        Nothing -> DM.lookup (mo,s,iflLine $ ifsStart ifs,0) dm
+                                        a->a
+                                in case mv2 of
+                                        Just (Object m2) |
+                                                 Just qt<-HM.lookup "QType" m2,
+                                                 Just t<-HM.lookup "Type" m2,
+                                                 Just gt<-HM.lookup "GType" m2 -> Object (HM.insert "QType" qt $
+                                                        HM.insert "Type" t $
+                                                        HM.insert "GType" gt
+                                                        m1) 
+                                        _ -> v
+                addType _ v=v
+
 -- | store the GHC generated AST
 storeGHCInfo :: FilePath -- ^ the source file
-        -> TypecheckedSource -- ^ the GHC AST
+        -> TypecheckedModule -- ^ the GHC AST
         -> IO()
-storeGHCInfo fp tcs=setStoredInfo fp "AST"  (dataToJSON tcs)
-
+storeGHCInfo fp tcm= -- do
+--        putStrLn $ showData TypeChecker 4 $ typecheckedSource tcm
+--        putStrLn "Typechecked"
+--        BSC.putStrLn $ encode $ dataToJSON $ typecheckedSource tcm
+--        putStrLn "Renamed"
+--        BSC.putStrLn $ encode $ dataToJSON $ tm_renamed_source tcm
+--        let tcvals=extractUsages $ dataToJSON $ typecheckedSource tcm
+--        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
+        
+                
 -- | read the GHC AST as a JSON value
 readGHCInfo :: FilePath -- ^ the source file
         -> IO(Maybe Value)
@@ -132,13 +201,35 @@                 else return Nothing
        return $ fromMaybe (object []) mv
 
+-- | write the usage info file
+setUsageInfo :: FilePath -- ^ the source file
+        -> Value -- ^ the value
+        -> IO()
+setUsageInfo fp v=do
+        let usageFile=getUsageFile fp
+        BSS.writeFile usageFile $ BSS.concat $ BS.toChunks $ encode v
+
+-- | read the usage info file
+getUsageInfo :: FilePath -- ^ the source file
+        -> IO Value
+getUsageInfo fp=do
+        let usageFile=getUsageFile fp
+        ex<-doesFileExist usageFile
+        mv<-if ex
+                then do
+                       bs<-BSS.readFile usageFile
+                       return $ decode' $ BS.fromChunks [bs]
+                else return Nothing
+        return $ fromMaybe (object []) mv
+        
+
 -- | 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  = 
-  generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpan 
+  generic `ext1Q` list `extQ` string `extQ` fastString `extQ` srcSpanToJSON 
           `extQ` name `extQ` occName `extQ` modName `extQ` var `extQ` exprVar `extQ` dataCon
           `extQ` bagName `extQ` bagRdrName `extQ` bagVar `extQ` nameSet
-          `extQ` postTcType `extQ` fixity
+          `extQ` postTcType `extQ` fixity  `extQ` hsBind
   where generic :: Data a => a -> Value
         generic t =arr $ gmapQ dataToJSON t
                 -- object [(T.pack $ showConstr (toConstr t)) .= sub ] 
@@ -155,27 +246,19 @@         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   = object ["Name" .= string (OccName.occNameString o),"HType" .= string (if isValOcc o then "v" else "t")]
+        occName 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"]
-        srcSpan :: SrcSpan -> Value
-        srcSpan src 
-                | isGoodSrcSpan src   = object[ "SrcSpan" .= toJSON [srcLoc $ srcSpanStart src, srcLoc $ srcSpanEnd src]] 
-                | otherwise = Null
-#if __GLASGOW_HASKELL__ < 702   
-        srcLoc :: SrcLoc -> Value
-        srcLoc sl 
-                | isGoodSrcLoc  sl=object ["line" .= toJSON (srcLocLine sl),"column" .= toJSON (srcLocCol sl)]
-                | otherwise = Null
-#else
-        srcLoc :: SrcLoc -> Value
-        srcLoc (RealSrcLoc sl)=object ["line" .= toJSON (srcLocLine sl),"column" .= toJSON (srcLocCol sl)]
-        srcLoc _ = Null        
-#endif
+
         var :: Var -> Value
         var  v     = typedVar v (varType v)
         dataCon ::  DataCon -> Value
-        dataCon  d  = object (nameAndModule (dataConName d) ++ ["GType" .= string "DataCon"])
+        dataCon  d  = let
+                t=dataConUserType d
+                in object (nameAndModule (dataConName d) ++ typeToJSON t ++ [
+                        "GType" .= string "DataCon",
+                        "HType" .=  string "v"])
 --        simple:: T.Text -> String -> Value
 --        simple nm v=object [nm .= T.pack v]
         simpleV:: T.Text -> Value -> Value
@@ -193,10 +276,8 @@                         Just (t,v)-> typedVar v t
                         Nothing->generic ev
         typedVar :: Var -> Type -> Value
-        typedVar v t=object (nameAndModule (varName v) ++-                ["GType" .= string "Var",-                "Type" .= string (showSDocUnqual $ pprTypeForUser True t),-                "QType" .= string (showSDoc $ pprTypeForUser True t),+        typedVar v t=object (nameAndModule (varName v) ++ typeToJSON t ++
+                ["GType" .= string "Var",
                 "HType" .=  string (if isValOcc (nameOccName (Var.varName v)) then "v" else "t")])
 
         nameSet = const $ Data.Aeson.String "{!NameSet placeholder here!}" :: NameSet -> Value
@@ -205,12 +286,49 @@ 
         fixity  = const Null :: GHC.Fixity -> Value --simple "Fixity" . showSDoc . ppr 
 
+        typeToJSON :: Type -> [(T.Text,Value)]
+        typeToJSON t =  -- let
+                --appT=let (a,b)= splitAppTys t in (a:b)
+                --allT2=concatMap typesInsideType appT
+                -- 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)]
+              --  ,"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 a=generic a
         -- nameAndModule :: Name -> [Pair]
         nameAndModule n=let
-                mn=maybe "" (showSDoc . ppr . moduleName) $ nameModule_maybe n
+                mm=nameModule_maybe n
+                mn=maybe "" (showSDoc . ppr . moduleName) mm
+                pkg=maybe "" (showSDoc . ppr . modulePackageId) mm
                 na=showSDocUnqual $ ppr n
-                in ["Module" .= string mn, "Name" .= string na]
+                in ["Module" .= string mn,"Package" .= string pkg, "Name" .= string na]
 
+srcSpanToJSON :: SrcSpan -> Value
+srcSpanToJSON src 
+        | isGoodSrcSpan src   = object[ "SrcSpan" .= toJSON [srcLocToJSON $ srcSpanStart src, srcLocToJSON $ srcSpanEnd src]] 
+        | otherwise = Null
+#if __GLASGOW_HASKELL__ < 702   
+srcLocToJSON :: SrcLoc -> Value
+srcLocToJSON sl 
+        | isGoodSrcLoc  sl=object ["line" .= toJSON (srcLocLine sl),"column" .= toJSON (srcLocCol sl)]
+        | otherwise = Null
+#else
+srcLocToJSON :: SrcLoc -> Value
+srcLocToJSON (RealSrcLoc sl)=object ["line" .= toJSON (srcLocLine sl),"column" .= toJSON (srcLocCol sl)]
+srcLocToJSON _ = Null        
+#endif
+
+
+typesInsideType :: Type -> [Type]
+typesInsideType t=let
+         (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
@@ -263,39 +381,106 @@         Error _ -> Nothing 
 findInJSONData _=Nothing
 
+---- | find in JSON AST
+--findInJSON :: FindFunc -- ^ the evaluation function  
+--        -> Value -- ^ the root object containing the AST 
+--        -> Maybe Value
+--findInJSON f (Array arr) | not $ V.null arr=let
+--        v1=arr V.! 0
+--        in if f v1 && V.length arr==2 -- we have an array of two elements, the first one being a matching SrcSpan we go down the second element
+--           then 
+--                let
+--                        mv=findInJSON f $ arr V.! 1
+--                in case mv of
+--                        Just rv-> Just rv -- found something underneath
+--                        Nothing -> Just $ arr V.! 1 -- found nothing underneath, return second element of the array
+--           else
+--                let rvs=catMaybes $ V.toList $ fmap (findInJSON f) arr -- other case of arrays: check on each element
+--                in case rvs of
+--                        (x:_)->Just x -- return first match
+--                        []->Nothing
+--findInJSON f (Object obj)=let rvs=mapMaybe (findInJSON f) $ HM.elems obj -- in a complex object: check on contained elements
+--                in case rvs of
+--                        (x:_)->Just x
+--                        []->Nothing
+--findInJSON _ _= Nothing
+--
+---- | overlap function: find whatever is at the given line and column
+--overlap :: Int  -- ^ line
+--        -> Int -- ^ column
+--        -> FindFunc
+--overlap l c (Object m) | 
+--        Just pos<-HM.lookup "SrcSpan" m,
+--        Just (l1,c1,l2,c2)<-extractSourceSpan pos=l1<=l && c1<=c && l2>=l && c2>=c
+--overlap _ _ _=False
+
 -- | find in JSON AST
 findInJSON :: FindFunc -- ^ the evaluation function  
         -> Value -- ^ the root object containing the AST 
         -> Maybe Value
-findInJSON f (Array arr) | not $ V.null arr=let
-        v1=arr V.! 0
-        in if f v1 && V.length arr==2 -- we have an array of two elements, the first one being a matching SrcSpan we go down the second element
-           then 
-                let
-                        mv=findInJSON f $ arr V.! 1
-                in case mv of
-                        Just rv-> Just rv -- found something underneath
-                        Nothing -> Just $ arr V.! 1 -- found nothing underneath, return second element of the array
-           else
-                let rvs=catMaybes $ V.toList $ fmap (findInJSON f) arr -- other case of arrays: check on each element
-                in case rvs of
-                        (x:_)->Just x -- return first match
-                        []->Nothing
-findInJSON f (Object obj)=let rvs=mapMaybe (findInJSON f) $ HM.elems obj -- in a complex object: check on contained elements
-                in case rvs of
-                        (x:_)->Just x
-                        []->Nothing
-findInJSON _ _= Nothing
+findInJSON f (Array vals)=listToMaybe $ sortBy lastPos $ filter f $ V.toList vals
+findInJSON _ _=Nothing
 
+-- | sort Value by position, descending        
+lastPos :: Value -> Value -> Ordering
+lastPos (Object m1) (Object m2) |
+       Just pos1<-HM.lookup "Pos" m1,
+       Success ifs1 <- fromJSON pos1,
+       Just pos2<-HM.lookup "Pos" m2,
+       Success ifs2 <- fromJSON pos2 =let
+                c1=compare (iflLine $ ifsStart ifs2) (iflLine $ ifsStart ifs1)
+                in case c1 of
+                        EQ -> compare (iflColumn $ ifsStart ifs2) (iflColumn $ ifsStart ifs1)
+                        a -> a
+lastPos _ _=EQ      
+
 -- | overlap function: find whatever is at the given line and column
 overlap :: Int  -- ^ line
         -> Int -- ^ column
         -> FindFunc
 overlap l c (Object m) | 
-        Just pos<-HM.lookup "SrcSpan" m,
-        Just (l1,c1,l2,c2)<-extractSourceSpan pos=l1<=l && c1<=c && l2>=l && c2>=c
+        Just pos<-HM.lookup "Pos" m,
+        Success ifs <- fromJSON pos=iflOverlap ifs (InFileLoc l c)
 overlap _ _ _=False
 
+extractUsages :: Value -- ^ the root object containing the AST 
+        -> [Value]
+extractUsages (Array arr) | not $ V.null arr=let
+        v1=arr V.! 0
+        msrc=extractSource v1
+        in if isJust msrc && V.length arr==2 -- we have an array of two elements, the first one being a matching SrcSpan we go down the second element
+           then extractName v1 (arr V.! 1) ++ extractUsages (arr V.! 1)
+           else concat $ V.toList $ fmap extractUsages arr -- other case of arrays: check on each element
+extractUsages (Object obj)=concatMap extractUsages $ HM.elems obj -- in a complex object: check on contained elements
+        -- (extractName o) : 
+extractUsages  _= []
+
+extractName :: Value -> Value -> [Value]
+extractName src (Object m) |
+        Just ifl<-extractSource src,
+        Just (String s)<-HM.lookup "Name" m,
+        Just (String mo)<-HM.lookup "Module" m,
+        -- not $ T.null mo, -- keep local objects
+        Just (String p)<-HM.lookup "Package" m,
+        mqt<-HM.lookup "QType" m,
+        mst<-HM.lookup "Type" m,
+        mgt<-HM.lookup "GType" m,    
+        Just (String t)<-HM.lookup "HType" m,
+        at<-fromMaybe (Array V.empty) $ HM.lookup "AllTypes" m
+                =let
+                atts=["Name" .= s,"Module" .= mo,"Package" .= p,"HType" .= t,"AllTypes" .= at, "Pos" .= toJSON ifl, "QType" .= mqt, "Type" .= mst,"GType" .= mgt]
+                --atts1=if T.null mo 
+                --        then atts
+                --        else ():atts
+                in [object atts]
+extractName _ _=[]
+
+extractSource :: Value ->  Maybe InFileSpan
+extractSource (Object m) | 
+        Just pos<-HM.lookup "SrcSpan" m,
+        Just (sl,sc,el,ec)<-extractSourceSpan pos=Just $ InFileSpan (InFileLoc sl sc) (InFileLoc el ec)
+extractSource _=Nothing
+
 -- | extract the source span from JSON
 extractSourceSpan :: Value -> Maybe (Int,Int,Int,Int)
 extractSourceSpan (Array arr) | V.length arr==2 = do
@@ -352,7 +537,7 @@ reduceType t = t
 
 substType :: TyVar -> Type -> Type -> Type
-substType v t' t0 = go t0
+substType v t'  = go 
   where
     go t = case t of
       TyVarTy tv 

@@ -1,4 +1,4 @@-{-# LANGUAGE CPP #-}
+{-# LANGUAGE CPP, ScopedTypeVariables #-}
 -- |
 -- Module      : Language.Haskell.BuildWrapper.Packages
 -- Author      : Thiago Arrais
@@ -26,7 +26,7 @@ import System.Environment (getEnv)
 import System.FilePath
 import System.IO
-import System.IO.Error
+import qualified Control.Exception as Exc
 
 import GHC.Paths
 
@@ -87,22 +87,22 @@         Just pkgs -> return pkgs
 
     -- Get the user package configuration database
-    e_appdir <- try $ getAppUserDataDirectory "ghc"
-    user_conf <- case e_appdir of-                    Left _ -> return []+    e_appdir <- Exc.try $ getAppUserDataDirectory "ghc"
+    user_conf <- case e_appdir of
+                    Left (_::Exc.IOException) -> return []
                     Right appdir -> do 
-                       let subdir-                             = currentArch ++ '-' : currentOS ++ '-' : ghcVersion-                           dir = appdir </> subdir-                       r <- lookForPackageDBIn dir-                       case r of-                           Nothing -> return []+                       let subdir
+                             = currentArch ++ '-' : currentOS ++ '-' : ghcVersion
+                           dir = appdir </> subdir
+                       r <- lookForPackageDBIn dir
+                       case r of
+                           Nothing -> return []
                            Just pkgs -> return pkgs
 
     -- Process GHC_PACKAGE_PATH, if present:
-    e_pkg_path <- try (getEnv "GHC_PACKAGE_PATH")
+    e_pkg_path <- Exc.try (getEnv "GHC_PACKAGE_PATH")
     env_stack <- case e_pkg_path of
-        Left _     -> return []
+        Left (_::Exc.IOException)     -> return []
         Right path -> do
           pkgs <- mapM readContents [PkgDirectory pkg | pkg <- splitSearchPath path]
           return $ concat pkgs
@@ -135,8 +135,8 @@ #if __GLASGOW_HASKELL__ >= 612
       -- fix the encoding to UTF-8
       hSetEncoding h utf8
-      catch (hGetContents h) (\err->do
-         putStrLn $ ioeGetErrorString  err
+      Exc.catch (hGetContents h) (\(err :: Exc.IOException)->do
+         putStrLn $ show err
          hClose h
          h' <- openFile file ReadMode
          hSetEncoding h' localeEncoding
@@ -169,16 +169,16 @@     pkgInfoReader ::  FilePath
                       -> IO [InstalledPackageInfo]
     pkgInfoReader f = 
-      catch (
+      Exc.catch (
          do
               pkgStr <- readUTF8File f
               let pkgInfo = parseInstalledPackageInfo pkgStr
               case pkgInfo of
                 ParseOk _ info -> return [info]
                 ParseFailed err  -> do
-                        (print err)
+                        print err
                         return [emptyInstalledPackageInfo]
-        ) (\_->return [emptyInstalledPackageInfo])
+        ) (\(_::Exc.IOException)->return [emptyInstalledPackageInfo])
         
   in case pkgdb of
       (PkgDirectory pkgdbDir) -> do

@@ -20,7 +20,7 @@ 
 import qualified Data.Text as T
 import Data.Char (isSpace)
-import Data.List (foldl')
+import Data.List (foldl', isPrefixOf)
 
 -- | get the AST
 getHSEAST :: String -- ^ input text
@@ -28,8 +28,9 @@         -> IO (ParseResult (Module SrcSpanInfo, [Comment]))
 getHSEAST input options=do
         -- we add MultiParamTypeClasses because we may need it if the module we're parsing uses a type class with multiple parameters, which doesn't require the PRAGMA (only in the module DEFINING the type class)
+        -- we add PatternGuards since GHC only gives a warning if not explicit
         -- we cannot add all the extensions because some conflict (NewQualifiedOperators breaks code with old operator syntax I think)
-        let exts=MultiParamTypeClasses : map classifyExtension options
+        let exts=MultiParamTypeClasses : PatternGuards : map (\x->classifyExtension $ if isPrefixOf "-X" x then tail $ tail x else x) options
         let extsFull=if "-fglasgow-exts" `elem` options
                 then exts ++ glasgowExts
                 else exts
@@ -133,20 +134,28 @@                 commentMap = foldl' buildCommentMap DM.empty comments     
                 addComment:: OutlineDef -> OutlineDef
                 addComment od=let
-                        st=ifl_line $ ifs_start $ od_loc od
+                        st=iflLine $ ifsStart$ odLoc od
                         -- search for comment before declaration (line above, same column)
                         pl=DM.lookup (st-1) commentMap
                         od2= case pl of
-                                Just (stc,t) | stc == ifl_column (ifs_start $ od_loc od) -> od{od_comment=Just t}
+                                Just (stc,t) | stc == iflColumn (ifsStart $ odLoc od) -> od{odComment=Just t}
                                 _ -> let
                                         -- search  for comment after declaration (same line)
                                         pl2=DM.lookup st commentMap
                                      in case pl2 of
-                                                Just (_,t)-> od{od_comment=Just t}
+                                                Just (_,t)-> od{odComment=Just t}
                                                 Nothing -> od
-                        in od2{od_children=map addComment $ od_children od2}
+                        in od2{odChildren=map addComment $ odChildren od2}
 getHSEOutline _ = []
 
+-- | get the ouline from the AST        
+getModuleLocation :: (Module SrcSpanInfo, [Comment]) -- ^ the commented AST
+        -> Maybe InFileSpan
+getModuleLocation (Module _ (Just (ModuleHead _ (ModuleName l _) _ _)) _ _ _,_)=Just $ makeSpan l
+getModuleLocation (Module l _ _ _ _,_)=Just $ makeSpan l
+getModuleLocation _=Nothing
+
+
 -- | build the comment map
 buildCommentMap ::  DM.Map Int (Int,T.Text) -- ^ the map: key is line, value is start column and comment text
         -> Comment -- ^  the comment
@@ -183,7 +192,7 @@                 impDefs :: [ImportDecl SrcSpanInfo] -> [ImportDef]
                 impDefs=map impDef
                 impDef :: ImportDecl SrcSpanInfo -> ImportDef
-                impDef (ImportDecl l m qual _ _ al specs)=ImportDef (mnnameDecl m) (makeSpan l) qual (hide specs) (alias al) (children specs)
+                impDef (ImportDecl l m qual _ pkg al specs)=ImportDef (mnnameDecl m) (fmap T.pack pkg) (makeSpan l) qual (hide specs) (alias al) (children specs)
                 hide :: Maybe (ImportSpecList a)-> Bool
                 hide  (Just (ImportSpecList _ b _))=b
                 hide _=False

@@ -12,11 +12,40 @@ -- Direct tests on the API code
 module Language.Haskell.BuildWrapper.APITest where
 
+import qualified Language.Haskell.BuildWrapper.API as API
 import Language.Haskell.BuildWrapper.Base
+import Language.Haskell.BuildWrapper.Tests
 import qualified Language.Haskell.BuildWrapper.Cabal as Cabal
 
+import Control.Monad.State
 import Test.HUnit
 
+data DirectAPI=DirectAPI
+
+instance APIFacade DirectAPI where
+        synchronize _ r ff= runAPI r $ API.synchronize ff
+        synchronize1 _ r ff fp= runAPI r $ API.synchronize1 ff fp
+        write _ r fp s= runAPI r $ API.write fp s
+        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
+        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
+        getCabalDependencies _ r= runAPI r API.getCabalDependencies
+        getCabalComponents _ r= runAPI r API.getCabalComponents
+        generateUsage _ r retAll cc=runAPI r $ API.generateUsage retAll $ cabalComponentName cc
+        
+runAPI:: FilePath -> StateT BuildWrapperState IO a  -> IO a
+runAPI root f =runAPIFlags root f "" 
+
+runAPIFlags:: FilePath -> StateT BuildWrapperState IO a  -> String -> IO a
+runAPIFlags root f flags =
+        evalStateT f (BuildWrapperState ".dist-buildwrapper" "cabal" (testCabalFile root) Normal flags [])
 
 unitTests :: [Test]
 unitTests=[testGetBuiltPath,testParseBuildMessages,testParseBuildMessagesLinker,testParseBuildMessagesCabal

@@ -12,6 +12,7 @@ -- Testing via the executable interface
 module Language.Haskell.BuildWrapper.CMDTests where
 
+import Language.Haskell.BuildWrapper.Base
 import Language.Haskell.BuildWrapper.Tests
 import Test.HUnit
 
@@ -48,6 +49,7 @@         getNamesInScope _ r fp= runAPI r "namesinscope" ["--file="++fp]
         getCabalDependencies _ r= runAPI r "dependencies" []
         getCabalComponents _ r= runAPI r "components" []
+        generateUsage _ r retAll cc=runAPI r "generateusage" ["--returnall="++ show retAll,"--cabalcomponent="++ cabalComponentName cc]
         
 exeExtension :: String
 #ifdef mingw32_HOST_OS

@@ -33,7 +33,9 @@ tests :: (APIFacade a)=> [a -> Test]
 tests=  [
         testSynchronizeAll,
-        testConfigureWarnings , 
+        testSynchronizeDelete,
+        testSynchronizeExtraFiles,
+        testConfigureWarnings, 
         testConfigureErrors,
         testBuildErrors,
         testBuildWarnings,
@@ -46,27 +48,31 @@         testOutlineComments,
         testOutlineMultiParam,
         testOutlineOperator,
+        testOutlinePatternGuards,
+        testOutlineExtension,
         testPreviewTokenTypes,
-        testThingAtPoint ,
+        testThingAtPoint,
         testThingAtPointNotInCabal,
         testThingAtPointMain,
-        testThingAtPointMainSubFolder ,
+        testThingAtPointMainSubFolder,
         testNamesInScope,
+        testNameDefsInScope,
         testInPlaceReference,
         testCabalComponents,
         testCabalDependencies,
         testNoSourceDir,
-        testFlags
+        testFlags,
+        testBuildFlags
         ]
 
 class APIFacade a where
-        synchronize :: a -> FilePath -> Bool -> IO (OpResult [FilePath])
+        synchronize :: a -> FilePath -> Bool -> IO (OpResult ([FilePath],[FilePath]))
         synchronize1 :: a  -> FilePath -> Bool -> FilePath -> IO (Maybe FilePath)
         write :: a -> FilePath -> FilePath -> String -> IO ()
         configure :: a -> FilePath -> WhichCabal -> IO (OpResult Bool)
         configureWithFlags :: a -> FilePath -> WhichCabal -> String -> IO (OpResult Bool)
         build :: a -> FilePath -> Bool -> WhichCabal -> IO (OpResult BuildResult)
-        build1 :: a -> FilePath -> FilePath -> IO (OpResult Bool)
+        build1 :: a -> FilePath -> FilePath -> 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])
@@ -75,12 +81,14 @@         getNamesInScope :: a -> FilePath -> FilePath-> IO (OpResult (Maybe [String]))
         getCabalDependencies :: a -> FilePath -> IO (OpResult [(FilePath,[CabalPackage])])
         getCabalComponents :: a -> FilePath -> IO (OpResult [CabalComponent])
+        generateUsage :: a -> FilePath -> Bool -> CabalComponent -> IO (OpResult (Maybe [FilePath]))
         
 testSynchronizeAll :: (APIFacade a)=> a -> Test
 testSynchronizeAll api= TestLabel "testSynchronizeAll" (TestCase ( do
         root<-createTestProject
-        (fps,_)<-synchronize api root False
+        ((fps,dels),_)<-synchronize api root False
         assertBool "no file path on creation" (not $ null fps) 
+        assertBool "deletions!" (null dels) 
         assertEqual "no cabal file" (testProjectName <.> ".cabal") (head fps)
         assertBool "no A" (("src" </> "A.hs") `elem` fps)
         assertBool "no C" (("src" </> "B" </> "C.hs") `elem` fps)
@@ -90,6 +98,37 @@         assertBool "no TestA" (("test" </> "TestA.hs") `elem` fps)
         ))
 
+testSynchronizeDelete :: (APIFacade a)=> a -> Test
+testSynchronizeDelete api= TestLabel "testSynchronizeDelete" (TestCase ( do
+        root<-createTestProject
+        ((fps0,dels0),_)<-synchronize api root False
+        assertBool "no file path on creation" (not $ null fps0) 
+        assertBool "deletions!" (null dels0) 
+        let new=root </> ".dist-buildwrapper" </> "New.hs"
+        writeFile new "module New where"
+        ex1<-doesFileExist new
+        assertBool "new does not exist" ex1
+        ((_,dels),_)<-synchronize api root False
+        assertBool "no deletions" (not $ null dels) 
+        assertBool "no New.hs" ("New.hs" `elem` dels)
+        ex2<-doesFileExist new
+        assertBool "new does still exist" (not ex2)
+        ))
+
+testSynchronizeExtraFiles :: (APIFacade a)=> a -> Test
+testSynchronizeExtraFiles api= TestLabel "testSynchronizeAll" (TestCase ( do
+        root<-createTestProject
+        let extra=root </> "src" -- need to be in hs-source-dirs
+        writeFile (extra </> "a.txt") "contents"
+        let new=root </> ".dist-buildwrapper" </> "src" </> "a.txt"
+        ex1<-doesFileExist new
+        assertBool "new does exist before synchronize" (not ex1)
+        ((fps,_),_)<-synchronize api root False
+        assertBool "no new in sync result" (("src" </> "a.txt") `elem` fps)
+        ex2<-doesFileExist new
+        assertBool "new does not exist after synchronize" ex2
+        ))
+
 testConfigureErrors :: (APIFacade a)=> a -> Test
 testConfigureErrors api= TestLabel "testConfigureErrors" (TestCase ( do
         root<-createTestProject
@@ -97,7 +136,7 @@         assertBool "configure returned true on no cabal" (not boolNoCabal)
         --assertEqual "errors or warnings on no cabal (should be ignored)" 0 (length nsNoCabal)        
         let bw=head nsNoCabal
-        assertEqual "wrong error on no cabal" BWError (bwn_status bw)   
+        assertEqual "wrong error on no cabal" BWError (bwnStatus bw)   
         
         synchronize api root False
         (boolOK,nsOK)<-configure api root Target
@@ -249,13 +288,21 @@         assertBool ("errors or warnings on build:"++show nsOK) (null nsOK)
         let rel="src"</>"A.hs"
         -- write source file
+        
         writeFile (root </> rel) $ unlines ["module A where","import toto","fA=undefined"]
+        synchronize1 api root True rel
+        (bool11,nsErrors11)<-build1 api root rel
+        assertBool "returned true on bool1_1" (isNothing bool11)
+        assertBool "no errors or warnings on nsErrors11" (not $ null nsErrors11)
+        let (nsError11:[])=nsErrors11
+        assertEqualNotesWithoutSpaces "not proper error 1_1" (BWNote BWError "parse error on input `toto'\n" (BWLocation rel 2 8)) nsError11
         (BuildResult bool1 _,nsErrors1)<-build api root False Source
         assertBool "returned true on bool1" (not bool1)
-        assertBool "no errors or warnings on nsErrors" (not $ null nsErrors1)
+        assertBool "no errors or warnings on nsErrors1" (not $ null nsErrors1)
         let (nsError1:[])=nsErrors1
         assertEqualNotesWithoutSpaces "not proper error 1" (BWNote BWError "parse error on input `toto'\n" (BWLocation rel 2 8)) nsError1
-        -- write file and synchronize
+        
+            -- write file and synchronize
         writeFile (root </> "src"</>"A.hs")$ unlines ["module A where","import Toto","fA=undefined"]
         mf2<-synchronize1 api root True rel
         assertBool "mf2 not just" (isJust mf2)
@@ -264,10 +311,16 @@         assertBool "no errors or warnings on nsErrors2" (not $ null nsErrors2)
         let (nsError2:[])=nsErrors2
         assertEqualNotesWithoutSpaces "not proper error 2" (BWNote BWError "Could not find module `Toto':\n      Use -v to see a list of the files searched for.\n" (BWLocation rel 2 8)) nsError2
+        synchronize1 api root True rel
+        (bool21,nsErrors21)<-build1 api root rel
+        assertBool "returned true on bool21" (isNothing bool21)
+        assertBool "no errors or warnings on nsErrors2_1" (not $ null nsErrors21)
+        let (nsError21:[])=nsErrors21
+        assertEqualNotesWithoutSpaces "not proper error 2_1" (BWNote BWError "Could not find module `Toto':\n      Use -v to see a list of the files searched for.\n" (BWLocation rel 2 8)) nsError21
         (_,nsErrors3f)<- getBuildFlags api root ("src"</>"A.hs")
         assertBool ("errors or warnings on nsErrors3f:" ++ show nsErrors3f) (null nsErrors3f)
-        (bool3,nsErrors3)<-build1 api root ("src"</>"A.hs")
-        assertBool "returned true on bool3" (not bool3)
+        (bool3,nsErrors3)<-build1 api root rel
+        assertBool "returned true on bool3" (isNothing bool3)
         assertBool "no errors or warnings on nsErrors3" (not $ null nsErrors3)
         let (nsError3:[])=nsErrors3
         assertEqualNotesWithoutSpaces "not proper error 3" (BWNote BWError "Could not find module `Toto':\n  Use -v to see a list of the files searched for." (BWLocation rel 2 8)) nsError3
@@ -307,7 +360,7 @@         (_,nsErrors3f)<-getBuildFlags api root rel
         assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
         (bool3,nsErrors3)<-build1 api root rel
-        assertBool "returned false on bool3" bool3
+        assertBool "returned false on bool3" (isJust bool3)
         assertEqual "not 2 errors or warnings on nsErrors3" 2 (length nsErrors3)
         let (nsError3:nsError4:[])=nsErrors3
         assertEqualNotesWithoutSpaces "not proper error 3" (BWNote BWWarning "The import of `Data.List' is redundant\n           except perhaps to import instances from `Data.List'\n         To import instances alone, use: import Data.List()" (BWLocation rel 2 1)) nsError3
@@ -316,7 +369,7 @@         mf3<-synchronize1 api root True rel
         assertBool "mf3 not just" (isJust mf3)
         (bool4,nsErrors4)<-build1 api root rel
-        assertBool "returned false on bool4" bool4
+        assertBool "returned false on bool4" (isJust bool4)
         assertBool "no errors or warnings on nsErrors4" (not $ null nsErrors4)
         let (nsError5:[])=nsErrors4
         assertEqualNotesWithoutSpaces "not proper error 5" (BWNote BWWarning ("This binding for `pats' shadows the existing binding\n           defined at "++rel++":3:1") (BWLocation rel 4 5)) nsError5
@@ -327,8 +380,8 @@         root<-createTestProject
         synchronize api root False
         build api root True Source
-        let exeN=case os of-                        "mingw32" -> addExtension testProjectName "exe"+        let exeN=case os of
+                        "mingw32" -> addExtension testProjectName "exe"
                         _   -> testProjectName
         let exeF=root </> ".dist-buildwrapper" </> "dist" </> "build" </> testProjectName </> exeN
         exeE1<-doesFileExist exeF
@@ -356,7 +409,7 @@         (_,nsErrors2f)<-getBuildFlags api root rel
         assertBool "no errors or warnings on nsErrors2f" (null nsErrors2f)
         (bool2, nsErrors2)<-build1 api root rel
-        assertBool ("returned false on bool2: " ++ show nsErrors2) bool2
+        assertBool ("returned false on bool2: " ++ show nsErrors2) (isJust bool2)
         assertBool ("errors or warnings on nsErrors2: " ++ show nsErrors2) (null nsErrors2)
         
         ))      
@@ -445,7 +498,7 @@         assertEqual "length" (length expected) (length defs)
         mapM_ (uncurry (assertEqual "outline")) (zip expected defs)
         assertEqual "exports" [] es
-        assertEqual "imports" [ImportDef "Data.Char" (InFileSpan (InFileLoc 5 1)(InFileLoc 5 17)) False False "" Nothing] is
+        assertEqual "imports" [ImportDef "Data.Char" Nothing (InFileSpan (InFileLoc 5 1)(InFileLoc 5 17)) False False "" Nothing] is
       ))   
         
 testOutlineComments :: (APIFacade a)=> a -> Test
@@ -514,7 +567,7 @@         assertEqual ("length:" ++ show defs) (length expected) (length defs)
         mapM_ (uncurry (assertEqual "outline")) (zip expected defs)
         assertEqual "exports" [] es
-        assertEqual "imports" [ImportDef "Data.Char" (InFileSpan (InFileLoc 5 1)(InFileLoc 5 17)) False False "" Nothing] is
+        assertEqual "imports" [ImportDef "Data.Char" Nothing (InFileSpan (InFileLoc 5 1)(InFileLoc 5 17)) False False "" Nothing] is
       ))           
         
 testOutlinePreproc :: (APIFacade a)=> a -> Test
@@ -654,10 +707,10 @@                 ]
         mapM_ (uncurry (assertEqual "exports")) (zip exps es)
         let imps=[
-                ImportDef "Data.Char" (InFileSpan (InFileLoc 3 1)(InFileLoc 3 17)) False False "" Nothing,
-                ImportDef "Data.Map" (InFileSpan (InFileLoc 4 1)(InFileLoc 4 30)) False False "DM" (Just [ImportSpecDef "empty" IEVar (InFileSpan (InFileLoc 4 24)(InFileLoc 4 29)) []]),
-                ImportDef "Data.List" (InFileSpan (InFileLoc 5 1)(InFileLoc 5 42)) False True "" (Just [ImportSpecDef "orderBy" IEVar (InFileSpan (InFileLoc 5 26)(InFileLoc 5 33)) [],ImportSpecDef "groupBy" IEVar (InFileSpan (InFileLoc 5 34)(InFileLoc 5 41)) []]),
-                ImportDef "Data.Maybe" (InFileSpan (InFileLoc 6 1)(InFileLoc 6 42)) True False "" (Just [ImportSpecDef "Maybe" IEThingWith (InFileSpan (InFileLoc 6 30)(InFileLoc 6 41)) ["Just"]])
+                ImportDef "Data.Char" Nothing (InFileSpan (InFileLoc 3 1)(InFileLoc 3 17)) False False "" Nothing,
+                ImportDef "Data.Map" Nothing (InFileSpan (InFileLoc 4 1)(InFileLoc 4 30)) False False "DM" (Just [ImportSpecDef "empty" IEVar (InFileSpan (InFileLoc 4 24)(InFileLoc 4 29)) []]),
+                ImportDef "Data.List" Nothing (InFileSpan (InFileLoc 5 1)(InFileLoc 5 42)) False True "" (Just [ImportSpecDef "orderBy" IEVar (InFileSpan (InFileLoc 5 26)(InFileLoc 5 33)) [],ImportSpecDef "groupBy" IEVar (InFileSpan (InFileLoc 5 34)(InFileLoc 5 41)) []]),
+                ImportDef "Data.Maybe" Nothing (InFileSpan (InFileLoc 6 1)(InFileLoc 6 42)) True False "" (Just [ImportSpecDef "Maybe" IEThingWith (InFileSpan (InFileLoc 6 30)(InFileLoc 6 41)) ["Just"]])
                 ] 
         mapM_ (uncurry (assertEqual "imports")) (zip imps is)
         
@@ -689,9 +742,9 @@                 ] 
         (_,nsErrors3f)<-getBuildFlags api root rel2
         assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
-        (OutlineResult or _ _,nsErrors1)<-getOutline api root rel2
+        (OutlineResult ors _ _,nsErrors1)<-getOutline api root rel2
         assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1)
-        assertBool "no outline" (not $ null or)
+        assertBool "no outline" (not $ null ors)
         ))
     
 testOutlineOperator  :: (APIFacade a)=> a -> Test
@@ -711,11 +764,66 @@                 ]
         (_,nsErrors3f)<-getBuildFlags api root rel
         assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
-        (OutlineResult or _ _,nsErrors1)<-getOutline api root rel
+        (OutlineResult ors _ _,nsErrors1)<-getOutline api root rel
         assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1)
-        assertBool "no outline" (not $ null or)
+        assertBool "no outline" (not $ null ors)
         ))    
+
+
+testOutlinePatternGuards  :: (APIFacade a)=> a -> Test
+testOutlinePatternGuards api= TestLabel "testOutlinePatternGuards" (TestCase ( do
+        root<-createTestProject
+        synchronize api root False
+        let rel="src"</>"A.hs"      
+        write api root rel $ unlines [
+                "module A",
+                "  where",
+                "toto o | Just s<-o=s",
+                "toto _=\"\"   "
+                ]
+        (_,nsErrors3f)<-getBuildFlags api root rel
+        assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
+        (bool3,nsErrors3)<-build1 api root rel
+        assertBool "returned false on bool3" (isJust bool3)
+        assertBool ("errors on nsErrors3"++ show nsErrors3) (not (any (\ x -> BWError == bwnStatus x) nsErrors3))
+        (OutlineResult ors _ _,nsErrors1)<-getOutline api root rel
+        assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1)
+        assertBool "no outline" (not $ null ors)
+        )) 
                 
+testOutlineExtension     :: (APIFacade a)=> a -> Test
+testOutlineExtension api= TestLabel "testOutlineExtension" (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.C",
+                "  build-depends:  base",
+                "  extensions: EmptyDataDecls"]
+        let rel="src"</>"A.hs"      
+        write api root rel $ unlines [
+                "module A",
+                "  where",
+                "data B"
+                ]
+        synchronize api root False        
+        configure api root Source
+        (_,nsErrors3f)<-getBuildFlags api root rel
+        assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
+        (bool3,nsErrors3)<-build1 api root rel
+        assertBool "returned false on bool3" (isJust bool3)
+        assertBool ("errors on nsErrors3"++ show nsErrors3) (not (any (\ x -> BWError == bwnStatus x) nsErrors3))
+        (OutlineResult ors _ _,nsErrors1)<-getOutline api root rel
+        assertBool ("errors or warnings on getOutline:"++show nsErrors1) (null nsErrors1)
+        assertBool "no outline" (not $ null ors)
+        ))             
+                
 testPreviewTokenTypes :: (APIFacade a)=> a -> Test
 testPreviewTokenTypes api= TestLabel "testPreviewTokenTypes" (TestCase ( do
         root<-createTestProject
@@ -751,7 +859,15 @@         let rel="src"</>"Main.hs"
         write api root rel $ unlines [  
                   "module Main where",
-                  "main=return $ map id \"toto\""
+                  "main=return $ map id \"toto\"",
+                  "",
+                  "data DataT=MkData {name :: String}",
+                  "",
+                  "data Toot=Toot {toot :: String}",
+                  "",
+                  "fun1=let",
+                  "    l2=reverse \"toto\"",
+                  "    in head l2"
                   ] 
         (_,nsErrors3f)<-getBuildFlags api root rel
         assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)          
@@ -766,13 +882,75 @@         assertEqual "not gtype"  (Just "Var") (tapGType $ fromJust tap1)
         
         
-        (tap5,nsErrors5)<-getThingAtPoint api root rel 2 20
-        assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors5) (null nsErrors5)
-        assertBool "not just tap5" (isJust tap5)
-        assertEqual "not id" "id" (tapName $ fromJust tap5)
-        assertEqual "not GHC.Base" (Just "GHC.Base") (tapModule $ fromJust tap5)
-        assertEqual "not qtype" (Just "GHC.Types.Char -> GHC.Types.Char") (tapQType $ fromJust tap5)
+        (tap2,nsErrors2)<-getThingAtPoint api root rel 2 20
+        assertBool ("errors or warnings on getThingAtPoint2:"++show nsErrors2) (null nsErrors2)
+        assertBool "not just tap2" (isJust tap2)
+        assertEqual "not id" "id" (tapName $ fromJust tap2)
+        assertEqual "not GHC.Base" (Just "GHC.Base") (tapModule $ fromJust tap2)
+        assertEqual "not htype2"  (Just "v") (tapHType $ fromJust tap2)
+        assertEqual "not qtype" (Just "GHC.Types.Char -> GHC.Types.Char") (tapQType $ fromJust tap2)
        
+        (tap3,nsErrors3)<-getThingAtPoint api root rel 4 7
+        assertBool ("errors or warnings on getThingAtPoint3:"++show nsErrors3) (null nsErrors3)
+        assertBool "not just tap3" (isJust tap3)
+        assertEqual "not DataT" "DataT" (tapName $ fromJust tap3)
+        assertEqual "not Main" (Just "Main") (tapModule $ fromJust tap3)
+        assertEqual "not htype3"  (Just "t") (tapHType $ fromJust tap3)
+        assertEqual "qtype DataT" Nothing (tapQType $ fromJust tap3)
+        
+        (tap4,nsErrors4)<-getThingAtPoint api root rel 4 14
+        assertBool ("errors or warnings on getThingAtPoint4:"++show nsErrors4) (null nsErrors4)
+        assertBool "not just tap4" (isJust tap4)
+        assertEqual "not MkData" "MkData" (tapName $ fromJust tap4)
+        assertEqual "not Main" (Just "Main") (tapModule $ fromJust tap4)
+        assertEqual "not htype4"  (Just "v") (tapHType $ fromJust tap4)
+        assertEqual "gtype MkData"  (Just "DataCon") (tapGType $ fromJust tap4)
+        assertEqual "type MkData" (Just "String -> DataT") (tapType $ fromJust tap4)
+        assertEqual "qtype MkData" (Just "GHC.Base.String -> Main.DataT") (tapQType $ fromJust tap4)
+        
+        (tap5,nsErrors5)<-getThingAtPoint api root rel 4 22
+        assertBool ("errors or warnings on getThingAtPoint5:"++show nsErrors5) (null nsErrors5)
+        assertBool "not just tap5" (isJust tap5)
+        assertEqual "not name" "name" (tapName $ fromJust tap5)
+        assertEqual "not Main" (Just "Main") (tapModule $ fromJust tap5)
+        assertEqual "not htype5"  (Just "v") (tapHType $ fromJust tap5)
+        assertEqual "qtype name" (Just "Main.DataT -> GHC.Base.String") (tapQType $ fromJust tap5)
+        
+        (tap6,nsErrors6)<-getThingAtPoint api root rel 6 7
+        assertBool ("errors or warnings on getThingAtPoint6:"++show nsErrors6) (null nsErrors6)
+        assertBool "not just tap6" (isJust tap6)
+        assertEqual "not Toot" "Toot" (tapName $ fromJust tap6)
+        assertEqual "not Main" (Just "Main") (tapModule $ fromJust tap6)
+        assertEqual "not htype6"  (Just "t") (tapHType $ fromJust tap6)
+        assertEqual "qtype Toot" Nothing (tapQType $ fromJust tap6)
+        
+        (tap7,nsErrors7)<-getThingAtPoint api root rel 6 14
+        assertBool ("errors or warnings on getThingAtPoint7:"++show nsErrors7) (null nsErrors7)
+        assertBool "not just tap7" (isJust tap7)
+        assertEqual "not Toot" "Toot" (tapName $ fromJust tap7)
+        assertEqual "not Main" (Just "Main") (tapModule $ fromJust tap7)
+        assertEqual "not htype7"  (Just "v") (tapHType $ fromJust tap7)
+        assertEqual "qtype Toot" (Just "GHC.Base.String -> Main.Toot") (tapQType $ fromJust tap7)
+        
+        (tap8,nsErrors8)<-getThingAtPoint api root rel 6 19
+        assertBool ("errors or warnings on getThingAtPoint8:"++show nsErrors8) (null nsErrors8)
+        assertBool "not just tap8" (isJust tap8)
+        assertEqual "not toot" "toot" (tapName $ fromJust tap8)
+        assertEqual "not Main" (Just "Main") (tapModule $ fromJust tap8)
+        assertEqual "not htype8"  (Just "v") (tapHType $ fromJust tap8)
+        assertEqual "qtype toot" (Just "Main.Toot -> GHC.Base.String") (tapQType $ fromJust tap8)
+        
+        
+        (tap9,nsErrors9)<-getThingAtPoint api root rel 9 5
+        assertBool ("errors or warnings on getThingAtPoint9:"++show nsErrors9) (null nsErrors9)
+        assertBool "not just tap9" (isJust tap9)
+        assertEqual "not l2" "l2" (tapName $ fromJust tap9)
+        assertEqual "not empty module" (Just "") (tapModule $ fromJust tap9)
+        assertEqual "not htype9"  (Just "v") (tapHType $ fromJust tap9)
+        assertEqual "qtype l2" (Just "[GHC.Types.Char]") (tapQType $ fromJust tap9)
+        
+        
+        
         )) 
 
 testThingAtPointNotInCabal :: (APIFacade a)=> a -> Test
@@ -817,7 +995,7 @@         configure api root Target          
         (bf3,nsErrors3f)<-getBuildFlags api root rel
         assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
-        assertEqual "not main module" (Just "Main") (bf_modName bf3)
+        assertEqual "not main module" (Just "Main") (bfModName bf3)
         (tap1,nsErrors1)<-getThingAtPoint api root rel 3 16
         assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors1) (null nsErrors1)
         assertBool "not just tap1" (isJust tap1)
@@ -861,7 +1039,7 @@         configure api root Target          
         (bf3,nsErrors3f)<-getBuildFlags api root rel
         assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
-        assertEqual "not main module" (Just "Main") (bf_modName bf3)
+        assertEqual "not main module" (Just "Main") (bfModName bf3)
         (tap1,nsErrors1)<-getThingAtPoint api root rel 3 16
         assertBool ("errors or warnings on getThingAtPoint1:"++show nsErrors1) (null nsErrors1)
         assertBool "not just tap1" (isJust tap1)
@@ -895,6 +1073,31 @@         assertBool "does not contain B.D.fD" ("B.D.fD" `elem` tts)
         assertBool "does not contain GHC.Types.Char" ("GHC.Types.Char" `elem` tts)
         )) 
+     
+testNameDefsInScope :: (APIFacade a)=> a -> Test
+testNameDefsInScope api= TestLabel "testNameDefsInScope" (TestCase ( do
+        root<-createTestProject
+        synchronize api root False
+        configure api root Source        
+        let rel="src"</>"Main.hs"
+        writeFile (root </> rel) $ unlines [  
+                  "module Main where",
+                  "import B.D",
+                  "main=return $ map id \"toto\"",
+                  "data Type1=MkType1_1 Int"
+                  ] 
+        build api root True Source
+        synchronize api root False
+        (mtts,_)<-build1 api root rel
+        assertBool "getNameDefsInScope not just" (isJust mtts)
+        let tts=fromJust mtts
+        assertBool "does not contain Main.main" (NameDef "Main.main" [Function] (Just "IO [Char]") `elem` tts)
+        assertBool "does not contain B.D.fD" (NameDef "B.D.fD" [Function] (Just "forall a. a") `elem` tts)
+        assertBool "does not contain Main.Type1" (NameDef "Main.Type1" [Type] Nothing `elem` tts)
+        assertBool "does not contain Main.MkType1_1" (NameDef "Main.MkType1_1" [Constructor] (Just "Int -> Type1") `elem` tts)
+        assertBool "does not contain GHC.Types.Char" (NameDef "GHC.Types.Char" [Type] Nothing `elem` tts)
+        )) 
+          
         
 testInPlaceReference  :: (APIFacade a)=> a -> Test
 testInPlaceReference api= TestLabel "testInPlaceReference" (TestCase ( do
@@ -1027,9 +1230,9 @@         assertBool ("errors or warnings on getCabalDependencies:"++show nsOK) (null nsOK)
         assertEqual "not two databases" 2 (length cps)
         let (_:(_,pkgs):[])=cps
-        let base=filter (\pkg->cp_name pkg == "base") pkgs
+        let base=filter (\pkg->cpName pkg == "base") pkgs
         assertEqual "not 1 base" 1 (length base)
-        let (l:ex:ts:[])=cp_dependent $ head base
+        let (l:ex:ts:[])=cpDependent $ head base
         assertEqual "not library true" (CCLibrary True) l
         assertEqual "not executable true" (CCExecutable "BWTest" True) ex
         assertEqual "not test suite true" (CCTestSuite "BWTest-test" True) ts
@@ -1116,6 +1319,35 @@         
         ))    
 
+testBuildFlags :: (APIFacade a)=> a -> Test
+testBuildFlags api=TestLabel "testFlags" (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.C",
+                "  build-depends:  base",
+                "  extensions: OverlappingInstances"
+                ]
+        configure api root Source 
+        let rel="src"</>"A.hs"  
+        (flgs,nsErrors3f)<-getBuildFlags api root rel
+        print flgs
+        assertBool "errors or warnings on nsErrors3f" (null nsErrors3f)
+        let ast=bfAst flgs   
+        assertBool "no package-name" ("-package-name" `elem` ast)
+        assertBool "no package name" ("BWTest-0.1" `elem` ast)
+        assertBool "no -XOverlappingInstances" ("-XOverlappingInstances" `elem` ast)
+        assertBool "OverlappingInstances" ("OverlappingInstances" `notElem` ast)
+        ))
+        
+
 testProjectName :: String
 testProjectName="BWTest"         
         
@@ -1166,7 +1398,7 @@ createTestProject = do
         temp<-getTemporaryDirectory
         let root=temp </> testProjectName
-        ex<-(doesDirectoryExist root)
+        ex<-doesDirectoryExist root
         when ex (removeDirectoryRecursive root)
         createDirectory root
         writeFile (testCabalFile root) testCabalContents
@@ -1190,6 +1422,6 @@ assertEqualNotesWithoutSpaces :: String -> BWNote -> BWNote -> IO()
 assertEqualNotesWithoutSpaces msg n1 n2=do
         let
-                n1'=n1{bwn_title=removeSpaces $ bwn_title n1}
-                n2'=n1{bwn_title=removeSpaces $ bwn_title n2}
+                n1'=n1{bwnTitle=removeSpaces $ bwnTitle n1}
+                n2'=n1{bwnTitle=removeSpaces $ bwnTitle n2}
         assertEqual msg n1' n2'

@@ -0,0 +1,387 @@+{-# LANGUAGE CPP,OverloadedStrings,PatternGuards #-}
+module Language.Haskell.BuildWrapper.UsagesTests where
+
+import Language.Haskell.BuildWrapper.Base
+
+import Language.Haskell.BuildWrapper.Tests
+import Language.Haskell.BuildWrapper.CMDTests
+import Test.HUnit
+
+import System.Directory
+import System.FilePath
+
+import System.Time
+
+import qualified Data.ByteString.Lazy as BS
+-- import qualified Data.ByteString.Lazy.Char8 as BSC (putStrLn)
+import qualified Data.ByteString as BSS
+import Data.Aeson
+import Data.Maybe
+
+import qualified Data.Set as S
+import qualified Data.Text as T
+import qualified Data.HashMap.Lazy as HM
+import qualified Data.Vector as V
+import qualified Data.Aeson.Types (parse)
+
+usageTests::[Test]
+usageTests= map (\f->f CMDAPI) utests
+
+utests :: (APIFacade a)=> [a -> Test]
+utests= [ testGenerateBWUsage,
+        testGenerateReferencesSimple,
+        testGenerateReferencesImports,
+        testGenerateReferencesExports,
+        testGenerateReferencesExportAlias,
+        testIncorrectModuleFileName
+        ]
+
+testGenerateBWUsage :: (APIFacade a)=> a -> Test
+testGenerateBWUsage api= TestLabel "testGenerateBWUsage" (TestCase ( do
+        root<-createTestProject
+        ((fps,dels),_)<-synchronize api root False
+        assertBool "no file path on creation" (not $ null fps)
+        assertBool "deletions" (null dels)  
+        assertEqual "no cabal file" (testProjectName <.> ".cabal") (head fps)
+        let rel="src" </> "A.hs"
+        assertBool "no A" (rel `elem` fps)
+        let bwI1=getUsageFile (root </> ".dist-buildwrapper" </>  rel)
+        ef1<-doesFileExist bwI1
+        assertBool (bwI1 ++ "  file exists before build") (not ef1)
+        (BuildResult bool1 fps1,nsErrors1)<-build api root False Source
+        assertBool "returned false on bool1" bool1
+        assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
+        assertBool ("no rel in fps1: " ++ show fps1) (rel `elem` fps1)
+        assertBool (bwI1 ++ "  file exists after build") (not ef1)
+        (comps,_)<-getCabalComponents api root
+        c1<-getClockTime
+        gar<-mapM (generateUsage api root False) comps
+        let fs=concat $ mapMaybe fst gar
+        assertBool "fs doesn't contain rel" (rel `elem` fs)
+        c2<-getClockTime
+        putStrLn ("generateUsage: " ++ timeDiffToString (diffClockTimes c2 c1))
+        ef2<-doesFileExist bwI1
+        assertBool (bwI1 ++ " file doesn't exist after generateAST") ef2
+        gar2<-mapM (generateUsage api root  False) comps
+        let fs2=concat $ mapMaybe fst gar2
+        assertBool "fs2  contains rel" (rel `notElem` fs2)
+        gar3<-mapM (generateUsage api root  True) comps
+        let fs3=concat $ mapMaybe fst gar3
+        assertBool "fs3 doesn't  contain rel" (rel `elem` fs3)
+        ))
+
+testGenerateReferencesSimple :: (APIFacade a)=> a -> Test
+testGenerateReferencesSimple api= TestLabel "testGenerateReferencesSimple" (TestCase ( do
+        root<-createTestProject
+        let relMain="src"</>"Main.hs"
+        writeFile (root</> relMain) $ unlines [  
+                  "module Main where",
+                  "import A",
+                  "main=print $ reset $ Cons2 1"
+                  ] 
+        let rel="src" </> "A.hs"
+        writeFile (root</> rel) $ unlines [  
+                  "module A where",
+                  "data MyData=Cons1", 
+                  "      { mdS::MyString}", 
+                  "      | Cons2 Int",
+                  "     deriving Show",
+                  "",
+                  "type MyString=String",
+                  "",
+                  "reset :: MyData -> MyData",
+                  "reset (Cons1 _)=Cons1 \"\"",
+                  "reset (Cons2 _)=Cons2 0",
+                  "",
+                  "resetAll=map reset",
+                  "",
+                  "getString :: MyData -> Maybe MyString",
+                  "getString (Cons1 s)=Just s",
+                  "getString _= Nothing"
+                  ]  
+        _<-synchronize api root True          
+        (BuildResult bool1 _,nsErrors1)<-build api root False Source
+        assertBool ("returned false on bool1:" ++ show nsErrors1)  bool1
+        assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
+        (lib:exe:_,_)<-getCabalComponents api root    
+        --mapM_ (generateUsage api root False) comps
+        generateUsage api root False lib
+        let uf=getUsageFile $ root </> ".dist-buildwrapper" </> relMain
+        euf1<-doesFileExist uf
+        assertBool "main usage file exists after lib" (not euf1)
+        generateUsage api root False exe
+        euf2<-doesFileExist uf
+        assertBool "main usage file does not exist after exe" euf2
+        --sI<-fmap formatJSON (readFile  $ getInfoFile(root </> ".dist-buildwrapper" </>  rel))
+        --putStrLn sI
+        v<-readStoredUsage (root </> ".dist-buildwrapper" </>  rel)
+        -- sU<-fmap formatJSON (readFile  $ getUsageFile(root </> ".dist-buildwrapper" </>  rel))
+        -- putStrLn sU
+      
+        assertPackageModule "BWTest-0.1" "A" [1,8,1,9] v
+      
+        assertVarUsage "BWTest-0.1" "A" "Cons1" [("Cons1",True,[2,13,2,18]),("reset",False,[10,8,10,13]),("reset",False,[10,17,10,22]),("getString",False,[16,12,16,17])] v
+        assertVarUsage "BWTest-0.1" "A" "Cons2" [("Cons2",True,[4,9,4,14]),("reset",False,[11,8,11,13]),("reset",False,[11,17,11,22])] v
+        assertVarUsage "BWTest-0.1" "A" "mdS" [("mdS",True,[3,9,3,12])] v
+        assertVarUsage "BWTest-0.1" "A" "reset" [("reset",True,[9,1,9,6]),("reset",True,[10,1,10,25]),("reset",True,[11,1,11,24]),("resetAll",False,[13,14,13,19])] v
+        assertVarUsage "BWTest-0.1" "A" "resetAll" [("resetAll",True,[13,1,13,19])] v
+        assertVarUsage "BWTest-0.1" "A" "getString" [("getString",True,[15,1,15,10]),("getString",True,[16,1,16,27]),("getString",True,[17,1,17,21])] v
+        assertVarUsage "base" "Data.Maybe" "Nothing" [("getString",False,[17,14,17,21])] v
+        assertVarUsage "base" "Data.Maybe" "Just" [("getString",False,[16,21,16,25])] v
+        assertVarUsage "base" "GHC.Base" "map" [("resetAll",False,[13,10,13,13])] v
+        assertVarUsage "base" "GHC.Num" "fromInteger" [("reset",False,[11,23,11,24])] v
+        
+        assertTypeUsage "BWTest-0.1" "A" "MyData" [("MyData",True,[2,6,2,12]),("reset",False,[9,10,9,16]),("reset",False,[9,20,9,26]),("getString",False,[15,14,15,20])] v
+        assertTypeUsage "BWTest-0.1" "A" "MyString" [("mdS",False,[3,14,3,22]),("MyString",True,[7,6,7,14]),("getString",False,[15,30,15,38])] v
+        assertTypeUsage "base" "Data.Maybe" "Maybe" [("getString",False,[15,24,15,29])] v
+        assertTypeUsage "base" "GHC.Base" "String" [("MyString",False,[7,15,7,21])] v
+        assertTypeUsage "base" "GHC.Show" "Show" [("MyData",False,[5,15,5,19])] v
+        assertTypeUsage "ghc-prim" "GHC.Types" "Int" [("Cons2",False,[4,15,4,18])] v
+        
+        vMain<-readStoredUsage (root </> ".dist-buildwrapper" </>  relMain)
+        --sUMain<-fmap formatJSON (readFile  $ getUsageFile(root </> ".dist-buildwrapper" </>  relMain))
+        --putStrLn sUMain
+        assertPackageModule "BWTest-0.1" "Main" [1,8,1,12] vMain
+        
+        assertVarUsage "BWTest-0.1" "A" "" [("import",False,[2,8,2,9])] vMain
+        assertVarUsage "BWTest-0.1" "A" "Cons2" [("main",False,[3,22,3,27])] vMain
+        assertVarUsage "BWTest-0.1" "A" "reset" [("main",False,[3,14,3,19])] vMain
+        assertVarUsage "BWTest-0.1" "Main" "main" [("main",True,[3,1,3,29])] vMain
+        assertVarUsage "base" "System.IO" "print" [("main",False,[3,6,3,11])] vMain
+        assertVarUsage "base" "GHC.Base" "$" [("main",False,[3,12,3,13]),("main",False,[3,20,3,21])] vMain
+        return ()
+        ))
+
+testGenerateReferencesImports :: (APIFacade a)=> a -> Test
+testGenerateReferencesImports api= TestLabel "testGenerateReferencesImports" (TestCase ( do
+        root<-createTestProject
+        let relMain="src"</>"Main.hs"
+        writeFile (root</> relMain) $ unlines [
+                  "module Main where",
+                  "import Data.Ord",
+                  "import Data.Maybe (Maybe(..))",
+                  "import Data.Complex (Complex((:+)))",
+                  "",
+                  "main=undefined"
+                  ] 
+        _<-synchronize api root True          
+        (BuildResult bool1 _,nsErrors1)<-build api root False Source
+        assertBool ("returned false on bool1:" ++ show nsErrors1)  bool1
+        assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
+        (comps,_)<-getCabalComponents api root    
+        mapM_ (generateUsage api root False) comps
+        vMain<-readStoredUsage (root </> ".dist-buildwrapper" </>  relMain)
+        -- sUMain<-fmap formatJSON (readFile  $ getUsageFile(root </> ".dist-buildwrapper" </>  relMain))
+        -- putStrLn sUMain
+        assertVarUsage "base" "Data.Ord" "" [("import",False,[2,8,2,16])] vMain
+        assertVarUsage "base" "Data.Maybe" "" [("import",False,[3,8,3,18])] vMain
+        assertVarUsage "base" "Data.Complex" "" [("import",False,[4,8,4,20])] vMain
+        assertTypeUsage "base" "Data.Maybe" "Maybe" [("import",False,[3,20,3,29])] vMain
+        assertTypeUsage "base" "Data.Complex" "Complex" [("import",False,[4,22,4,35])] vMain
+        assertVarUsage "base" "Data.Complex" ":+" [("import",False,[4,22,4,35])] vMain
+        ))
+
+testGenerateReferencesExports :: (APIFacade a)=> a -> Test
+testGenerateReferencesExports api= TestLabel "testGenerateReferencesExports" (TestCase ( do
+        root<-createTestProject
+        let rel="src" </> "A.hs"
+        writeFile (root</> rel) $ unlines [  
+                  "module A (",
+                  "    MyData,",
+                  "    MyData2(..),",
+                  "    MyData3(Cons31),",
+                  "    reset,",
+                  "    MyString,",
+                  "    module Data.Ord) where",
+                  "import Data.Ord",
+                  "data MyData=Cons1", 
+                  "      { mdS::MyString}", 
+                  "      | Cons2 Int",
+                  "     deriving Show",
+                  "",
+                  "type MyString=String",
+                  "",
+                  "reset :: MyData -> MyData",
+                  "reset (Cons1 _)=Cons1 \"\"",
+                  "reset (Cons2 _)=Cons2 0",
+                  "",
+                  "data MyData2=Cons21", 
+                  "      { mdS2::MyString}", 
+                  "      | Cons22 Int",
+                  "     deriving Show",
+                  "data MyData3=Cons31", 
+                  "      { mdS3::MyString}", 
+                  "      | Cons32 Int",
+                  "     deriving Show"
+                  ]  
+        _<-synchronize api root True          
+        (BuildResult bool1 _,nsErrors1)<-build api root False Source
+        assertBool ("returned false on bool1:" ++ show nsErrors1)  bool1
+        assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
+        (comps,_)<-getCabalComponents api root    
+        mapM_ (generateUsage api root False) comps
+        v<-readStoredUsage (root </> ".dist-buildwrapper" </>  rel)
+        --sU<-fmap formatJSON (readFile  $ getUsageFile(root </> ".dist-buildwrapper" </>  rel))
+        --putStrLn sU
+        
+        assertVarUsage "BWTest-0.1" "A" "Cons1" [("Cons1",True,[9,13,9,18]),("reset",False,[17,8,17,13]),("reset",False,[17,17,17,22])] v
+        assertVarUsage "BWTest-0.1" "A" "Cons2" [("Cons2",True,[11,9,11,14]),("reset",False,[18,8,18,13]),("reset",False,[18,17,18,22])] v
+        assertVarUsage "BWTest-0.1" "A" "Cons21" [("Cons21",True,[20,14,20,20])] v
+        assertVarUsage "BWTest-0.1" "A" "Cons22" [("Cons22",True,[22,9,22,15])] v
+        assertVarUsage "BWTest-0.1" "A" "Cons31" [("export",False,[4,5,4,20]),("Cons31",True,[24,14,24,20])] v
+        assertVarUsage "BWTest-0.1" "A" "Cons32" [("Cons32",True,[26,9,26,15])] v
+        assertVarUsage "BWTest-0.1" "A" "mdS" [("mdS",True,[10,9,10,12])] v
+        assertVarUsage "BWTest-0.1" "A" "mdS2" [("mdS2",True,[21,9,21,13])] v
+        assertVarUsage "BWTest-0.1" "A" "mdS3" [("mdS3",True,[25,9,25,13])] v
+        assertVarUsage "BWTest-0.1" "A" "reset" [("export",False,[5,5,5,10]),("reset",True,[16,1,16,6]),("reset",True,[17,1,17,25]),("reset",True,[18,1,18,24])] v
+        assertVarUsage "base" "GHC.Num" "fromInteger" [("reset",False,[18,23,18,24])] v
+        
+        assertVarUsage "base" "Data.Ord" "" [("export",False,[7,5,7,20]),("import",False,[8,8,8,16])] v
+        
+        assertTypeUsage "BWTest-0.1" "A" "MyData" [("export",False,[2,5,2,11]),("MyData",True,[9,6,9,12]),("reset",False,[16,10,16,16]),("reset",False,[16,20,16,26])] v
+        assertTypeUsage "BWTest-0.1" "A" "MyString" [("export",False,[6,5,6,13]),("mdS",False,[10,14,10,22]),("MyString",True,[14,6,14,14]),("mdS2",False,[21,15,21,23]),("mdS3",False,[25,15,25,23])] v
+        assertTypeUsage "base" "GHC.Base" "String" [("MyString",False,[14,15,14,21])] v
+        assertTypeUsage "base" "GHC.Show" "Show" [("MyData",False,[12,15,12,19]),("MyData2",False,[23,15,23,19]),("MyData3",False,[27,15,27,19])] v
+        assertTypeUsage "BWTest-0.1" "A" "MyData2" [("export",False,[3,5,3,16]),("MyData2",True,[20,6,20,13])] v
+        assertTypeUsage "BWTest-0.1" "A" "MyData3" [("export",False,[4,5,4,20]),("MyData3",True,[24,6,24,13])] v
+        assertTypeUsage "ghc-prim" "GHC.Types" "Int" [("Cons2",False,[11,15,11,18]),("Cons22",False,[22,16,22,19]),("Cons32",False,[26,16,26,19])] v
+        ))        
+ 
+testGenerateReferencesExportAlias :: (APIFacade a)=> a -> Test
+testGenerateReferencesExportAlias api= TestLabel "testGenerateReferencesExportAlias" (TestCase ( do
+        root<-createTestProject
+        let relMain="src"</>"Main.hs"
+        writeFile (root</> relMain) $ unlines [
+                  "module Main (module X,main) where",
+                  "import Data.Ord as X",
+                  "",
+                  "main=undefined"
+                  ] 
+        _<-synchronize api root True          
+        (BuildResult bool1 _,nsErrors1)<-build api root False Source
+        assertBool ("returned false on bool1:" ++ show nsErrors1)  bool1
+        assertBool "no errors or warnings on nsErrors1" (null nsErrors1)
+        (comps,_)<-getCabalComponents api root    
+        mapM_ (generateUsage api root False) comps
+        vMain<-readStoredUsage (root </> ".dist-buildwrapper" </>  relMain)
+        -- sUMain<-fmap formatJSON (readFile  $ getUsageFile(root </> ".dist-buildwrapper" </>  relMain))
+        -- putStrLn sUMain
+        assertVarUsage "base" "Data.Ord" "" [("export",False,[1,14,1,22]),("import",False,[2,8,2,16])] vMain
+        )) 
+    
+testIncorrectModuleFileName :: (APIFacade a)=> a -> Test
+testIncorrectModuleFileName api= TestLabel "testIncorrectModuleFileName" (TestCase ( do
+        root<-createTestProject
+        let relMain="src"</>"Main.hs"
+        let relMain2="src"</>"Main-exe.hs"
+        renameFile (root </> relMain) (root </> relMain2)
+        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.C",
+                "  build-depends:  base",
+                "",
+                "executable BWTest",
+                "  hs-source-dirs:  src",
+                "  main-is:         Main-exe.hs",
+                "  other-modules:  B.D",
+                "  build-depends:  base",
+                "",
+                "test-suite BWTest-test",
+                "  type:            exitcode-stdio-1.0",
+                "  hs-source-dirs:  test",
+                "  main-is:         Main.hs",
+                "  other-modules:  TestA",
+                "  build-depends:  base",
+                ""
+                ]        
+        synchronize api root False  
+        configure api root Target  
+        (comps,_)<-getCabalComponents api root    
+        gar<-mapM (generateUsage api root False) comps       
+        let fs=concat $ mapMaybe fst gar
+        assertBool "fs doesn't contain relMain2" (relMain2 `elem` fs)
+        ))
+        
+getUsageFile :: FilePath -- ^ the source file
+        -> FilePath
+getUsageFile fp= let 
+        (dir,file)=splitFileName fp
+        in combine dir ('.' : addExtension file ".bwusage")      
+        
+readStoredUsage :: FilePath  -- ^ the source file
+        -> IO Value
+readStoredUsage =readJSONFile . getUsageFile
+
+  
+readJSONFile :: FilePath -> IO Value
+readJSONFile f= do
+       ex<-doesFileExist f
+       mv<-if ex
+                then do
+                       bs<-BSS.readFile f
+                       return $ decode' $ BS.fromChunks [bs]
+                else return Nothing
+       return $ fromMaybe (object []) mv
+       
+getInfoFile :: FilePath -- ^ the source file
+        -> FilePath
+getInfoFile fp= let 
+        (dir,file)=splitFileName fp
+        in combine dir ('.' : addExtension file ".bwinfo")      
+        
+-- | read the top JSON value containing all the information
+readStoredInfo :: FilePath  -- ^ the source file
+        -> IO Value
+readStoredInfo =readJSONFile . getInfoFile 
+
+extractNameValue :: Value -> T.Text
+extractNameValue (Object m) |Just (String s)<-HM.lookup "Name" m=s
+extractNameValue _ = error "no name in value"
+
+assertVarUsage :: T.Text -> T.Text -> T.Text -> [(T.Text,Bool,[Int])] -> Value -> IO() 
+assertVarUsage = assertUsage "vars"
+
+assertTypeUsage :: T.Text -> T.Text -> T.Text -> [(T.Text,Bool,[Int])] -> Value -> IO() 
+assertTypeUsage = assertUsage "types"
+
+
+assertUsage :: T.Text -> T.Text -> T.Text -> T.Text -> [(T.Text,Bool,[Int])] -> Value -> IO()
+assertUsage tp pkg modu name lins (Array v) |
+        V.length v==5,
+        (Object m) <-v V.! 3,
+        Just (Object m2)<-HM.lookup pkg m,
+        Just (Object m3)<-HM.lookup modu m2,
+        Just (Object m4)<-HM.lookup tp m3,
+        Just (Array arr)<-HM.lookup name m4=   do
+                let expected=S.fromList $ map (\(section,def,[sl,sc,el,ec])->(section,def,InFileSpan (InFileLoc sl sc) (InFileLoc el ec))) lins
+                let actual=S.fromList $ map (\v2->
+                        let (Success r)=Data.Aeson.Types.parse (\(Object o) ->do 
+                                --Success (Object o)<-fromJSON v 
+                                (String section)<-o .: "s"
+                                (Bool def)<-o .: "d"
+                                arr2<-o .: "l"
+                                let (Success ifl)=fromJSON arr2
+                                return (section,def,ifl::InFileSpan)) v2
+                        in r) $ V.toList arr
+                assertEqual (T.unpack modu ++ "." ++ T.unpack name ++ ": " ++ show lins) expected actual  
+        --V.elem (Number (I line)) arr=return ()
+assertUsage _ _ modu name line _=assertBool (T.unpack modu ++ "." ++ T.unpack name ++ ": " ++ show line) False
+
+assertPackageModule :: T.Text -> T.Text -> [Int] -> Value -> IO()
+assertPackageModule pkg modu [sl,sc,el,ec] (Array v) |
+         V.length v==5,
+        (String s0) <-v V.! 0,
+        (String s1) <-v V.! 1,
+        arr<- v V.! 2= do
+                assertEqual (T.unpack pkg) pkg s0
+                assertEqual (T.unpack modu) modu s1  
+                let (Success ifs)=fromJSON arr
+                assertEqual (show ifs) (InFileSpan (InFileLoc sl sc) (InFileLoc el ec)) ifs  
+assertPackageModule pkg modu _ _=  assertBool (T.unpack pkg ++ "." ++ T.unpack modu) False

@@ -12,6 +12,7 @@ module Main where
 
 import Language.Haskell.BuildWrapper.APITest
+import Language.Haskell.BuildWrapper.UsagesTests
 import Language.Haskell.BuildWrapper.CMDTests
 import Language.Haskell.BuildWrapper.GHCTests
 
@@ -22,8 +23,10 @@ main = defaultMain tests
 
 tests :: [Test]
-tests = [testGroup "Unit Tests" (concatMap hUnitTestToTests unitTests)
-        ,testGroup "GHC Tests" (concatMap hUnitTestToTests ghcTests)
-        ,testGroup "Command Tests" (concatMap hUnitTestToTests cmdTests)
+tests = [
+        testGroup "Unit Tests" (concatMap hUnitTestToTests unitTests),
+        testGroup "GHC Tests" (concatMap hUnitTestToTests ghcTests),
+        testGroup "Command Tests" (concatMap hUnitTestToTests cmdTests),
+        testGroup "Usages Tests" (concatMap hUnitTestToTests usageTests)
         ]