buildwrapper 0.6.3 → 0.6.4

raw patch · 6 files changed

+116/−4 lines, 6 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• buildwrapper.cabal +1/−1
• src-exe/Language/Haskell/BuildWrapper/CMD.hs +9/−1
• src/Language/Haskell/BuildWrapper/API.hs +14/−0
• src/Language/Haskell/BuildWrapper/GHC.hs +20/−0
• src/Language/Haskell/BuildWrapper/GHCStorage.hs +27/−0
• test/Language/Haskell/BuildWrapper/CMDTests.hs +45/−2

@@ -1,5 +1,5 @@ name:           buildwrapper
-version:        0.6.3
+version:        0.6.4
 cabal-version:  >= 1.8
 build-type:     Simple
 license:        BSD3

@@ -41,6 +41,7 @@         | TokenTypes {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String} 
         | Occurrences {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath,token::String, component:: Maybe String}
         | ThingAtPointCmd {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, line::Int, column::Int, component:: Maybe String}
+        | Locals {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, sline::Int, scolumn::Int,eline::Int, ecolumn::Int, component:: Maybe String}
         | NamesInScope {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String], file:: FilePath, component:: Maybe String} 
         | Dependencies {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String]}
         | Components {tempFolder::TempFolder, cabalPath::CabalPath, cabalFile::CabalFile, cabalFlags::String, cabalOption::[String]}
@@ -102,6 +103,12 @@ mthingAtPoint=ThingAtPointCmd tf cp cf uf co fp 
         (def &= help "line" &= name "line")
         (def &= help "column" &= name "column") mcc
+mlocals :: BWCmd
+mlocals=Locals tf cp cf uf co fp 
+        (def &= help "start line" &= name "start line")
+        (def &= help "start column" &= name "start column")
+        (def &= help "end line" &= name "end line")
+        (def &= help "end column" &= name "end column") mcc
 mnamesInScope :: BWCmd
 mnamesInScope=NamesInScope tf cp cf uf co fp mcc
 mdependencies :: BWCmd
@@ -116,7 +123,7 @@ cmdMain = cmdArgs   (modes      [msynchronize, msynchronize1, mconfigure, mwrite, mbuild, mbuild1,-      mgetbf, moutline, mtokenTypes, moccurrences, mthingAtPoint,+      mgetbf, moutline, mtokenTypes, moccurrences, mthingAtPoint, mlocals,        mnamesInScope, mdependencies, mcomponents, mgenerateUsage]      &= helpArg [explicit, name "help", name "h"]      &= help "buildwrapper executable"@@ -137,6 +144,7 @@                 handle c@TokenTypes{file=fi}=runCmd c (getTokenTypes fi)
                 handle c@Occurrences{file=fi,token=t,component=mcomp}=runCmd c (getOccurrences fi t mcomp)
                 handle c@ThingAtPointCmd{file=fi,line=l,column=col,component=mcomp}=runCmd c (getThingAtPoint fi l col mcomp)
+                handle c@Locals{file=fi,sline=sl,scolumn=scol,eline=el,ecolumn=ecol,component=mcomp}=runCmd c (getLocals fi sl scol el ecol mcomp)
                 handle c@NamesInScope{file=fi,component=mcomp}=runCmd c (getNamesInScope fi mcomp)
                 handle c@Dependencies{}=runCmd c getCabalDependencies
                 handle c@Components{}=runCmd c getCabalComponents

@@ -468,6 +468,20 @@         return $ case mm of 
                 (Just m,ns)->(m,ns)
                 (Nothing,ns)-> (Nothing,ns)
+
+-- | get locals identifiers
+getLocals :: FilePath -- ^ the source file
+        -> Int -- ^ the start line
+        -> Int -- ^ the start column
+        -> Int -- ^ the end line
+        -> Int -- ^ the end column
+        -> Maybe String -- ^ the cabal component to use, or Nothing if not specified 
+        -> BuildWrapper (OpResult ([ThingAtPoint]))
+getLocals fp sline scol eline ecol mccn=do
+        mm<-withGHCAST fp mccn $ BwGHC.getLocalsJSON sline scol eline ecol
+        return $ case mm of 
+                (Just m,ns)->(m,ns)
+                (Nothing,ns)-> ([],ns)
                 
 -- | get all names in scope (GHC API)                
 getNamesInScope :: FilePath

@@ -320,6 +320,26 @@             ) fp base_dir modul options
         return $ fromMaybe Nothing mmf
    
