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 (
splitVar
, splits
@ -32,7 +29,6 @@ data SplitInfo = SplitInfo G.Name (SrcSpan,Type) (SrcSpan, Type) [SrcSpan]
data SplitToTextInfo = SplitToTextInfo { sVarName :: String
, sBindingSpan :: SrcSpan
, sVarSpan :: SrcSpan
, sMatchesSpan :: [SrcSpan]
, sTycons :: [String]
}
@ -58,9 +54,9 @@ splits opt file lineNo colNo = ghandle handler body
body = inModuleContext file $ \dflag style -> do
modSum <- Gap.fileModSummary file
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
text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc matches $
text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc $
getTyCons dflag style varName varT)
return (fourInts bndLoc, text)
handler (SomeException _) = emptyResult opt
@ -183,10 +179,11 @@ genCaseSplitTextFile file info = liftIO $ do
return $ getCaseSplitText (T.lines text) info
getCaseSplitText :: [T.Text] -> SplitToTextInfo -> String
getCaseSplitText text (SplitToTextInfo { .. }) =
let bindingText = getBindingText text sBindingSpan
difference = srcSpanDifference sBindingSpan sVarSpan
replaced = concatMap (replaceVarWithTyCon bindingText difference sVarName) sTycons
getCaseSplitText text (SplitToTextInfo { sVarName = sVN, sBindingSpan = sBS
, sVarSpan = sVS, sTycons = sT }) =
let bindingText = getBindingText text sBS
difference = srcSpanDifference sBS sVS
replaced = concatMap (replaceVarWithTyCon bindingText difference sVN) sT
in T.unpack $ T.intercalate (T.pack "\n") replaced
getBindingText :: [T.Text] -> SrcSpan -> [T.Text]

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

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