hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Remove code with extensions not present < ghc 7.8

Browse Source
This commit is contained in:
Alejandro Serrano 2014-06-27 19:32:05 +02:00
parent edfe0c8ef3
commit 871f72fca4
2 changed files with 24 additions and 26 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

17
Language/Haskell/GhcMod/CaseSplit.hs
View File

@ -1,6 +1,3 @@
{-# LANGUAGE LambdaCase, RecordWildCards
, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
module Language.Haskell.GhcMod.CaseSplit ( module Language.Haskell.GhcMod.CaseSplit (
splitVar splitVar
, splits , splits
@ -32,7 +29,6 @@ data SplitInfo = SplitInfo G.Name (SrcSpan,Type) (SrcSpan, Type) [SrcSpan]
data SplitToTextInfo = SplitToTextInfo { sVarName :: String data SplitToTextInfo = SplitToTextInfo { sVarName :: String
, sBindingSpan :: SrcSpan , sBindingSpan :: SrcSpan
, sVarSpan :: SrcSpan , sVarSpan :: SrcSpan
, sMatchesSpan :: [SrcSpan]
, sTycons :: [String] , sTycons :: [String]
} }
@ -58,9 +54,9 @@ splits opt file lineNo colNo = ghandle handler body
body = inModuleContext file $ \dflag style -> do body = inModuleContext file $ \dflag style -> do
modSum <- Gap.fileModSummary file modSum <- Gap.fileModSummary file
whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $ whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $
\(SplitInfo varName (bndLoc,_) (varLoc,varT) matches) -> do \(SplitInfo varName (bndLoc,_) (varLoc,varT) _matches) -> do
let varName' = showName dflag style varName -- Convert name to string let varName' = showName dflag style varName -- Convert name to string
text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc matches $ text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
getTyCons dflag style varName varT) getTyCons dflag style varName varT)
return (fourInts bndLoc, text) return (fourInts bndLoc, text)
handler (SomeException _) = emptyResult opt handler (SomeException _) = emptyResult opt
@ -183,10 +179,11 @@ genCaseSplitTextFile file info = liftIO $ do
return $ getCaseSplitText (T.lines text) info return $ getCaseSplitText (T.lines text) info
getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String
getCaseSplitText text (SplitToTextInfo { .. }) = getCaseSplitText text (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS
let bindingText = getBindingText text sBindingSpan , sVarSpan = sVS, sTycons = sT }) =
difference = srcSpanDifference sBindingSpan sVarSpan let bindingText = getBindingText text sBS
replaced = concatMap (replaceVarWithTyCon bindingText difference sVarName) sTycons difference = srcSpanDifference sBS sVS
replaced = concatMap (replaceVarWithTyCon bindingText difference sVN) sT
in T.unpack $ T.intercalate (T.pack "\n") replaced in T.unpack $ T.intercalate (T.pack "\n") replaced
getBindingText :: [T.Text] -> SrcSpan -> [T.Text] getBindingText :: [T.Text] -> SrcSpan -> [T.Text]

33
Language/Haskell/GhcMod/FillSig.hs
View File

@ -1,5 +1,4 @@
{-# LANGUAGE LambdaCase, RecordWildCards {-# LANGUAGE MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
, MultiParamTypeClasses, FunctionalDependencies, FlexibleInstances #-}
module Language.Haskell.GhcMod.FillSig ( module Language.Haskell.GhcMod.FillSig (
fillSig fillSig
@ -56,12 +55,12 @@ sig opt file lineNo colNo = ghandle handler body
where where
body = inModuleContext file $ \dflag style -> do body = inModuleContext file $ \dflag style -> do
modSum <- Gap.fileModSummary file modSum <- Gap.fileModSummary file
whenFound opt (getSignature modSum lineNo colNo) $ whenFound opt (getSignature modSum lineNo colNo) $ \s -> case s of
\case Signature loc names ty -> Signature loc names ty ->
("function", fourInts loc, map (initialBody dflag style ty) names) ("function", fourInts loc, map (initialBody dflag style ty) names)
InstanceDecl loc cls -> do InstanceDecl loc cls -> do
("instance", fourInts loc, map (\x -> initialBody dflag style (G.idType x) x) ("instance", fourInts loc, map (\x -> initialBody dflag style (G.idType x) x)
(Ty.classMethods cls)) (Ty.classMethods cls))
handler (SomeException _) = do handler (SomeException _) = do
-- Code cannot be parsed by ghc module -- Code cannot be parsed by ghc module
@ -153,10 +152,11 @@ instance FnArgsInfo (G.HsType G.RdrName) (G.RdrName) where
getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy getFnArgs (G.HsForAllTy _ _ _ (L _ iTy)) = getFnArgs iTy
getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy getFnArgs (G.HsParTy (L _ iTy)) = getFnArgs iTy
getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy getFnArgs (G.HsFunTy (L _ lTy) (L _ rTy)) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
where fnarg = \case (G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy where fnarg = \ty -> case ty of
(G.HsParTy (L _ iTy)) -> fnarg iTy (G.HsForAllTy _ _ _ (L _ iTy)) -> fnarg iTy
(G.HsFunTy _ _) -> True (G.HsParTy (L _ iTy)) -> fnarg iTy
_ -> False (G.HsFunTy _ _) -> True
_ -> False
getFnArgs _ = [] getFnArgs _ = []
instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
@ -165,10 +165,11 @@ instance FnArgsInfo (HE.Type HE.SrcSpanInfo) (HE.Name HE.SrcSpanInfo) where
getFnArgs (HE.TyForall _ _ _ iTy) = getFnArgs iTy getFnArgs (HE.TyForall _ _ _ iTy) = getFnArgs iTy
getFnArgs (HE.TyParen _ iTy) = getFnArgs iTy getFnArgs (HE.TyParen _ iTy) = getFnArgs iTy
getFnArgs (HE.TyFun _ lTy rTy) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy getFnArgs (HE.TyFun _ lTy rTy) = (if fnarg lTy then FnArgFunction else FnArgNormal):getFnArgs rTy
where fnarg = \case (HE.TyForall _ _ _ iTy) -> fnarg iTy where fnarg = \ty -> case ty of
(HE.TyParen _ iTy) -> fnarg iTy (HE.TyForall _ _ _ iTy) -> fnarg iTy
(HE.TyFun _ _ _) -> True (HE.TyParen _ iTy) -> fnarg iTy
_ -> False (HE.TyFun _ _ _) -> True
_ -> False
getFnArgs _ = [] getFnArgs _ = []
instance FnArgsInfo Type Id where instance FnArgsInfo Type Id where