Cleaning of case splitting code

This commit is contained in:
Alejandro Serrano 2014-06-27 19:06:20 +02:00
parent 2ab6991d95
commit edfe0c8ef3
2 changed files with 18 additions and 18 deletions

View File

@ -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
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 $ convert opt $ ( fourInts bndLoc
, text)
handler (SomeException _) = return $ convert opt ([] :: [String])
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
@ -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

View File

@ -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