Permalink
Browse files

section names

  • Loading branch information...
1 parent 452b27c commit e631abfc13a740f834dbe07b43f1e3d6e6f2dd93 @JPMoresmau committed May 7, 2012
View
@@ -80,7 +80,7 @@ executable buildwrapper
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
@@ -107,7 +107,7 @@ test-suite buildwrapper-test
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,
@@ -153,9 +153,10 @@ generateUsage returnAll ccn= do
case mast of
Just (ParseOk ast)->do
let ods=getHSEOutline ast
- liftIO $ Prelude.print ods
+ --liftIO $ Prelude.print ods
let val=reconcile pkg vals ods ius
- let valWithModule=Array $ V.fromList [toJSON pkg,toJSON modu,val]
+ let modLoc=maybe Null toJSON (getModuleLocation ast)
+ let valWithModule=Array $ V.fromList [toJSON pkg,toJSON modu,modLoc,val]
liftIO $ setUsageInfo tgt valWithModule
return ()
_ -> return ()
@@ -784,6 +784,7 @@ end (UnhelpfulSpan _)=error "UnhelpfulSpan in cmpOverlap start"
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
@@ -148,6 +148,14 @@ getHSEOutline (Module _ _ _ _ decls,comments)=map addComment $ concatMap declOut
in od2{od_children=map addComment $ od_children 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
@@ -111,7 +111,7 @@ testGenerateReferencesSimple api= TestLabel "testGenerateReferencesSimple" (Test
sU<-fmap formatJSON (readFile $ getUsageFile(root </> ".dist-buildwrapper" </> rel))
-- putStrLn sU
- assertPackageModule "BWTest-0.1" "A" v
+ 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
@@ -134,7 +134,7 @@ testGenerateReferencesSimple api= TestLabel "testGenerateReferencesSimple" (Test
vMain<-readStoredUsage (root </> ".dist-buildwrapper" </> relMain)
--sUMain<-fmap formatJSON (readFile $ getUsageFile(root </> ".dist-buildwrapper" </> relMain))
--putStrLn sUMain
- assertPackageModule "BWTest-0.1" "Main" vMain
+ 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
@@ -347,8 +347,8 @@ 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==3,
- (Object m) <-v V.! 2,
+ V.length v==4,
+ (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,
@@ -367,11 +367,14 @@ assertUsage tp pkg modu name lins (Array v) |
--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 -> Value -> IO()
-assertPackageModule pkg modu (Array v) |
- V.length v==3,
+assertPackageModule :: T.Text -> T.Text -> [Int] -> Value -> IO()
+assertPackageModule pkg modu [sl,sc,el,ec] (Array v) |
+ V.length v==4,
(String s0) <-v V.! 0,
- (String s1) <-v V.! 1= do
+ (String s1) <-v V.! 1,
+ arr<- v V.! 2= do
assertEqual (T.unpack pkg) pkg s0
- assertEqual (T.unpack modu) modu s1
-assertPackageModule pkg modu _= assertBool (T.unpack pkg ++ "." ++ T.unpack modu) False
+ 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

0 comments on commit e631abf

Please sign in to comment.