+-- | get the "thing" at a particular point (line/column) in the source
+-- this is using the saved JSON info if available
+getLocalsJSON ::Int  -- ^ start line
+        -> Int -- ^ start column
+        -> Int  -- ^ end line
+        -> Int -- ^ end column
+        -> FilePath -- ^ source file path
+        -> FilePath -- ^ base directory
+        -> String  -- ^ module name
+        -> [String] -- ^  build flags
+        -> IO ([ThingAtPoint])
+getLocalsJSON sline scol eline ecol fp base_dir modul options= do
+        mmf<-withJSONAST (\v->do
+                let cont=contains sline (scionColToGhcCol scol) eline (scionColToGhcCol ecol)
+                let isVar=isGHCType "Var"
+                let mf=findAllInJSON (\x->cont x && isVar x) v
+                return $ mapMaybe (findInJSONData . Just) mf  
+            ) fp base_dir modul options
+        return $ fromMaybe [] mmf  
+  
   
 -- | convert a GHC SrcSpan to a Span,  ignoring the actual file info
 ghcSpanToLocation ::GHC.SrcSpan

@@ -465,6 +465,13 @@ findInJSON f (Array vals)=listToMaybe $ sortBy lastPos $ filter f $ V.toList vals
 findInJSON _ _=Nothing
 
+-- | find in JSON AST
+findAllInJSON :: FindFunc -- ^ the evaluation function  
+        -> Value -- ^ the root object containing the AST 
+        -> [Value]
+findAllInJSON f (Array vals)=filter f $ V.toList vals
+findAllInJSON _ _=[]
+
 -- | sort Value by position, descending        
 lastPos :: Value -> Value -> Ordering
 lastPos (Object m1) (Object m2) |
@@ -486,6 +493,26 @@         Just pos<-HM.lookup "Pos" m,
         Success ifs <- fromJSON pos=iflOverlap ifs (InFileLoc l c)
 overlap _ _ _=False
+
+-- | contains function: find whatever is contained inside the given span
+contains :: Int  -- ^ start line
+        -> Int -- ^ start column
+        -> Int  -- ^ end line
+        -> Int -- ^ end column
+        -> FindFunc
+contains sl sc el ec (Object m) | 
+        Just pos<-HM.lookup "Pos" m,
+        Success ifs <- fromJSON pos=iflOverlap (InFileSpan (InFileLoc sl sc) (InFileLoc el ec)) (ifsStart ifs)
+contains _ _ _ _ _=False
+
+-- | isGHCType function: find whatever has the proper GHCType
+isGHCType :: String --  ^ the type
+        -> FindFunc
+isGHCType tp (Object m) | 
+        Just pos<-HM.lookup "GType" m,
+        Success ghcType <- fromJSON pos=tp == ghcType
+isGHCType _ _ =False
+
 
 extractUsages :: Value -- ^ the root object containing the AST 
         -> [Value]

