diff --git a/Language/Haskell/GhcMod/CaseSplit.hs b/Language/Haskell/GhcMod/CaseSplit.hs index 3ebaab8..951b4b4 100644 --- a/Language/Haskell/GhcMod/CaseSplit.hs +++ b/Language/Haskell/GhcMod/CaseSplit.hs @@ -6,14 +6,12 @@ module Language.Haskell.GhcMod.CaseSplit ( , splits ) where -import Data.Char (isSymbol) import Data.List (find, intercalate) import qualified Data.Text as T import qualified Data.Text.IO as T (readFile) import Exception (ghandle, SomeException(..)) import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L)) import qualified GHC as G -import Language.Haskell.GhcMod.Doc (showOneLine) import Language.Haskell.GhcMod.GHCApi import Language.Haskell.GhcMod.Gap (HasType(..)) import qualified Language.Haskell.GhcMod.Gap as Gap @@ -25,10 +23,6 @@ import Outputable (PprStyle) import qualified Type as Ty import qualified TyCon as Ty import qualified DataCon as Ty -import qualified HsBinds as Ty -import qualified Class as Ty -import OccName (OccName, occName) -import qualified Language.Haskell.Exts.Annotated as HE ---------------------------------------------------------------- -- CASE SPLITTING @@ -63,16 +57,16 @@ splits opt file lineNo colNo = ghandle handler body where body = inModuleContext file $ \dflag style -> do modSum <- Gap.fileModSummary file - splitInfo <- getSrcSpanTypeForSplit modSum lineNo colNo - case splitInfo of - Nothing -> return $ convert opt ([] :: [String]) - Just (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 $ - getTyCons dflag style varName varT) - return $ convert opt $ ( fourInts bndLoc - , text) - handler (SomeException _) = return $ convert opt ([] :: [String]) + whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $ + \(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 $ + getTyCons dflag style varName varT) + return (fourInts bndLoc, text) + handler (SomeException _) = emptyResult opt + +---------------------------------------------------------------- +-- a. Code for getting the information of the variable getSrcSpanTypeForSplit :: G.ModSummary -> Int -> Int -> Ghc (Maybe SplitInfo) getSrcSpanTypeForSplit modSum lineNo colNo = do @@ -80,7 +74,7 @@ getSrcSpanTypeForSplit modSum lineNo colNo = do tcm@TypecheckedModule{tm_typechecked_source = tcs} <- G.typecheckModule p let bs:_ = listifySpans tcs (lineNo, colNo) :: [LHsBind Id] varPat = find isPatternVar $ listifySpans tcs (lineNo, colNo) :: Maybe (LPat Id) - match:_ = listifyParsedSpans pms (lineNo, colNo) :: [G.LMatch G.RdrName (LHsExpr G.RdrName)] + match:_ = listifyParsedSpans pms (lineNo, colNo) :: [G.LMatch G.RdrName (LHsExpr G.RdrName)] case varPat of Nothing -> return Nothing Just varPat' -> do @@ -101,6 +95,7 @@ getPatternVarName (L _ (G.VarPat vName)) = G.getName vName getPatternVarName _ = error "This should never happend" ---------------------------------------------------------------- +-- b. Code for getting the possible constructors getTyCons :: DynFlags -> PprStyle -> G.Name -> G.Type -> [String] getTyCons dflag style name ty | Just (tyCon, _) <- Ty.splitTyConApp_maybe ty = @@ -180,6 +175,7 @@ showFieldNames dflag style v (x:xs) = let fName = showName dflag style x _ -> fAcc ++ ", " ++ showFieldNames dflag style v xs ---------------------------------------------------------------- +-- c. Code for performing the case splitting genCaseSplitTextFile :: FilePath -> SplitToTextInfo -> Ghc String genCaseSplitTextFile file info = liftIO $ do diff --git a/Language/Haskell/GhcMod/Convert.hs b/Language/Haskell/GhcMod/Convert.hs index 6b0195e..e348eca 100644 --- a/Language/Haskell/GhcMod/Convert.hs +++ b/Language/Haskell/GhcMod/Convert.hs @@ -1,6 +1,6 @@ {-# LANGUAGE FlexibleInstances, FlexibleContexts, OverlappingInstances #-} -module Language.Haskell.GhcMod.Convert (convert, convert', emptyResult, whenFound) where +module Language.Haskell.GhcMod.Convert (convert, convert', emptyResult, whenFound, whenFound') where import Language.Haskell.GhcMod.Monad import Language.Haskell.GhcMod.Types @@ -123,3 +123,7 @@ emptyResult opt = return $ convert opt ([] :: [String]) -- Return an emptyResult when Nothing whenFound :: (Monad m, ToString b) => Options -> m (Maybe a) -> (a -> b) -> m String whenFound opt from f = maybe (emptyResult opt) (return . convert opt . f) =<< from + +-- Return an emptyResult when Nothing, inside a monad +whenFound' :: (Monad m, ToString b) => Options -> m (Maybe a) -> (a -> m b) -> m String +whenFound' opt from f = maybe (emptyResult opt) (\x -> do y <- f x ; return (convert opt y)) =<< from