hasufell/ghc-mod
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Cleaning of case splitting code

Browse Source
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
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

28
Language/Haskell/GhcMod/CaseSplit.hs
View File

@ -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]) let varName' = showName dflag style varName -- Convert name to string
Just (SplitInfo varName (bndLoc,_) (varLoc,varT) matches) -> do text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc matches $
let varName' = showName dflag style varName -- Convert name to string getTyCons dflag style varName varT)
text <- genCaseSplitTextFile file (SplitToTextInfo varName' bndLoc varLoc matches $ return (fourInts bndLoc, text)
getTyCons dflag style varName varT) handler (SomeException _) = emptyResult opt
return $ convert opt $ ( fourInts bndLoc
, text) ----------------------------------------------------------------
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

6
Language/Haskell/GhcMod/Convert.hs
View File

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