Cleaning of case splitting code
This commit is contained in:
parent
2ab6991d95
commit
edfe0c8ef3
@ -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
|
||||
|
@ -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
|
||||
|
Loading…
Reference in New Issue
Block a user