haskell-tools-cli 0.5.0.0 → 0.6.0.0
raw patch · 8 files changed
+152/−183 lines, 8 filesdep +strictdep ~haskell-tools-astdep ~haskell-tools-clidep ~haskell-tools-prettyprintPVP ok
version bump matches the API change (PVP)
Dependencies added: strict
Dependency ranges changed: haskell-tools-ast, haskell-tools-cli, haskell-tools-prettyprint, haskell-tools-refactor
API changes (from Hackage documentation)
Files
- Language/Haskell/Tools/Refactor/CLI.hs +46/−34
- examples/Project/cpp-opt/A.hs +6/−0
- examples/Project/cpp-opt/some-test-package.cabal +19/−0
- examples/Project/illegal-extension/A.hs +0/−2
- haskell-tools-cli.cabal +16/−25
- test-hackage/Main.hs +0/−72
- test-stackage/Main.hs +36/−21
- test/Main.hs +29/−29
Language/Haskell/Tools/Refactor/CLI.hs view
@@ -14,6 +14,7 @@ import Data.List import Data.List.Split import Data.Maybe +import Data.Char import System.Directory import System.Exit import System.IO @@ -34,7 +35,7 @@ type CLIRefactorSession = StateT CLISessionState Ghc -data CLISessionState = +data CLISessionState = CLISessionState { _refactState :: RefactorSessionState , _actualMod :: Maybe SourceFileKey , _exiting :: Bool @@ -46,7 +47,7 @@ deriving instance Show PkgConfRef tryOut :: IO () -tryOut = void $ refactorSession stdin stdout +tryOut = void $ refactorSession stdin stdout [ "-dry-run", "-one-shot", "-module-name=Language.Haskell.Tools.AST", "-refactoring=OrganizeImports" , "src/ast", "src/backend-ghc", "src/prettyprint", "src/rewrite", "src/refactor"] @@ -61,8 +62,8 @@ else do initSuccess <- initializeSession output workingDirs htFlags when initSuccess $ runSession input output htFlags return initSuccess - - where printSrcErrors err = do dfs <- getSessionDynFlags + + where printSrcErrors err = do dfs <- getSessionDynFlags liftIO $ printBagOfErrors dfs (srcErrorMessages err) return False @@ -70,16 +71,16 @@ initializeSession output workingDirs flags = do liftIO $ hSetBuffering output NoBuffering liftIO $ hPutStrLn output "Compiling modules. This may take some time. Please wait." - res <- loadPackagesFrom (\ms -> liftIO $ hPutStrLn output ("Loaded module: " ++ modSumName ms)) workingDirs - case res of + res <- loadPackagesFrom (\ms -> liftIO $ hPutStrLn output ("Loaded module: " ++ modSumName ms)) (const $ return ()) (\_ _ -> return []) workingDirs + case res of Right (_, ignoredMods) -> do - when (not $ null ignoredMods) - $ liftIO $ hPutStrLn output - $ "The following modules are ignored: " + when (not $ null ignoredMods) + $ liftIO $ hPutStrLn output + $ "The following modules are ignored: " ++ concat (intersperse ", " $ ignoredMods) ++ ". Multiple modules with the same qualified name are not supported." - - liftIO . hPutStrLn output $ if ("-one-shot" `elem` flags) + + liftIO . hPutStrLn output $ if ("-one-shot" `elem` flags) then "All modules loaded." else "All modules loaded. Use 'SelectModule module-name' to select a module." when ("-dry-run" `elem` flags) $ modify (dryMode .= True) @@ -91,7 +92,7 @@ runSession _ output flags | "-one-shot" `elem` flags = let modName = catMaybes $ map (\f -> case splitOn "=" f of ["-module-name", mod] -> Just mod; _ -> Nothing) flags refactoring = catMaybes $ map (\f -> case splitOn "=" f of ["-refactoring", ref] -> Just ref; _ -> Nothing) flags - in case (modName, refactoring) of + in case (modName, refactoring) of ([modName],[refactoring]) -> do performSessionCommand output (LoadModule modName) command <- readSessionCommand output (takeWhile (/='"') $ dropWhile (=='"') $ refactoring) @@ -102,13 +103,13 @@ runSession input output _ = runSessionLoop input output runSessionLoop :: Handle -> Handle -> CLIRefactorSession () - runSessionLoop input output = do + runSessionLoop input output = do actualMod <- gets (^. actualMod) liftIO $ hPutStr output (maybe "no-module-selected> " (\sfk -> (sfk ^. sfkModuleName) ++ "> ") actualMod) - cmd <- liftIO $ hGetLine input + cmd <- liftIO $ hGetLine input sessionComm <- readSessionCommand output cmd changedMods <- performSessionCommand output sessionComm - void $ reloadChangedModules (hPutStrLn output . ("Re-loaded module: " ++) . modSumName) + void $ reloadChangedModules (hPutStrLn output . ("Re-loaded module: " ++) . modSumName) (const $ return ()) (\ms -> keyFromMS ms `elem` changedMods) doExit <- gets (^. exiting) when (not doExit) (void (runSessionLoop input output)) @@ -116,7 +117,7 @@ usageMessage = "Usage: ht-refact [ht-flags, ghc-flags] package-pathes\n" ++ "ht-flags: -dry-run -one-shot -module-name=modulename -refactoring=\"refactoring\"" -data RefactorSessionCommand +data RefactorSessionCommand = LoadModule String | Skip | Exit @@ -124,16 +125,24 @@ deriving Show readSessionCommand :: Handle -> String -> CLIRefactorSession RefactorSessionCommand -readSessionCommand output cmd = case splitOn " " cmd of +readSessionCommand output cmd = case (splitOn " " cmd) of ["SelectModule", mod] -> return $ LoadModule mod - ["Exit"] -> return Exit - _ -> do actualMod <- gets (^. actualMod) - case actualMod of Just _ -> return $ RefactorCommand $ readCommand cmd - Nothing -> do liftIO $ hPutStrLn output "Set the actual module first" - return Skip + ["Exit"] -> return Exit+ cm | head cm `elem` refactorCommands + -> do actualMod <- gets (^. actualMod)+ case readCommand cmd of+ Right cmd -> + case actualMod of Just _ -> return $ RefactorCommand cmd + Nothing -> do liftIO $ hPutStrLn output "Set the actual module first" + return Skip+ Left err -> do liftIO $ hPutStrLn output err + return Skip + _ -> do liftIO $ hPutStrLn output $ "'" ++ cmd ++ "' is not a known command. Commands are: SelectModule, Exit, " + ++ intercalate ", " refactorCommands + return Skip performSessionCommand :: Handle -> RefactorSessionCommand -> CLIRefactorSession [SourceFileKey] -performSessionCommand output (LoadModule modName) = do +performSessionCommand output (LoadModule modName) = do mod <- gets (lookupModInSCs (SourceFileKey NormalHs modName) . (^. refSessMCs)) if isJust mod then modify $ actualMod .= fmap fst mod else liftIO $ hPutStrLn output ("Cannot find module: " ++ modName) @@ -141,10 +150,10 @@ performSessionCommand _ Skip = return [] performSessionCommand _ Exit = do modify $ exiting .= True return [] -performSessionCommand output (RefactorCommand cmd) +performSessionCommand output (RefactorCommand cmd) = do actMod <- gets (^. actualMod) (actualMod, otherMods) <- getMods actMod - res <- case actualMod of + res <- case actualMod of Just mod -> lift $ performCommand cmd mod otherMods -- WALKAROUND: support running refactors that need no module selected Nothing -> case otherMods of (hd:rest) -> lift $ performCommand cmd hd rest @@ -155,24 +164,28 @@ Right resMods -> performChanges output inDryMode resMods where performChanges output False resMods = - forM resMods $ \case - ModuleCreated n m otherM -> do + forM resMods $ \case + ModuleCreated n m otherM -> do Just (_, otherMR) <- gets (lookupModInSCs otherM . (^. refSessMCs)) let Just otherMS = otherMR ^? modRecMS otherSrcDir <- liftIO $ getSourceDir otherMS let loc = srcDirFromRoot otherSrcDir n - liftIO $ withBinaryFile loc WriteMode (`hPutStr` prettyPrint m) + liftIO $ withBinaryFile loc WriteMode $ \handle -> do + hSetEncoding handle utf8 + hPutStr handle (prettyPrint m) return (SourceFileKey NormalHs n) ContentChanged (n,m) -> do let modName = semanticsModule m ms <- getModSummary modName (isBootModule $ m ^. semantics) let file = fromJust $ ml_hs_file $ ms_location ms - liftIO $ withBinaryFile file WriteMode (`hPutStr` prettyPrint m) + liftIO $ withBinaryFile file WriteMode $ \handle -> do + hSetEncoding handle utf8 + hPutStr handle (prettyPrint m) return n ModuleRemoved mod -> do Just (_,m) <- gets (lookupModInSCs (SourceFileKey NormalHs mod) . (^. refSessMCs)) case ( fmap semanticsModule (m ^? typedRecModule) <|> fmap semanticsModule (m ^? renamedRecModule) - , fmap isBootModule (m ^? typedRecModule) <|> fmap isBootModule (m ^? renamedRecModule)) of + , fmap isBootModule (m ^? typedRecModule) <|> fmap isBootModule (m ^? renamedRecModule)) of (Just modName, Just isBoot) -> do ms <- getModSummary modName isBoot let file = fromJust $ ml_hs_file $ ms_location ms @@ -180,8 +193,8 @@ liftIO $ removeFile file _ -> do liftIO $ hPutStrLn output ("Module " ++ mod ++ " could not be removed.") return (SourceFileKey NormalHs mod) - performChanges output True resMods = do - forM_ resMods (liftIO . \case + performChanges output True resMods = do + forM_ resMods (liftIO . \case ContentChanged (n,m) -> do hPutStrLn output $ "### Module changed: " ++ (n ^. sfkModuleName) ++ "\n### new content:\n" ++ prettyPrint m ModuleRemoved mod -> @@ -192,9 +205,8 @@ getModSummary name boot = do allMods <- lift getModuleGraph - return $ fromJust $ find (\ms -> ms_mod ms == name && (ms_hsc_src ms == HsSrcFile) /= boot) allMods + return $ fromJust $ find (\ms -> ms_mod ms == name && (ms_hsc_src ms == HsSrcFile) /= boot) allMods instance IsRefactSessionState CLISessionState where refSessMCs = refactState & _refSessMCs initSession = CLISessionState initSession Nothing False False -
+ examples/Project/cpp-opt/A.hs view
@@ -0,0 +1,6 @@+{-# LANGUAGE CPP #-} +module A where + +#ifndef MACRO +"The macro 'MACRO' defined in the cabal file is not applied." +#endif
+ examples/Project/cpp-opt/some-test-package.cabal view
@@ -0,0 +1,19 @@+name: some-test-package +version: 1.2.3.4 +synopsis: A package just for testing Haskell-tools support. Don't install it. +description: + +homepage: https://github.com/nboldi/haskell-tools +license: BSD3 +license-file: LICENSE +author: Boldizsar Nemeth +maintainer: nboldi@elte.hu +category: Language +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: A + build-depends: base + default-language: Haskell2010 + cpp-options: -DMACRO
− examples/Project/illegal-extension/A.hs
@@ -1,2 +0,0 @@-{-# LANGUAGE CPP #-} -module A where
haskell-tools-cli.cabal view
@@ -1,5 +1,5 @@ name: haskell-tools-cli -version: 0.5.0.0 +version: 0.6.0.0 synopsis: Command-line frontend for Haskell-tools Refact description: Command-line frontend for Haskell-tools Refact. Not meant as a final product, only for demonstration purposes. homepage: https://github.com/haskell-tools/haskell-tools @@ -14,6 +14,8 @@ extra-source-files: examples/CppHs/Language/Preprocessor/*.hs , examples/CppHs/Language/Preprocessor/Cpphs/*.hs , bench-tests/*.txt + , examples/Project/cpp-opt/*.hs + , examples/Project/cpp-opt/*.cabal , examples/Project/has-cabal/*.hs , examples/Project/has-cabal/*.cabal , examples/Project/multi-packages/package1/*.hs @@ -29,7 +31,6 @@ , examples/Project/multi-packages-same-module/package2/*.hs , examples/Project/multi-packages-same-module/package2/*.cabal , examples/Project/no-cabal/*.hs - , examples/Project/illegal-extension/*.hs , examples/Project/reloading/*.hs , examples/Project/selection/*.hs , examples/Project/source-dir/*.cabal @@ -38,7 +39,6 @@ , examples/Project/src/*.hs library - ghc-options: -O2 build-depends: base >= 4.9 && < 4.10 , containers >= 0.5 && < 0.6 , mtl >= 2.2 && < 2.3 @@ -48,59 +48,52 @@ , ghc >= 8.0 && < 8.1 , ghc-paths >= 0.1 && < 0.2 , references >= 0.3 && < 0.4 - , haskell-tools-ast >= 0.5 && < 0.6 - , haskell-tools-prettyprint >= 0.5 && < 0.6 - , haskell-tools-refactor >= 0.5 && < 0.6 + , strict >= 0.3 && < 0.4 + , haskell-tools-ast >= 0.6 && < 0.7 + , haskell-tools-prettyprint >= 0.6 && < 0.7 + , haskell-tools-refactor >= 0.6 && < 0.7 exposed-modules: Language.Haskell.Tools.Refactor.CLI default-language: Haskell2010 executable ht-refact - ghc-options: -O2 -rtsopts + ghc-options: -rtsopts build-depends: base >= 4.9 && < 4.10 - , haskell-tools-cli >= 0.5 && < 0.6 + , haskell-tools-cli >= 0.6 && < 0.7 hs-source-dirs: exe main-is: Main.hs default-language: Haskell2010 - -executable ht-test-hackage - build-depends: base >= 4.9 && < 4.10 - , directory >= 1.2 && < 1.4 - , process >= 1.4 && < 1.5 - , split >= 0.2 && < 0.3 - hs-source-dirs: test-hackage - main-is: Main.hs - default-language: Haskell2010 executable ht-test-stackage build-depends: base >= 4.9 && < 4.10 , directory >= 1.2 && < 1.4 , process >= 1.4 && < 1.5 , split >= 0.2 && < 0.3 + ghc-options: -threaded -with-rtsopts=-M4g hs-source-dirs: test-stackage main-is: Main.hs default-language: Haskell2010 test-suite haskell-tools-cli-tests type: exitcode-stdio-1.0 - ghc-options: -with-rtsopts=-M2g -O2 + ghc-options: -with-rtsopts=-M2g hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs build-depends: base >= 4.9 && < 4.10 , tasty >= 0.11 && < 0.12 , tasty-hunit >= 0.9 && < 0.10 , directory >= 1.2 && < 1.4 , filepath >= 1.4 && < 2.0 - , haskell-tools-cli >= 0.5 && < 0.6 + , haskell-tools-cli >= 0.6 && < 0.7 , knob >= 0.1 && < 0.2 , bytestring >= 0.10 && < 0.11 default-language: Haskell2010 benchmark cli-benchmark type: exitcode-stdio-1.0 - ghc-options: -with-rtsopts=-M2g -O2 + ghc-options: -with-rtsopts=-M2g build-depends: base >= 4.9 && < 4.10 - , haskell-tools-cli >= 0.5 && < 0.6 + , haskell-tools-cli >= 0.6 && < 0.7 , criterion >= 1.1 && < 1.2 , time >= 1.6 && < 1.7 , aeson >= 1.0 && < 1.2 @@ -110,6 +103,4 @@ , bytestring >= 0.10 && < 0.11 , split >= 0.2 && < 0.3 hs-source-dirs: benchmark - main-is: Main.hs - - + main-is: Main.hs
− test-hackage/Main.hs
@@ -1,72 +0,0 @@-{-# LANGUAGE LambdaCase - #-} -module Main where - -import Control.Applicative -import Control.Monad -import System.Directory -import System.Process -import System.Environment -import System.Exit -import Data.List -import Data.List.Split - -data Result = GetFailure - | DepInstallFailure - | BuildFailure - | RefactError - | WrongCodeError - | OK - deriving Show - -main :: IO () -main = do args <- getArgs - testHackage args - -testHackage :: [String] -> IO () -testHackage args = do - createDirectoryIfMissing False workDir - withCurrentDirectory workDir $ do - unsetEnv "GHC_PACKAGE_PATH" - callCommand "cabal update" - callCommand "cabal list --simple > packages.txt 2>&1" - packages <- map (map (\case ' ' -> '-'; c -> c)) . lines <$> readFile "packages.txt" - alreadyTested <- if noRetest then do appendFile resultFile "" - map (head . splitOn ";") . filter (not . null) . lines - <$> readFile "results.csv" - else writeFile resultFile "" >> return [] - putStrLn $ "Skipping " ++ show (length alreadyTested) ++ " already tested packages" - let filteredPackages = packages \\ alreadyTested - mapM_ testAndEvaluate filteredPackages - where workDir = "hackage-test" - resultFile = "results.csv" - - noRetest = "-no-retest" `elem` args - testAndEvaluate p = do - res <- testPackage p - appendFile resultFile (p ++ ";" ++ show res ++ "\n") - - -testPackage :: String -> IO Result -testPackage pack = do - downloaded <- doesDirectoryExist pack - getSuccess <- if not downloaded then waitForProcess =<< runCommand ("cabal get " ++ pack) - else return ExitSuccess - case getSuccess of - ExitSuccess -> - withCurrentDirectory pack $ do - callCommand "cabal sandbox init" - runCommands [ ("cabal install -j --only-dependencies --enable-tests --enable-benchmarks > deps-log.txt 2>&1", DepInstallFailure) - , ("cabal configure --enable-tests --enable-benchmarks > config-log.txt 2>&1", BuildFailure) - , ("cabal build -j > build-log.txt 2>&1", BuildFailure) - , ("ht-refact -one-shot -refactoring=ProjectOrganizeImports -package-db .cabal-sandbox\\x86_64-windows-ghc-8.0.1-packages.conf.d . +RTS -M6G -RTS > refact-log.txt 2>&1", RefactError) - , ("cabal build > reload-log.txt 2>&1", WrongCodeError) - ] - ExitFailure _ -> return GetFailure - -runCommands :: [(String, Result)] -> IO Result -runCommands [] = return OK -runCommands ((cmd,failRes):rest) = do - exitCode <- waitForProcess =<< runCommand cmd - case exitCode of ExitSuccess -> runCommands rest - ExitFailure _ -> return failRes
test-stackage/Main.hs view
@@ -1,18 +1,20 @@-{-# LANGUAGE LambdaCase - #-} +{-# LANGUAGE LambdaCase #-} module Main where import Control.Applicative +import Control.Exception import Control.Monad import System.Directory +import System.IO import System.Process +import System.Timeout import System.Environment import System.Exit import Control.Concurrent import Data.List import Data.List.Split -data Result = GetFailure +data Result = GetFailure | BuildFailure | RefactError | WrongCodeError @@ -24,12 +26,12 @@ testHackage args testHackage :: [String] -> IO () -testHackage args = do +testHackage args = do createDirectoryIfMissing False workDir withCurrentDirectory workDir $ do packages <- lines <$> readFile (last args) - alreadyTested <- if noRetest then do appendFile resultFile "" - map (head . splitOn ";") . filter (not . null) . lines + alreadyTested <- if noRetest then do appendFile resultFile "" + map (head . splitOn ";") . filter (not . null) . lines <$> readFile resultFile else writeFile resultFile "" >> return [] let filteredPackages = packages \\ alreadyTested @@ -40,27 +42,40 @@ noRetest = "-no-retest" `elem` args testAndEvaluate p = do - res <- testPackage p - appendFile resultFile (p ++ ";" ++ show res ++ "\n") + (res, problem) <- testPackage p + appendFile resultFile (p ++ ";" ++ show res ++ " ; " ++ problem ++ "\n") -testPackage :: String -> IO Result -testPackage pack = - runCommands [ Left ("cabal get " ++ pack, GetFailure) - , Right $ do threadDelay 1000000 - createDirectoryIfMissing False testedDir +testPackage :: String -> IO (Result, String) +testPackage pack = do + res <- runCommands + [ Left ("cabal get " ++ pack, GetFailure) + , Right refreshDir + , Left ("stack build --test --no-run-tests --bench --no-run-benchmarks > logs\\" ++ pack ++ "-build-log.txt 2>&1", BuildFailure) + , Left ("stack exec ht-refact --stack-yaml=..\\stack.yaml -- -one-shot -refactoring=ProjectOrganizeImports tested-package tested-package\\.stack-work\\dist\\" ++ snapshotId ++ "\\build\\autogen -package base +RTS -M6G -RTS > logs\\" ++ pack ++ "-refact-log.txt 2>&1", RefactError) + , Left ("stack build > logs\\" ++ pack ++ "-reload-log.txt 2>&1", WrongCodeError) + ] + problem <- case res of + RefactError -> map (\case '\n' -> ' '; c -> c) <$> readFile ("logs\\" ++ pack ++ "-refact-log.txt") + WrongCodeError -> map (\case '\n' -> ' '; c -> c) <$> readFile ("logs\\" ++ pack ++ "-reload-log.txt") + _ -> return "" + return (res, problem) + where testedDir = "tested-package" + snapshotId = "ca59d0ab" + refreshDir = refreshDir' 3 + refreshDir' n = do createDirectoryIfMissing False testedDir removeDirectoryRecursive testedDir renameDirectory pack testedDir - , Left ("stack build --test --no-run-tests --bench --no-run-benchmarks > logs\\" ++ pack ++ "-build-log.txt 2>&1", BuildFailure) - , Left ("stack exec ht-refact -- -one-shot -refactoring=ProjectOrganizeImports tested-package +RTS -M6G -RTS > logs\\" ++ pack ++ "-refact-log.txt 2>&1", RefactError) - , Left ("stack build > logs\\" ++ pack ++ "-reload-log.txt 2>&1", WrongCodeError) - ] - where testedDir = "tested-package" + `catch` \e -> if n <= 0 + then throwIO (e :: IOException) + else do threadDelay 500000 + refreshDir' (n-1) runCommands :: [Either (String, Result) (IO ())] -> IO Result runCommands [] = return OK -runCommands (Left (cmd,failRes) : rest) = do - exitCode <- waitForProcess =<< runCommand cmd +runCommands (Left (cmd,failRes) : rest) = do + pr <- runCommand cmd + exitCode <- waitForProcess pr case exitCode of ExitSuccess -> runCommands rest ExitFailure _ -> return failRes -runCommands (Right act : rest) = act >> runCommands rest+runCommands (Right act : rest) = act >> runCommands rest
test/Main.hs view
@@ -25,7 +25,7 @@ makeCliTest :: ([FilePath], [String], String, String) -> TestTree makeCliTest (dirs, args, input, output) = let dir = joinPath $ longestCommonPrefix $ map splitDirectories dirs testdirs = map (((dir ++ "_test") </>) . makeRelative dir) dirs - in testCase dir $ do + in testCase dir $ do exists <- doesDirectoryExist (dir ++ "_test") when exists $ removeDirectoryRecursive (dir ++ "_test") copyDir dir (dir ++ "_test") @@ -39,33 +39,36 @@ `finally` removeDirectoryRecursive (dir ++ "_test") cliTests :: [([FilePath], [String], String, String)] -cliTests - = [ ( [testRoot </> "Project" </> "source-dir"] - , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] +cliTests + = [ ( [testRoot </> "Project" </> "cpp-opt"] + , ["-dry-run", "-one-shot", "-module-name=A"] + , "", oneShotPrefix ["A"] ++ "-module-name or -refactoring flag not specified correctly. Not doing any refactoring.\n") + , ( [testRoot </> "Project" </> "source-dir"] + , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] , "", oneShotPrefix ["A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nx :: ()\nx = ()\n") , ( [testRoot </> "Project" </> "source-dir-outside"] - , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] + , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] , "", oneShotPrefix ["A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nx :: ()\nx = ()\n") , ( [testRoot </> "Project" </> "no-cabal"] - , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] + , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] , "", oneShotPrefix ["A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nx :: ()\nx = ()\n") , ( [testRoot </> "Project" </> "has-cabal"] - , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] + , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1-3:1\""] , "", oneShotPrefix ["A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nx :: ()\nx = ()\n") - , ( [testRoot </> "Project" </> "selection"], [] + , ( [testRoot </> "Project" </> "selection"], [] , "SelectModule C\nSelectModule B\nRenameDefinition 5:1-5:2 bb\nSelectModule C\nRenameDefinition 3:1-3:2 cc\nExit" - , prefixText ["C","B"] ++ "no-module-selected> C> B> " + , prefixText ["C","B"] ++ "no-module-selected> C> B> " ++ reloads ["B"] ++ "B> C> " ++ reloads ["C", "B"] ++ "C> " ) - , ( [testRoot </> "Project" </> "reloading"], [] + , ( [testRoot </> "Project" </> "reloading"], [] , "SelectModule C\nRenameDefinition 3:1-3:2 cc\nSelectModule B\nRenameDefinition 5:1-5:2 bb\nExit" - , prefixText ["C","B","A"] ++ "no-module-selected> C> " + , prefixText ["C","B","A"] ++ "no-module-selected> C> " ++ reloads ["C", "B", "A"] ++ "C> B> " ++ reloads ["B", "A"] ++ "B> ") , ( map ((testRoot </> "Project" </> "multi-packages") </>) ["package1", "package2"] , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"RenameDefinition 3:1-3:2 xx\""], "" - , oneShotPrefix ["B", "A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nxx = ()\n" + , oneShotPrefix ["B", "A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nxx = ()\n" ) , ( map ((testRoot </> "Project" </> "multi-packages-flags") </>) ["package1", "package2"] , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"RenameDefinition 3:1-3:2 xx\""], "" @@ -73,26 +76,23 @@ ) , ( map ((testRoot </> "Project" </> "multi-packages-same-module") </>) ["package1", "package2"] , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"RenameDefinition 3:1-3:2 xx\""], "" - , "Compiling modules. This may take some time. Please wait.\nLoaded module: A\n" + , "Compiling modules. This may take some time. Please wait.\nLoaded module: A\n" ++ "The following modules are ignored: A. Multiple modules with the same qualified name are not supported.\n" - ++ "All modules loaded.\n" + ++ "All modules loaded.\n" ++ "### Module changed: A\n### new content:\nmodule A where\n\nxx = ()\n" ) - , ( [testRoot </> "Project" </> "illegal-extension"] - , ["-dry-run", "-one-shot"] - , "", "Compiling modules. This may take some time. Please wait.\nThe following extensions are not allowed: CPP.\n") ] benchTests :: IO [TestTree] -benchTests +benchTests = forM ["full-1", "full-2", "full-3"] $ \id -> do commands <- readFile ("bench-tests" </> id <.> "txt") return $ makeCliTest (["examples" </> "CppHs"], [], filter (/='\r') commands, expectedOut id) -expectedOut "full-1" +expectedOut "full-1" = prefixText cppHsMods ++ "no-module-selected> Language.Preprocessor.Cpphs.CppIfdef> " ++ concat (replicate 8 (reloads cppIfDefReloads ++ "Language.Preprocessor.Cpphs.CppIfdef> ")) -expectedOut "full-2" +expectedOut "full-2" = prefixText cppHsMods ++ "no-module-selected> Language.Preprocessor.Cpphs.MacroPass> " ++ concat (replicate 3 (reloads macroPassReloads ++ "Language.Preprocessor.Cpphs.MacroPass> ")) expectedOut "full-3" @@ -107,7 +107,7 @@ ++ "Language.Preprocessor.Cpphs.CppIfdef> " ++ concat (replicate 3 (reloads cppIfDefReloads ++ "Language.Preprocessor.Cpphs.CppIfdef> ")) -cppIfDefReloads = [ "Language.Preprocessor.Cpphs.CppIfdef" +cppIfDefReloads = [ "Language.Preprocessor.Cpphs.CppIfdef" , "Language.Preprocessor.Cpphs.RunCpphs" , "Language.Preprocessor.Cpphs" ] macroPassReloads = "Language.Preprocessor.Cpphs.MacroPass" : cppIfDefReloads @@ -127,20 +127,20 @@ testRoot = "examples" prefixText :: [String] -> String -prefixText mods - = "Compiling modules. This may take some time. Please wait.\n" - ++ concatMap (\m -> "Loaded module: " ++ m ++ "\n") mods +prefixText mods + = "Compiling modules. This may take some time. Please wait.\n" + ++ concatMap (\m -> "Loaded module: " ++ m ++ "\n") mods ++ "All modules loaded. Use 'SelectModule module-name' to select a module.\n" oneShotPrefix :: [String] -> String -oneShotPrefix mods - = "Compiling modules. This may take some time. Please wait.\n" - ++ concatMap (\m -> "Loaded module: " ++ m ++ "\n") mods +oneShotPrefix mods + = "Compiling modules. This may take some time. Please wait.\n" + ++ concatMap (\m -> "Loaded module: " ++ m ++ "\n") mods ++ "All modules loaded.\n" reloads :: [String] -> String -reloads mods = concatMap (\m -> "Re-loaded module: " ++ m ++ "\n") mods +reloads mods = concatMap (\m -> "Re-loaded module: " ++ m ++ "\n") mods copyDir :: FilePath -> FilePath -> IO () copyDir src dst = do @@ -166,4 +166,4 @@ | otherwise = [] longestCommonPrefix :: (Eq a) => [[a]] -> [a] -longestCommonPrefix = foldl1 commonPrefix+longestCommonPrefix = foldl1 commonPrefix