Cleaning of case splitting code
This commit is contained in:
parent
2ab6991d95
commit
edfe0c8ef3
@ -6,14 +6,12 @@ module Language.Haskell.GhcMod.CaseSplit (
|
|||||||
, splits
|
, splits
|
||||||
) where
|
) where
|
||||||
|
|
||||||
import Data.Char (isSymbol)
|
|
||||||
import Data.List (find, intercalate)
|
import Data.List (find, intercalate)
|
||||||
import qualified Data.Text as T
|
import qualified Data.Text as T
|
||||||
import qualified Data.Text.IO as T (readFile)
|
import qualified Data.Text.IO as T (readFile)
|
||||||
import Exception (ghandle, SomeException(..))
|
import Exception (ghandle, SomeException(..))
|
||||||
import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
|
import GHC (Ghc, LHsBind, LHsExpr, LPat, Id, ParsedModule(..), TypecheckedModule(..), DynFlags, SrcSpan, Type, GenLocated(L))
|
||||||
import qualified GHC as G
|
import qualified GHC as G
|
||||||
import Language.Haskell.GhcMod.Doc (showOneLine)
|
|
||||||
import Language.Haskell.GhcMod.GHCApi
|
import Language.Haskell.GhcMod.GHCApi
|
||||||
import Language.Haskell.GhcMod.Gap (HasType(..))
|
import Language.Haskell.GhcMod.Gap (HasType(..))
|
||||||
import qualified Language.Haskell.GhcMod.Gap as Gap
|
import qualified Language.Haskell.GhcMod.Gap as Gap
|
||||||
@ -25,10 +23,6 @@ import Outputable (PprStyle)
|
|||||||
import qualified Type as Ty
|
import qualified Type as Ty
|
||||||
import qualified TyCon as Ty
|
import qualified TyCon as Ty
|
||||||
import qualified DataCon 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
|
-- CASE SPLITTING
|
||||||
@ -63,16 +57,16 @@ splits 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
|
||||||
splitInfo <- getSrcSpanTypeForSplit modSum lineNo colNo
|
whenFound' opt (getSrcSpanTypeForSplit modSum lineNo colNo) $
|
||||||
case splitInfo of
|
\(SplitInfo varName (bndLoc,_) (varLoc,varT) matches) -> do
|
||||||
Nothing -> return $ convert opt ([] :: [String])
|
|
||||||
Just (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 matches $
|
||||||
getTyCons dflag style varName varT)
|
getTyCons dflag style varName varT)
|
||||||
return $ convert opt $ ( fourInts bndLoc
|
return (fourInts bndLoc, text)
|
||||||
, text)
|
handler (SomeException _) = emptyResult opt
|
||||||
handler (SomeException _) = return $ convert opt ([] :: [String])
|
|
||||||
|
----------------------------------------------------------------
|
||||||
|
-- a. Code for getting the information of the variable
|
||||||
|
|
||||||
getSrcSpanTypeForSplit :: G.ModSummary -> Int -> Int -> Ghc (Maybe SplitInfo)
|
getSrcSpanTypeForSplit :: G.ModSummary -> Int -> Int -> Ghc (Maybe SplitInfo)
|
||||||
getSrcSpanTypeForSplit modSum lineNo colNo = do
|
getSrcSpanTypeForSplit modSum lineNo colNo = do
|
||||||
@ -101,6 +95,7 @@ getPatternVarName (L _ (G.VarPat vName)) = G.getName vName
|
|||||||
getPatternVarName _ = error "This should never happend"
|
getPatternVarName _ = error "This should never happend"
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
-- b. Code for getting the possible constructors
|
||||||
|
|
||||||
getTyCons :: DynFlags -> PprStyle -> G.Name -> G.Type -> [String]
|
getTyCons :: DynFlags -> PprStyle -> G.Name -> G.Type -> [String]
|
||||||
getTyCons dflag style name ty | Just (tyCon, _) <- Ty.splitTyConApp_maybe ty =
|
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
|
_ -> fAcc ++ ", " ++ showFieldNames dflag style v xs
|
||||||
|
|
||||||
----------------------------------------------------------------
|
----------------------------------------------------------------
|
||||||
|
-- c. Code for performing the case splitting
|
||||||
|
|
||||||
genCaseSplitTextFile :: FilePath -> SplitToTextInfo -> Ghc String
|
genCaseSplitTextFile :: FilePath -> SplitToTextInfo -> Ghc String
|
||||||
genCaseSplitTextFile file info = liftIO $ do
|
genCaseSplitTextFile file info = liftIO $ do
|
||||||
|
@ -1,6 +1,6 @@
|
|||||||
{-# LANGUAGE FlexibleInstances, FlexibleContexts, OverlappingInstances #-}
|
{-# 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.Monad
|
||||||
import Language.Haskell.GhcMod.Types
|
import Language.Haskell.GhcMod.Types
|
||||||
@ -123,3 +123,7 @@ emptyResult opt = return $ convert opt ([] :: [String])
|
|||||||
-- Return an emptyResult when Nothing
|
-- Return an emptyResult when Nothing
|
||||||
whenFound :: (Monad m, ToString b) => Options -> m (Maybe a) -> (a -> b) -> m String
|
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
|
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