HaRe 0.7.0.9 → 0.7.1.0
raw patch · 9 files changed
+267/−497 lines, 9 files
Files
- HaRe.cabal +3/−2
- src/Language/Haskell/Refact/DupDef.hs +7/−4
- src/Language/Haskell/Refact/MoveDef.hs +10/−10
- src/Language/Haskell/Refact/Renaming.hs +5/−4
- src/Language/Haskell/Refact/Utils.hs +66/−99
- src/Language/Haskell/Refact/Utils/Monad.hs +165/−50
- src/Language/Haskell/Refact/Utils/MonadFunctions.hs +1/−19
- src/Language/Haskell/Refact/Utils/TypeUtils.hs +2/−308
- src/MainHaRe.hs +8/−1
HaRe.cabal view
@@ -1,5 +1,5 @@ Name: HaRe-Version: 0.7.0.9+Version: 0.7.1.0 Author: Chris Brown, Huiqing Li, Simon Thompson, Alan Zimmerman Maintainer: Alan Zimmerman Stability: Alpha@@ -74,7 +74,7 @@ GHC-Options: -Wall Hs-Source-Dirs: src- Other-Modules: Paths_HaRe+ -- Other-Modules: Paths_HaRe Exposed-modules: Language.Haskell.Refact.Case , Language.Haskell.Refact.DupDef@@ -98,6 +98,7 @@ , Language.Haskell.Refact.Utils.TokenUtilsTypes , Language.Haskell.Refact.Utils.TypeSyn , Language.Haskell.Refact.Utils.TypeUtils+ , Paths_HaRe Extensions: CPP
src/Language/Haskell/Refact/DupDef.hs view
@@ -166,15 +166,18 @@ -- | Do refactoring in the client module. That is to hide the -- identifer in the import declaration if it will cause any problem in -- the client module.-refactorInClientMod :: GHC.Name -> GHC.ModuleName -> GHC.Name -> GHC.ModSummary+refactorInClientMod :: GHC.Name -> GHC.ModuleName -> GHC.Name -> TargetModule -> RefactGhc ApplyRefacResult-refactorInClientMod oldPN serverModName newPName modSummary+refactorInClientMod oldPN serverModName newPName targetModule@(_,modSummary) = do logm ("refactorInClientMod: (serverModName,newPName)=" ++ (showGhc (serverModName,newPName))) -- ++AZ++ debug+ activateModule targetModule+ let fileName = gfromJust "refactorInClientMod" $ GHC.ml_hs_file $ GHC.ms_location modSummary+{- -- modInfo@(t,ts) <- getModuleGhc fileName getModuleGhc fileName-+-} renamed <- getRefactRenamed parsed <- getRefactParsed @@ -234,7 +237,7 @@ && not isQualified && (isNothing h -- not hiding ||- (isJust h && ((fst (fromJust h))==True))+ (isJust h && ((fst (gfromJust "willBeUnQualImportedBy" h))==True)) )) imps in if (emptyList ms) then Nothing
src/Language/Haskell/Refact/MoveDef.hs view
@@ -405,10 +405,10 @@ -- |Do refactoring in the client module. that is to hide the identifer -- in the import declaration if it will cause any problem in the -- client module.-liftingInClientMod :: GHC.ModuleName -> [GHC.Name] -> GHC.ModSummary+liftingInClientMod :: GHC.ModuleName -> [GHC.Name] -> TargetModule -> RefactGhc [ApplyRefacResult]-liftingInClientMod serverModName pns modSummary = do- getModuleDetails modSummary+liftingInClientMod serverModName pns targetModule@(_,modSummary) = do+ activateModule targetModule renamed <- getRefactRenamed -- logm $ "liftingInClientMod:renamed=" ++ (SYB.showData SYB.Renamer 0 renamed) -- ++AZ++ let clientModule = GHC.ms_mod modSummary@@ -419,7 +419,7 @@ logm $ "liftingInClientMod:modNames=" ++ (showGhc modNames) if isJust modNames then do- pns' <- namesNeedToBeHided clientModule (fromJust modNames) pns+ pns' <- namesNeedToBeHided clientModule (gfromJust "liftingInClientMod" modNames) pns logm $ "liftingInClientMod:pns'=" ++ (showGhc pns') -- in if pns' /= [] if (nonEmptyList pns')@@ -436,7 +436,7 @@ let (_,_,exps,_) = renamed in if isNothing exps then False- else any isJust $ map (\y-> (find (\x-> (simpModule x==Just y)) (fromJust exps))) names+ else any isJust $ map (\y-> (find (\x-> (simpModule x==Just y)) (gfromJust "willBeExportedByClientMod" exps))) names where simpModule (GHC.L _ (GHC.IEModuleContents m)) = Just m simpModule _ = Nothing @@ -873,10 +873,10 @@ -- b) If the identifier is not used but is hided by the import -- declaration, then remove it from the hiding. demotingInClientMod ::- [GHC.Name] -> GHC.ModSummary+ [GHC.Name] -> TargetModule -> RefactGhc ApplyRefacResult-demotingInClientMod pns modSummary = do- getModuleDetails modSummary+demotingInClientMod pns targetModule@(_,modSummary) = do+ activateModule targetModule (refactoredMod,_) <- applyRefac (doDemotingInClientMod pns (GHC.ms_mod modSummary)) RSAlreadyLoaded return refactoredMod @@ -1469,7 +1469,7 @@ where worker (GHC.Match pats1 typ rhs) = do let pats'=filter (\x->not ((patToPNT x /= Nothing) &&- elem (fromJust $ patToPNT x) ps)) pats1+ elem (gfromJust "rmParamsInDemotedDecls" $ patToPNT x) ps)) pats1 let (startPos,endPos) = getBiggestStartEndLoc pats1 -- error $ "rmParamsInDemotedDecls:(startPos,endPos)=" ++ (show (startPos,endPos)) -- ++AZ++@@ -1525,7 +1525,7 @@ mkSubst :: [GHC.LPat GHC.Name] -> [[GHC.HsExpr GHC.Name]] -> [(GHC.Name,GHC.HsExpr GHC.Name)] mkSubst pats1 params = catMaybes (zipWith (\x y -> if (patToPNT x/=Nothing) && (length (nub $ map showGhc y)==1)- then Just (fromJust $ patToPNT x,(ghead "mkSubst") y)+ then Just (gfromJust "mkSubst" $ patToPNT x,(ghead "mkSubst") y) else Nothing) pats1 params) {- = catMaybes (zipWith (\x y ->if (patToPN x/=defaultPN) && (length (nub y)==1)
src/Language/Haskell/Refact/Renaming.hs view
@@ -96,6 +96,7 @@ Just mn -> GHC.moduleName mn Nothing -> modName + -- TODO: why do we have this restriction? unless (defineMod == modName ) ( error ("This identifier is defined in module " ++ (show defineMod) ++ ", please do renaming in that module!")) -- logm $ "Renaming.comp:(isMainModule modu,pn)=" ++ (showGhc (isMainModule modu,pn))@@ -420,11 +421,11 @@ else renamePN oldPN Nothing newName True t -} -renameInClientMod :: GHC.Name -> String -> GHC.Name -> GHC.ModSummary+renameInClientMod :: GHC.Name -> String -> GHC.Name -> TargetModule -> RefactGhc [ApplyRefacResult]-renameInClientMod oldPN newName newNameGhc modSummary = do- logm $ "renameInClientMod:(oldPN,newNameGhc,modSummary)=" ++ (showGhc (oldPN,newNameGhc,modSummary)) -- ++AZ++- getModuleDetails modSummary+renameInClientMod oldPN newName newNameGhc targetModule@(_,modSummary) = do+ logm $ "renameInClientMod:(oldPN,newNameGhc,modSummary)=" ++ (showGhc (oldPN,newNameGhc,targetModule)) -- ++AZ+++ activateModule targetModule {- ++AZ++ debug stuff -} names <- ghandle handler (GHC.parseName $ nameToString oldPN) nameInfo <- mapM GHC.lookupName names
src/Language/Haskell/Refact/Utils.hs view
@@ -10,9 +10,10 @@ sameOccurrence -- * Managing the GHC / project environment- , loadModuleGraphGhc+ -- , loadModuleGraphGhc , getModuleGhc , parseSourceFileGhc+ , activateModule , getModuleDetails -- * The bits that do the work@@ -30,13 +31,14 @@ , getModuleName , clientModsAndFiles , serverModsAndFiles- , getCurrentModuleGraph- , sortCurrentModuleGraph+ -- , getCurrentModuleGraph+ -- , sortCurrentModuleGraph -- * For testing -- , initGhcSession -- , prettyprint- , pwd+ -- , pwd+ -- , cd ) where import Control.Monad.State@@ -51,8 +53,6 @@ import Language.Haskell.Refact.Utils.LocUtils import Language.Haskell.Refact.Utils.Monad import Language.Haskell.Refact.Utils.MonadFunctions--- import Language.Haskell.Refact.Utils.TokenUtils--- import Language.Haskell.Refact.Utils.TokenUtilsTypes import Language.Haskell.Refact.Utils.TypeSyn import Language.Haskell.Refact.Utils.TypeUtils import System.Directory@@ -69,28 +69,9 @@ -- --------------------------------------------------------------------- -pwd :: IO FilePath-pwd = getCurrentDirectory---- ---------------------------------------------------------------------- -- | From file name to module name. fileNameToModName :: FilePath -> RefactGhc GHC.ModuleName fileNameToModName fileName = do-{-- graph <- GHC.getModuleGraph- cgraph <- liftIO $ canonicalizeGraph graph- cfileName <- liftIO $ canonicalizePath fileName-- let mm = filter (\(mfn,_ms) -> mfn == Just cfileName) cgraph-- -- let mm = filter (\(mfn,_ms) -> mfn == Just fileName) $- -- map (\m -> (GHC.ml_hs_file $ GHC.ms_location m, m)) graph-- case mm of- [] -> error $ "Can't find module name"- _ -> return $ GHC.moduleName $ GHC.ms_mod $ snd $ head mm--} mm <- getModuleMaybe fileName case mm of Nothing -> error $ "Can't find module name"@@ -100,10 +81,16 @@ getModuleMaybe :: FilePath -> RefactGhc (Maybe GHC.ModSummary) getModuleMaybe fileName = do- graph <- GHC.getModuleGraph- cgraph <- liftIO $ canonicalizeGraph graph cfileName <- liftIO $ canonicalizePath fileName + graphs <- gets rsGraph+ currentTgt <- gets rsCurrentTarget+ logm $ "getModuleMaybe " ++ show fileName ++ ":" ++ show (length graphs,currentTgt)++ let cgraph = concatMap (\(_,cg) -> cg) graphs+ -- graph <- GHC.getModuleGraph+ -- cgraph <- liftIO $ canonicalizeGraph graph+ let mm = filter (\(mfn,_ms) -> mfn == Just cfileName) cgraph case mm of@@ -112,21 +99,6 @@ -- --------------------------------------------------------------------- -canonicalizeGraph ::- [GHC.ModSummary] -> IO [(Maybe (FilePath), GHC.ModSummary)]-canonicalizeGraph graph = do- let mm = map (\m -> (GHC.ml_hs_file $ GHC.ms_location m, m)) graph- canon ((Just fp),m) = do- fp' <- canonicalizePath fp- return $ (Just fp',m)- canon (Nothing,m) = return (Nothing,m)-- mm' <- mapM canon mm-- return mm'---- ---------------------------------------------------------------------- -- | Extract the module name from the parsed source, if there is one getModuleName :: GHC.ParsedSource -> Maybe (GHC.ModuleName,String) getModuleName (GHC.L _ modn) =@@ -136,24 +108,6 @@ -- --------------------------------------------------------------------- --- | Load a module graph into the GHC session, starting from main-loadModuleGraphGhc ::- Maybe FilePath -> RefactGhc ()-loadModuleGraphGhc maybeTargetFile = do- case maybeTargetFile of- Just targetFile -> do- -- Prefix with * to force interpretation, for inscopes- -- target <- GHC.guessTarget ("*" ++ targetFile) Nothing- -- NOTE: does not seem to be required- target <- GHC.guessTarget (targetFile) Nothing- GHC.setTargets [target]- void $ GHC.load GHC.LoadAllTargets- return ()- Nothing -> return ()- return ()---- ---------------------------------------------------------------------- -- | Once the module graph has been loaded, load the given module into -- the RefactGhc monad -- TODO: relax the equality test, if the file is loaded via cabal it@@ -161,19 +115,8 @@ getModuleGhc :: FilePath -> RefactGhc () getModuleGhc targetFile = do-{-- graph <- GHC.getModuleGraph-- let mm = filter (\(mfn,_ms) -> mfn == Just targetFile) $- map (\m -> (GHC.ml_hs_file $ GHC.ms_location m, m)) graph---- let mm = filter (\(mfn,_ms) -> mfn == Just targetFile) $--- map (\m -> (GHC.ml_hs_file $ GHC.ms_location m, m)) graph-- case mm of- [(_,modSum)] -> getModuleDetails modSum- _ -> parseSourceFileGhc targetFile--}+ -- TODO: consult cached store of multiple module graphs, one for+ -- each main file. mm <- getModuleMaybe targetFile case mm of Just ms -> getModuleDetails ms@@ -182,6 +125,18 @@ -- --------------------------------------------------------------------- -- | In the existing GHC session, put the requested TypeCheckedModule+-- into the RefactGhc Monad, after ensuring that its originating+-- target is the currently loaded one++activateModule :: TargetModule -> RefactGhc GHC.ModSummary+activateModule (target, modSum) = do+ newModSum <- ensureTargetLoaded (target,modSum)+ getModuleDetails newModSum+ return newModSum++-- ---------------------------------------------------------------------++-- | In the existing GHC session, put the requested TypeCheckedModule -- into the RefactGhc monad -- TODO: rename this function, it is not clear in a refactoring what@@ -215,22 +170,16 @@ -- | Parse a single source file into a GHC session parseSourceFileGhc :: FilePath -> RefactGhc () parseSourceFileGhc targetFile = do+ {- target <- GHC.guessTarget ("*" ++ targetFile) Nothing -- The * -- is to force interpretation, for inscopes GHC.setTargets [target] void $ GHC.load GHC.LoadAllTargets -- Loads and compiles, much as calling ghc --make--{-- graph <- GHC.getModuleGraph---- TODO: canonicalize paths- let mm = filter (\(mfn,_ms) -> mfn == Just targetFile) $- map (\m -> (GHC.ml_hs_file $ GHC.ms_location m, m)) graph+ -}+ logm $ "parseSourceFileGhc:about to loadModuleGraphGhc for" ++ (show targetFile)+ loadModuleGraphGhc (Just [targetFile])+ logm $ "parseSourceFileGhc:loadModuleGraphGhc done" - -- let modSum = head g- let [(_,modSum)] = mm- getModuleDetails modSum--} mm <- getModuleMaybe targetFile case mm of Nothing -> error $ "HaRe:unexpected error parsing " ++ targetFile@@ -266,15 +215,13 @@ , rsUniqState = 1 , rsFlags = RefFlags False , rsStorage = StorageNone+ , rsGraph = []+ , rsModuleGraph = []+ , rsCurrentTarget = Nothing , rsModule = Nothing } - maybeMainFile = rsetMainFile settings- -- readLog <- initializeFlagsWithCradle opt cradle options True- -- setTargetFile fileName- (refactoredMods,_s) <- runRefactGhc (initGhcSession cradle (rsetImportPaths settings) >>- loadModuleGraphGhc maybeMainFile >> comp) initialState let verbosity = rsetVerboseLevel (rsSettings initialState)@@ -524,18 +471,35 @@ -- TODO: deal with an anonymous main module, by taking Maybe GHC.ModuleName clientModsAndFiles- :: GHC.GhcMonad m => GHC.ModuleName -> m [GHC.ModSummary]+ :: GHC.ModuleName -> RefactGhc [([FilePath],GHC.ModSummary)] clientModsAndFiles m = do- ms <- GHC.getModuleGraph modsum <- GHC.getModSummary m- let mg = getModulesAsGraph False ms Nothing- rg = GHC.transposeG mg- modNode = fromJust $ find (\(msum',_,_) -> mycomp msum' modsum) (GHC.verticesG rg)- clientMods = filter (\msum' -> not (mycomp msum' modsum))- $ map summaryNodeSummary $ GHC.reachableG rg modNode - return clientMods+ -- ms' <- GHC.getModuleGraph+ ms' <- gets rsModuleGraph+ -- target <- gets rsCurrentTarget + let getClients ms = clientMods+ where+ mg = getModulesAsGraph False ms Nothing+ rg = GHC.transposeG mg+ {-+ modNode = gfromJust ("clientModsAndFiles:" ++ (showGhc (GHC.ms_mod modsum,target,mg))) + $ find (\(msum',_,_) -> mycomp msum' modsum) (GHC.verticesG rg)+ clientMods = filter (\msum' -> not (mycomp msum' modsum))+ $ map summaryNodeSummary $ GHC.reachableG rg modNode+ -}+ maybeModNode = find (\(msum',_,_) -> mycomp msum' modsum) (GHC.verticesG rg)+ clientMods = case maybeModNode of+ Nothing -> []+ Just modNode ->+ filter (\msum' -> not (mycomp msum' modsum))+ $ map summaryNodeSummary $ GHC.reachableG rg modNode++ let clients = concatMap (\(f,mg) -> zip (repeat f) (getClients mg)) ms'+ -- return (concatMap getClients ms')+ return clients+ -- TODO : find decent name and place for this. mycomp :: GHC.ModSummary -> GHC.ModSummary -> Bool mycomp ms1 ms2 = (GHC.ms_mod ms1) == (GHC.ms_mod ms2)@@ -546,13 +510,14 @@ -- | Return the server module and file names. The server modules of -- module, say m, are those modules which are directly or indirectly -- imported by module m. This can only be called in a live GHC session+-- TODO: make sure this works with multiple targets. Is that needed? No? serverModsAndFiles :: GHC.GhcMonad m => GHC.ModuleName -> m [GHC.ModSummary] serverModsAndFiles m = do ms <- GHC.getModuleGraph modsum <- GHC.getModSummary m let mg = getModulesAsGraph False ms Nothing- modNode = fromJust $ find (\(msum',_,_) -> mycomp msum' modsum) (GHC.verticesG mg)+ modNode = gfromJust "serverModsAndFiles" $ find (\(msum',_,_) -> mycomp msum' modsum) (GHC.verticesG mg) serverMods = filter (\msum' -> not (mycomp msum' modsum)) $ map summaryNodeSummary $ GHC.reachableG mg modNode @@ -565,15 +530,17 @@ -- --------------------------------------------------------------------- +{- ++AZ++ what is using this? -- | Get the current module graph, provided we are in a live GHC session getCurrentModuleGraph :: RefactGhc GHC.ModuleGraph getCurrentModuleGraph = GHC.getModuleGraph sortCurrentModuleGraph :: RefactGhc [GHC.SCC GHC.ModSummary] sortCurrentModuleGraph = do- -- g <- GHC.getModuleGraph g <- getCurrentModuleGraph let scc = GHC.topSortModuleGraph False g Nothing return scc ++++AZ++ -}
src/Language/Haskell/Refact/Utils/Monad.hs view
@@ -10,6 +10,7 @@ , RefactSettings(..) , RefactState(..) , RefactModule(..)+ , TargetModule , RefactStashId(..) , RefactFlags(..) , StateStorage(..)@@ -22,6 +23,11 @@ , logSettings , initGhcSession + , loadModuleGraphGhc+ , ensureTargetLoaded+ , canonicalizeGraph++ , logm ) where @@ -32,12 +38,17 @@ import Control.Monad.State import Data.List+import Data.Time.Clock+-- import Data.Tree import Exception import Language.Haskell.GhcMod import Language.Haskell.GhcMod.Internal--- import Language.Haskell.Refact.Utils.LayoutTypes+-- import Language.Haskell.Refact.Utils.GhcVersionSpecific import Language.Haskell.Refact.Utils.TokenUtilsTypes import Language.Haskell.Refact.Utils.TypeSyn+import System.Directory+import System.FilePath.Posix+import System.Log.Logger import qualified Control.Monad.IO.Class as MU -- ---------------------------------------------------------------------@@ -50,7 +61,7 @@ , rsetImportPaths :: ![FilePath] , rsetExpandSplice :: Bool , rsetLineSeparator :: LineSeparator- , rsetMainFile :: Maybe FilePath+ , rsetMainFile :: Maybe [FilePath] , rsetCheckTokenUtilsInvariant :: !Bool , rsetVerboseLevel :: !VerboseLevel , rsetEnabledTargets :: (Bool,Bool,Bool,Bool)@@ -58,7 +69,6 @@ deriving instance Show LineSeparator - defaultSettings :: RefactSettings defaultSettings = RefSet { rsetGhcOpts = []@@ -68,12 +78,14 @@ , rsetMainFile = Nothing , rsetCheckTokenUtilsInvariant = False , rsetVerboseLevel = Normal- , rsetEnabledTargets = (True,False,True,False)+ -- , rsetEnabledTargets = (True,False,True,False)+ , rsetEnabledTargets = (True,True,True,True) } logSettings :: RefactSettings logSettings = defaultSettings { rsetVerboseLevel = Debug } +-- --------------------------------------------------------------------- data RefactStashId = Stash !String deriving (Show,Eq,Ord) @@ -81,7 +93,6 @@ { rsTypecheckedMod :: !GHC.TypecheckedModule , rsOrigTokenStream :: ![PosToken] -- ^Original Token stream for the current module , rsTokenCache :: !TokenCache -- ^Token stream for the current module, maybe modified, in SrcSpan tree form- -- , rsTokenLayout :: !TokenLayout -- ^Token stream for the current module, maybe modified, in SrcSpan tree form , rsStreamModified :: !Bool -- ^current module has updated the token stream } @@ -97,9 +108,16 @@ , rsFlags :: !RefactFlags -- ^ Flags for controlling generic traversals , rsStorage :: !StateStorage -- ^Temporary storage of values -- while refactoring takes place+ , rsGraph :: [TargetGraph]+ , rsModuleGraph :: [([FilePath],GHC.ModuleGraph)]+ , rsCurrentTarget :: Maybe [FilePath] , rsModule :: !(Maybe RefactModule) -- ^The current module being refactored } +type TargetModule = ([FilePath], GHC.ModSummary)++type TargetGraph = ([FilePath],[(Maybe FilePath, GHC.ModSummary)])+ -- |Result of parsing a Haskell source file. It is simply the -- TypeCheckedModule produced by GHC. type ParseResult = GHC.TypecheckedModule@@ -144,7 +162,6 @@ mzero = GHC.GhcT $ \_s -> mzero x `mplus` y = GHC.GhcT $ \_s -> (GHC.runGhcT (Just GHC.libdir) x) `mplus` (GHC.runGhcT (Just GHC.libdir) y) - -- --------------------------------------------------------------------- -- | Initialise the GHC session, when starting a refactoring.@@ -171,39 +188,142 @@ case mcabal of Just cabal -> do- targets <- liftIO $ cabalAllTargets cabal+ -- targets <- liftIO $ cabalAllTargets cabal+ targets <- liftIO $ getCabalAllTargets cradle cabal -- liftIO $ warningM "HaRe" $ "initGhcSession:targets=" ++ show targets+ logm $ "initGhcSession:targets=" ++ show targets -- TODO: Cannot load multiple main modules, must try to load -- each main module and retrieve its module graph, and then -- set the targets to this superset. let targets' = getEnabledTargets settings targets- -- let (libt,exet,testt,bencht) = targets- -- case libt ++ exet ++ testt ++ bencht of- -- case libt {- ++ exet -} ++ testt ++ bencht of+ case targets' of- [] -> return ()- tgts -> do- -- liftIO $ warningM "HaRe" $ "initGhcSession:tgts=" ++ (show tgts)- setTargetFiles tgts- checkSlowAndSet- void $ GHC.load GHC.LoadAllTargets+ ([],[]) -> return ()+ (libTgts,exeTgts) -> do+ -- liftIO $ warningM "HaRe" $ "initGhcSession:tgts=" ++ (show (libTgts,exeTgts))+ logm $ "initGhcSession:(libTgts,exeTgts)=" ++ (show (libTgts,exeTgts))+ -- setTargetFiles tgts+ -- void $ GHC.load GHC.LoadAllTargets - Nothing -> return()+ mapM_ loadModuleGraphGhc $ map (\t -> Just [t]) exeTgts + -- Load the library last, most likely in context+ case libTgts of+ [] -> return ()+ _ -> loadModuleGraphGhc (Just libTgts)++ -- liftIO $ warningM "HaRe" $ "initGhcSession:loadModuleGraphGhc done"++ Nothing -> do+ let maybeMainFile = rsetMainFile settings+ loadModuleGraphGhc maybeMainFile+ return()++ -- graph <- gets rsGraph+ -- liftIO $ warningM "HaRe" $ "initGhcSession:graph=" ++ show graph return () where options opt | rsetExpandSplice opt = "-w:" : rsetGhcOpts opt | otherwise = "-Wall" : rsetGhcOpts opt +-- --------------------------------------------------------------------- +-- getCabalAllTargets :: Cradle -> PackageDescription -> IO ([FilePath],[FilePath],[FilePath],[FilePath])+getCabalAllTargets cradle cabal = do+ currentDir <- getCurrentDirectory+ setCurrentDirectory $ gfromJust "getCabalAllTargets" (cradleCabalDir cradle)++ (libs,exes,tests,benches) <- liftIO $ cabalAllTargets cabal+ setCurrentDirectory currentDir++ let -- libs' = addCurrentDir libs+ exes' = addCurrentDir exes+ tests' = addCurrentDir tests+ benches' = addCurrentDir benches++ addCurrentDir ts = map (\t -> combine currentDir t) ts++ return (libs,exes',tests',benches')++-- ---------------------------------------------------------------------++-- | Load a module graph into the GHC session, starting from main+loadModuleGraphGhc ::+ Maybe [FilePath] -> RefactGhc ()+loadModuleGraphGhc maybeTargetFiles = do+ -- currentDir <- liftIO getCurrentDirectory+ -- liftIO $ warningM "HaRe" $ "loadModuleGraphGhc:maybeTargetFiles=" ++ show (maybeTargetFiles,currentDir)+ case maybeTargetFiles of+ Just targetFiles -> do+ loadTarget targetFiles+ -- setTargetFiles [targetFile]+ -- void $ GHC.load GHC.LoadAllTargets++ graph <- GHC.getModuleGraph+ cgraph <- liftIO $ canonicalizeGraph graph++ settings <- get+ put $ settings { rsGraph = (rsGraph settings) ++ [(targetFiles,cgraph)]+ , rsModuleGraph = (rsModuleGraph settings) ++ [(targetFiles,graph)]+ , rsCurrentTarget = maybeTargetFiles+ }++ -- logm $ "loadModuleGraphGhc:cgraph=" ++ show (map fst cgraph)+ -- logm $ "loadModuleGraphGhc:cgraph=" ++ showGhc graph++ return ()+ Nothing -> return ()+ return ()++-- ---------------------------------------------------------------------++loadTarget :: [FilePath] -> RefactGhc ()+loadTarget targetFiles = do+ setTargetFiles targetFiles+ void $ GHC.load GHC.LoadAllTargets++-- ---------------------------------------------------------------------++-- | Make sure the given file is the currently loaded target, and load+-- it if not. Assumes that all the module graphs had been generated+-- before, so these are not updated.+ensureTargetLoaded :: TargetModule -> RefactGhc GHC.ModSummary+ensureTargetLoaded (target,modSum) = do+ settings <- get+ let currentTarget = rsCurrentTarget settings+ if currentTarget == Just target+ then return modSum+ else do+ loadTarget target+ put $ settings { rsCurrentTarget = Just target}+ graph <- GHC.getModuleGraph+ let newModSum = filter (\ms -> GHC.ms_mod modSum == GHC.ms_mod ms) graph+ return $ ghead "ensureTargetLoaded" newModSum++-- ---------------------------------------------------------------------++canonicalizeGraph ::+ [GHC.ModSummary] -> IO [(Maybe (FilePath), GHC.ModSummary)]+canonicalizeGraph graph = do+ let mm = map (\m -> (GHC.ml_hs_file $ GHC.ms_location m, m)) graph+ canon ((Just fp),m) = do+ fp' <- canonicalizePath fp+ return $ (Just fp',m)+ canon (Nothing,m) = return (Nothing,m)++ mm' <- mapM canon mm++ return mm'++-- ---------------------------------------------------------------------+ runRefactGhc :: RefactGhc a -> RefactState -> IO (a, RefactState) runRefactGhc comp initState = do runStateT (GHC.runGhcT (Just GHC.libdir) comp) initState- -- runStateT (GHC.runGhcT (Just GHC.libdir) (initGhcSession >> comp)) initState getRefacSettings :: RefactGhc RefactSettings getRefacSettings = do@@ -212,47 +332,42 @@ -- --------------------------------------------------------------------- -getEnabledTargets :: RefactSettings -> ([FilePath],[FilePath],[FilePath],[FilePath]) -> [FilePath]-getEnabledTargets settings (libt,exet,testt,bencht) = targets+getEnabledTargets :: RefactSettings -> ([FilePath],[FilePath],[FilePath],[FilePath]) -> ([FilePath],[FilePath])+getEnabledTargets settings (libt,exet,testt,bencht) = (targetsLib,targetsExe) where (libEnabled, exeEnabled, testEnabled, benchEnabled) = rsetEnabledTargets settings- targets = on libEnabled libt- ++ on exeEnabled exet- ++ on testEnabled testt- ++ on benchEnabled bencht+ targetsLib = on libEnabled libt+ targetsExe = on exeEnabled exet+ ++ on testEnabled testt+ ++ on benchEnabled bencht on flag xs = if flag then xs else [] --- ------------------------------------------------------------------------ ++AZ++ trying to wrap this in GhcT, or vice versa--- For inspiration:--- https://github.com/bjpop/berp/blob/200fa0f26a4da7c6f6ff6fcdc29a2468a1c39e60/src/Berp/Interpreter/Monad.hs-{--type Repl a = GhcT (StateT ReplState Compile) a -data ReplState = ReplState { repl_inputState :: !InputState }+-- --------------------------------------------------------------------- -runRepl :: Maybe FilePath -> Repl a -> IO a-runRepl filePath comp = do- initInputState <- initializeInput defaultSettings- let initReplState = ReplState { repl_inputState = initInputState }- runCompileMonad $ (flip evalStateT) initReplState $ runGhcT filePath comp+logm :: String -> RefactGhc ()+logm string = do+ settings <- getRefacSettings+ let loggingOn = (rsetVerboseLevel settings == Debug)+ -- || (rsetVerboseLevel settings == Normal)+ when loggingOn $ do+ -- ts <- liftIO timeStamp+ -- liftIO $ warningM "HaRe" (ts ++ ":" ++ string)+ liftIO $ warningM "HaRe" (string)+ return () -withInputState :: (InputState -> Repl a) -> Repl a-withInputState f = do- state <- liftGhcT $ gets repl_inputState- f state+timeStamp :: IO String+timeStamp = do+ k <- getCurrentTime+ return (show k) --- Ugliness because GHC has its own MonadIO class-instance MU.MonadIO m => MonadIO (GhcT m) where- liftIO = MU.liftIO+-- --------------------------------------------------------------------- -instance MonadIO m => MU.MonadIO (StateT s m) where- liftIO = MT.liftIO+instance Show GHC.ModSummary where+ show m = show $ GHC.ms_mod m -instance ExceptionMonad m => ExceptionMonad (StateT s m) where- gcatch f h = StateT $ \s -> gcatch (runStateT f s) (\e -> runStateT (h e) s)- gblock = mapStateT gblock- gunblock = mapStateT gunblock--}+instance Show GHC.Module where+ show m = GHC.moduleNameString $ GHC.moduleName m +-- ---------------------------------------------------------------------
src/Language/Haskell/Refact/Utils/MonadFunctions.hs view
@@ -62,7 +62,7 @@ , setStateStorage , getStateStorage - , logm+ -- , logm , updateToks , updateToksWithPos@@ -509,24 +509,6 @@ getStateStorage = do storage <- gets rsStorage return storage---- -----------------------------------------------------------------------logm :: String -> RefactGhc ()-logm string = do- settings <- getRefacSettings- let loggingOn = (rsetVerboseLevel settings == Debug)- -- || (rsetVerboseLevel settings == Normal)- when loggingOn $ do- -- ts <- liftIO timeStamp- -- liftIO $ warningM "HaRe" (ts ++ ":" ++ string)- liftIO $ warningM "HaRe" (string)- return ()--timeStamp :: IO String-timeStamp = do- k <- getCurrentTime- return (show k) -- ---------------------------------------------------------------------
src/Language/Haskell/Refact/Utils/TypeUtils.hs view
@@ -2001,98 +2001,8 @@ Nothing -> r -} --- -- --------------------------------------------------------------------- -{---- |Find those declarations(function\/pattern binding and type--- signature) which define the specified PNames. incTypeSig indicates--- whether the corresponding type signature will be included.-definingDecls::[PName] -- ^ The specified identifiers.- ->[HsDeclP] -- ^ A collection of declarations.- ->Bool -- ^ True means to include the type signature.- ->Bool -- ^ True means to look at the local declarations as well. - ->[HsDeclP] -- ^ The result.-definingDecls pns ds incTypeSig recursive = concatMap defines ds- where- defines decl- = if recursive -- TODO: original seems to stop on first match? Should continue- -- then ghead "defines" $ applyTU (stop_tdTU (failTU `adhocTU` inDecl)) decl- then SYB.everythingStaged SYB.Parser (++) [] ([] `SYB.mkQ` inDecl) decl- else defines' decl- where- inDecl (d::GHC.LHsDecl GHC.RdrName {- HsDeclP -} )- -- was |defines' d /= [] =return $ defines' d- -- was | length (defines' d) /= 0 = defines' d -- TODO: horribly inefficient- | True = defines' d -- TODO: horribly inefficient- inDecl _ = []-- defines' :: HsDeclP -> [HsDeclP]-- -- ValD - binds- defines' decl@(GHC.L l (GHC.ValD (GHC.FunBind (GHC.L _ pname) _ _ _ _ _)))- |isJust (find (==(PN pname)) pns) = [decl]-- defines' decl@(GHC.L l (GHC.ValD (GHC.PatBind p rhs ty fvs _))) ---CONSIDER AGAIN----- |(hsPNs p) `intersect` pns /= [] = [decl]- defines' decl@(GHC.L l (GHC.ValD _)) = []-- -- SigD - type signatures- defines' decl@(GHC.L l (GHC.SigD (GHC.TypeSig is tp)))- |(map lghcToPN is) `intersect` pns /=[]- = if incTypeSig- then [(GHC.L l (GHC.SigD (GHC.TypeSig (filter (\x->isJust (find (==lghcToPN x) pns)) is) tp)))]- else []- defines' decl@(GHC.L l (GHC.SigD _ {- (GHC.Sig id) -})) = []-- -- TyClD - Type definitions- -- GHC7.4.2: defines' decl@(GHC.L l (GHC.TyClD (GHC.TyData _ _ name _ _ _ cons _)))- -- GHC7.6.3: defines' decl@(GHC.L l (GHC.TyClD (GHC.TyDecl _name _vars (GHC.TyData _ _ _ _ cons _) _fvs)))- defines' decl@(GHC.L l (GHC.TyClD _))- = if checkCons (getDataConstructors decl) == True- then [decl]- else []-- where- checkCons [] = False- checkCons ((GHC.L _ (GHC.ConDecl (GHC.L _ pname) _ _ _ _ _ _ _)):ms)- | isJust (find (==(PN pname)) pns) = True- | otherwise = checkCons ms--{- ++ Without GhcVersionSpecific- -- TyClD - Type definitions- -- GHC7.4.2: defines' decl@(GHC.L l (GHC.TyClD (GHC.TyData _ _ name _ _ _ cons _)))- defines' decl@(GHC.L l (GHC.TyClD (GHC.TyDecl _name _vars (GHC.TyData _ _ _ _ cons _) _fvs)))- = if checkCons cons == True then [decl]- else []-- where- checkCons [] = False- checkCons ((GHC.L _ (GHC.ConDecl (GHC.L _ pname) _ _ _ _ _ _ _)):ms)- | isJust (find (==(PN pname)) pns) = True- | otherwise = checkCons ms--}-- defines' decl@(GHC.L l (GHC.TyClD _ {- (GHC.TyClDecl id) -})) = []--- defines' decl@(GHC.L l (GHC.InstD _ {- (GHC.InstDecl id) -})) = []- defines' decl@(GHC.L l (GHC.DerivD _ {- (GHC.DerivDecl id) -})) = []- defines' decl@(GHC.L l (GHC.DefD _ {- (GHC.DefaultDecl id) -})) = []- defines' decl@(GHC.L l (GHC.ForD _ {- (GHC.ForeignDecl id) -})) = []- defines' decl@(GHC.L l (GHC.WarningD _ {- (GHC.WarnDecl id) -})) = []- defines' decl@(GHC.L l (GHC.AnnD _ {- (GHC.AnnDecl id) -})) = []- defines' decl@(GHC.L l (GHC.RuleD _ {- (GHC.RuleDecl id) -})) = []- defines' decl@(GHC.L l (GHC.VectD _ {- (GHC.VectDecl id) -})) = []- defines' decl@(GHC.L l (GHC.SpliceD _ {- (GHC.SpliceDecl id) -})) = []- defines' decl@(GHC.L l (GHC.DocD _ {- (GHC.DocDecl) -})) = []- defines' decl@(GHC.L l (GHC.QuasiQuoteD _ {- (GHC.HsQuasiQuote id) -})) = []--}---- ---------------------------------------------------------------------- -- |Find those declarations(function\/pattern binding) which define -- the specified GHC.Names. incTypeSig indicates whether the -- corresponding type signature will be included.@@ -2161,47 +2071,6 @@ -- --------------------------------------------------------------------- -{---definingDecls::[PName] -- ^ The specified identifiers.- ->[HsDeclP] -- ^ A collection of declarations.- ->Bool -- ^ True means to include the type signature.- ->Bool -- ^ True means to look at the local declarations as well. - ->[HsDeclP] -- ^ The result.-definingDecls pns ds incTypeSig recursive=concatMap defines ds- where- defines decl- =if recursive- then ghead "defines" $ applyTU (stop_tdTU (failTU `adhocTU` inDecl)) decl- else defines' decl- where- inDecl (d::HsDeclP)- |defines' d /=[] =return $ defines' d- inDecl _=mzero-- defines' decl@(TiDecorate.Dec (HsFunBind _ ((HsMatch _ (PNT pname _ _) _ _ _):ms))) - |isJust (find (==pname) pns) = [decl]- defines' decl@(TiDecorate.Dec (HsPatBind loc p rhs ds)) ---CONSIDER AGAIN----- |(hsPNs p) `intersect` pns /=[] = [decl]- defines' decl@(TiDecorate.Dec (HsTypeSig loc is c tp)) --handle cases like a,b::Int - |(map pNTtoPN is) `intersect` pns /=[]- =if incTypeSig- then [(TiDecorate.Dec (HsTypeSig loc (filter (\x->isJust (find (==pNTtoPN x) pns)) is) c tp))]- else []- defines' decl@(TiDecorate.Dec (HsDataDecl loc c tp cons i))- = if checkCons cons == True then [decl]- else []-- where- checkCons [] = False- checkCons ((HsConDecl loc i c (PNT pname _ _) t):ms)- | isJust (find (==pname) pns) = True- | otherwise = checkCons ms- defines' _ =[]--}---- ---------------------------------------------------------------------- -- TODO: AZ: pretty sure this can be simplified, depends if we need to -- manage transformed stuff too though. @@ -2826,7 +2695,7 @@ addDecl parent pn (decl, msig, declToks) topLevel = if isJust pn- then appendDecl parent (fromJust pn) (decl, msig, declToks)+ then appendDecl parent (gfromJust "addDecl" pn) (decl, msig, declToks) else if topLevel then addTopLevelDecl (decl, msig, declToks) parent else addLocalDecl parent (decl,msig,declToks)@@ -3006,7 +2875,7 @@ inImport :: GHC.LImportDecl GHC.Name -> RefactGhc (GHC.LImportDecl GHC.Name) inImport imp@(GHC.L _ (GHC.ImportDecl (GHC.L _ modName) _qualify _source _safe isQualified _isImplicit _as h))- | serverModName == modName && not isQualified -- && (if isJust pn then findPN (fromJust pn) h else True)+ | serverModName == modName && not isQualified -- && (if isJust pn then findPN (gfromJust "addItemsToImport" pn) h else True) = case h of Nothing -> insertEnts imp [] True Just (_isHide, ents) -> insertEnts imp ents False@@ -3926,181 +3795,6 @@ return () else return () --- ----------------------------------------------------------------------{---- | Once a rename is complete, adjust the layout for any affected--- where/let/of/do elements------ TODO: what if the renamePN is of a different syntax element that--- just happens to be on the same line as the trigger token? May have--- to get rid of the conditional part in the tests below-adjustLayoutAfterRename ::(SYB.Data t)- =>GHC.Name -- ^ The identifier that has been renamed- ->GHC.Name -- ^ The new name, including possible qualifier- ->t -- ^ The syntax phrase- ->RefactGhc t-adjustLayoutAfterRename oldPN newName t = do- logm $ "adjustLayoutAfterRename:(oldPN,newName)=" ++ showGhc (oldPN,newName)- -- drawTokenTree "before adjusting"- -- logm $ "adjustLayoutAfterRename:t=" ++ (SYB.showData SYB.Renamer 0 t)-- -- Note: bottom-up traversal (no ' at end)- everywhereMStaged SYB.Renamer (SYB.mkM adjustLHsExpr- `SYB.extM` adjustLMatch- ) t- where- adjustLHsExpr :: (GHC.LHsExpr GHC.Name) -> RefactGhc (GHC.LHsExpr GHC.Name)-- -- case expression- adjustLHsExpr x@(GHC.L l (GHC.HsCase expr (GHC.MatchGroup ms typ)))- | findPNs [oldPN,newName] expr- = do -- Need to see if the last line of the expr changes due to- -- a name length change, and if so in/dedent mg accordingly- -- Starting with a very naive version.- -- let off = (length $ showGhc newName) - (length $ showGhc oldPN)-- -- Offset calculation- -- - Must take into account the new position of the 'of'- -- token.- -- - But must also take account of any spaces between the- -- end of the 'of' token and the start of the MatchGroup.- -- - And of whether the 'of' token is on the same line as- -- the MatchGroup- -- logm $ "adjustLHsExpr:case:starting="- -- drawTokenTreeDetailed "adjustLHsExpr:case"- upToOf <- getLineToks l isOf- let off = calcOffset upToOf- logm $ "adjustLHsExpr:case:(l,off)=" ++ showGhc (l,off)-- if off /= 0- then do- ms' <- indentList ms off- return (GHC.L l (GHC.HsCase expr (GHC.MatchGroup ms' typ)))- else return x-- -- do expression- adjustLHsExpr x@(GHC.L l (GHC.HsDo GHC.DoExpr stmts typ)) =- do- upToDo <- getLineToks l isDo- let off = calcOffset upToDo- if off /= 0- then do- logm $ "adjustLHsExpr:do:(l,off)=" ++ showGhc (l,off)- stmts' <- indentList stmts off- return (GHC.L l (GHC.HsDo GHC.DoExpr stmts' typ))- else return x-- -- let expression.- -- In following match, the 'let' token comes before local, 'in' before expr- adjustLHsExpr x@(GHC.L l (GHC.HsLet local expr)) =- do- upToLet <- getLineToks l isLet- let off = calcOffset upToLet- if off /= 0- then do- logm $ "adjustLHsExpr:let:(l,off)=" ++ showGhc (l,off)- local' <- indentList (sortBy compareLocated $ hsBinds local) off- -- drawTokenTreeDetailed "adjustLHsExpr:let:after indentList"- upToIn <- getLineToks l isIn- -- logm $ "adjustLHsExpr:in:(upToIn)=" ++ show upToIn- let offIn = calcOffset upToIn- logm $ "adjustLHsExpr:let/in:(l,offIn)=" ++ showGhc (l,offIn)- -- drawTokenTreeDetailed "before blowup"-- -- Does the 'in' token fall on the same line as the let- -- decls?- let (GHC.L ll _) = glast "adjustLHSExpr" local'- lastDeclToks <- getToksForSpanNoInv ll- let offToUse = if startLineForToks upToIn == startLineForToks (reverse lastDeclToks)- then off- else offIn- expr' <- indentDeclAndToks expr offToUse- -- drawTokenTreeDetailed "adjustLHsExpr:let:after indentDeclAndToks"- return (GHC.L l (GHC.HsLet (replaceBinds local local') expr'))- else return x-- adjustLHsExpr x = return x-- -- ----------------------------------- adjustLMatch :: (GHC.LMatch GHC.Name) -> RefactGhc (GHC.LMatch GHC.Name)- adjustLMatch x@(GHC.L _ (GHC.Match _ _ (GHC.GRHSs _ GHC.EmptyLocalBinds))) = return x- adjustLMatch x@(GHC.L l (GHC.Match pats mtyp (GHC.GRHSs grhs local))) =- do- upToWhere <- getLineToks l isWhere- let off = calcOffset upToWhere- if off /= 0- then do- logm $ "adjustLMatch:(l,off)=" ++ showGhc (l,off)- -- logm $ "adjustLMatch:local=[" ++ showGhc local ++ "]"- -- logm $ "adjustLMatch:hsBinds local=[" ++ showGhc (hsBinds local) ++ "]"- -- logm $ "adjustLMatch:sort $ hsBinds local=[" ++ showGhc (sortBy compareLocated $ hsBinds local) ++ "]"-- local' <- indentList (sortBy compareLocated $ hsBinds local) off- return (GHC.L l (GHC.Match pats mtyp (GHC.GRHSs grhs (replaceBinds local local'))))- else do- logm $ "adjustLMatch: (l,off)=" ++ showGhc (l,off)- return x-- -- adjustLMatch x = return x--}--- --------------------------------------{--startLineForToks :: [PosToken] -> Int-startLineForToks toks = tokenRow $ ghead "startLineForToks" toks--}--- --------------------------------------{--compareLocated ::- Ord a => GHC.GenLocated a t -> GHC.GenLocated a t1 -> Ordering-compareLocated (GHC.L l1 _) (GHC.L l2 _) = compare l1 l2--}--- --------------------------------------{---- |Get all the tokens on the same line as the do/let/of etc token-getLineToks :: GHC.SrcSpan -> (PosToken -> Bool) -> RefactGhc [PosToken]-getLineToks l isToken = do- toks <- getToksForSpanNoInv l- toksBefore <- getToksBeforeSpan l-- -- logm $ "getLineToks:toks=" ++ show toks- -- logm $ "getLineToks:toksBefore=" ++ show toksBefore-- let lineToks = groupTokensByLine $ reverse toks ++ (reversedToks toksBefore)-- logm $ "getLineToks:lineToks=" ++ show lineToks-- let forLine = ghead "getLineToks.1" $ filter (\ll -> any isToken ll) lineToks-- -- logm $ "getLineToks:forLine=" ++ show forLine-- -- let upToOf = reverse $ dropWhile (\tok -> not (isToken tok)) fullOfLineRev- let upToOf = reverse $ dropWhile (\tok -> not (isToken tok)) forLine- logm $ "getLineToks:up to match=" ++ show upToOf- return upToOf--}--- --------------------------------------{--calcOffset :: [PosToken] -> Int-calcOffset toks = sum $ map tokenDelta toks- where- tokenDelta (_,"") = 0- tokenDelta (tt,s) = deltac- where- (_sl,sc) = getLocatedStart tt- (_el,ec) = getLocatedEnd tt- deltac = (length s) - (ec - sc)--}--- --------------------------------------{--indentList :: SYB.Data t- => [GHC.Located t] -> Int -> RefactGhc [GHC.Located t]-indentList ms off = do- ms' <- mapM (\m -> indentDeclAndToks m off) (gtail "indentList.1" ms)- -- drawTokenTreeDetailed "after indentList"- let hm = ghead "indentList.2" ms- return (hm:ms')--} -- --------------------------------------------------------------------- -- | Create a new name token. If 'useQual' then use the qualified
src/MainHaRe.hs view
@@ -20,6 +20,7 @@ import Paths_HaRe import Prelude import System.Console.GetOpt+-- import System.Directory import System.Environment (getArgs) import System.IO (hPutStr, hPutStrLn, stdout, stderr, hSetEncoding, utf8) @@ -61,7 +62,7 @@ argspec :: [OptDescr (RefactSettings -> RefactSettings)] argspec = [ Option "m" ["mainfile"]- (ReqArg (\mf opts -> opts { rsetMainFile = Just mf }) "FILE")+ (ReqArg (\mf opts -> opts { rsetMainFile = Just [mf] }) "FILE") "Main file name if not specified in cabal file" -- , Option "l" ["tolisp"]@@ -109,9 +110,14 @@ -- #if __GLASGOW_HASKELL__ >= 611 hSetEncoding stdout utf8 -- #endif+ -- currentDirectory <- getCurrentDirectory args <- getArgs let (opt,cmdArg) = parseArgs argspec args cradle <- findCradle+ -- case (cradleCabalDir cradle) of+ -- Nothing -> return ()+ -- Just dir -> setCurrentDirectory dir+ -- hPutStrLn stderr $ "cabal file=" ++ show (cradleCabalFile cradle) -- ++AZ++ debug let cmdArg0 = cmdArg !. 0 cmdArg1 = cmdArg !. 1 cmdArg2 = cmdArg !. 2@@ -141,6 +147,7 @@ "show" -> putStrLn (show (opt,cradle)) cmd -> throw (NoSuchCommand cmd)+ -- setCurrentDirectory currentDirectory putStr (show res) -- putStr $ "(ok " ++ showLisp mfs ++ ")" where