@@ -1,6 +1,5 @@ {-# LANGUAGE CPP, OverloadedStrings #-}
 {-# OPTIONS_GHC -F -pgmF htfpp #-}
-{-# LINE 3 "test/Language/Haskell/BuildWrapper/CMDTests.hs" #-}
 -- |
 -- Module      : Language.Haskell.BuildWrapper.CMDTests
 -- Author      : JP Moresmau
@@ -54,6 +53,7 @@         getTokenTypes :: a -> FilePath -> FilePath -> IO (OpResult [TokenDef])
         getOccurrences :: a -> FilePath -> FilePath -> String -> IO (OpResult [TokenDef])
         getThingAtPoint :: a -> FilePath -> FilePath -> Int -> Int -> IO (OpResult (Maybe ThingAtPoint))
+        getLocals :: a -> FilePath -> FilePath -> Int -> Int -> Int -> Int -> IO (OpResult [ThingAtPoint])
         getNamesInScope :: a -> FilePath -> FilePath-> IO (OpResult (Maybe [String]))
         getCabalDependencies :: a -> FilePath -> IO (OpResult [(FilePath,[CabalPackage])])
         getCabalComponents :: a -> FilePath -> IO (OpResult [CabalComponent])
@@ -76,6 +76,7 @@         getTokenTypes _ r fp= runAPI r "tokentypes" ["--file="++fp]
         getOccurrences _ r fp s= runAPI r "occurrences" ["--file="++fp,"--token="++s]
         getThingAtPoint _ r fp l c= fmap removeLayoutTAP $ runAPI r "thingatpoint" ["--file="++fp,"--line="++ show l,"--column="++ show c]
+        getLocals _ r fp sl sc el ec= runAPI r "locals" ["--file="++fp,"--sline="++ show sl,"--scolumn="++ show sc,"--eline="++ show el,"--ecolumn="++ show ec]
         getNamesInScope _ r fp= runAPI r "namesinscope" ["--file="++fp]
         getCabalDependencies _ r= runAPI r "dependencies" []
         getCabalComponents _ r= runAPI r "components" []
@@ -1186,7 +1187,48 @@         assertEqual (Just "GHC.List") (tapModule $ fromJust tap1)
         assertEqual (Just "[GHC.Integer.Type.Integer] -> GHC.Integer.Type.Integer") (tapQType $ fromJust tap1)
       
+test_Locals :: Assertion
+test_Locals = do+        let api=CMDAPI
+        root<-createTestProject
+        synchronize api root False
+        configure api root Target        
+        let rel="src"</>"Main.hs"
+        write api root rel $ unlines [  
+                  "module Main where",
+                  "main=return $ map id \"toto\"",
+                  "",
+                  "fun1 l1=let",
+                  "    l2=reverse \"toto\"",
+                  "    in head l2"
+                  ] 
+        (_,nsErrors)<-getBuildFlags api root rel
+        assertBool (null nsErrors)      
+        (loc1,nsErrors1)<-getLocals api root rel 4 1 6 15
+        assertBool (null nsErrors1)
+        assertBool (not $ null loc1)
+        let names=map tapName loc1
+        assertBool (elem "l2" names)
+        assertBool (elem "l1" names)
+        write api root rel $ unlines [  
+                  "module Main where",
+                  "main=return $ map id \"toto\"",
+                  "",
+                  "fun1 l1=do",
+                  "    let l2=reverse \"toto\"",
+                  "    reverse head l2"
+                  ] 
+        (_,nsErrorsM)<-getBuildFlags api root rel
+        assertBool (null nsErrorsM)      
+        (loc2,nsErrors2)<-getLocals api root rel 4 1 6 15
+        assertBool (null nsErrors2)
+        assertBool (not $ null loc2)
+        let namesM=map tapName loc2
+        assertBool (elem "l2" namesM)
+        assertBool (elem "l1" namesM)+        return () 
+
 test_NamesInScope :: Assertion
 test_NamesInScope = do
         let api=CMDAPI
@@ -1679,7 +1721,8 @@                         _ -> res
  where removeLayout (Just tp) = Just $ unwords . concatMap words . lines $ tp -- replace sequences of spaces and newlines by single space
        removeLayout Nothing   = Nothing
-                
+
+
 runAPI:: (FromJSON a,Show a) => FilePath -> String -> [String] -> IO a
 runAPI root command args= do
         cd<-getCurrentDirectory