Hello community, here is the log from the commit of package ghc-haskell-tools-cli for openSUSE:Factory checked in at 2017-08-31 20:55:56 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-haskell-tools-cli (Old) and /work/SRC/openSUSE:Factory/.ghc-haskell-tools-cli.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-haskell-tools-cli" Thu Aug 31 20:55:56 2017 rev:2 rq:513370 version:0.8.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-haskell-tools-cli/ghc-haskell-tools-cli.changes 2017-04-12 18:06:43.930420432 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-haskell-tools-cli.new/ghc-haskell-tools-cli.changes 2017-08-31 20:55:57.907617881 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:05:13 UTC 2017 - psimons@suse.com + +- Update to version 0.8.0.0. + +------------------------------------------------------------------- Old: ---- haskell-tools-cli-0.5.0.0.tar.gz New: ---- haskell-tools-cli-0.8.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-haskell-tools-cli.spec ++++++ --- /var/tmp/diff_new_pack.WvP5Dy/_old 2017-08-31 20:55:58.675509990 +0200 +++ /var/tmp/diff_new_pack.WvP5Dy/_new 2017-08-31 20:55:58.675509990 +0200 @@ -19,7 +19,7 @@ %global pkg_name haskell-tools-cli %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.5.0.0 +Version: 0.8.0.0 Release: 0 Summary: Command-line frontend for Haskell-tools Refact License: BSD-3-Clause @@ -41,6 +41,7 @@ BuildRequires: ghc-references-devel BuildRequires: ghc-rpm-macros BuildRequires: ghc-split-devel +BuildRequires: ghc-strict-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build %if %{with tests} BuildRequires: ghc-bytestring-devel @@ -88,7 +89,6 @@ %defattr(-,root,root,-) %doc LICENSE %{_bindir}/ht-refact -%{_bindir}/ht-test-hackage %{_bindir}/ht-test-stackage %files devel -f %{name}-devel.files ++++++ haskell-tools-cli-0.5.0.0.tar.gz -> haskell-tools-cli-0.8.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/Language/Haskell/Tools/Refactor/CLI.hs new/haskell-tools-cli-0.8.0.0/Language/Haskell/Tools/Refactor/CLI.hs --- old/haskell-tools-cli-0.5.0.0/Language/Haskell/Tools/Refactor/CLI.hs 2017-01-31 20:47:43.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/Language/Haskell/Tools/Refactor/CLI.hs 2017-07-01 13:13:30.000000000 +0200 @@ -9,14 +9,17 @@ import Control.Applicative ((<|>)) import Control.Exception (displayException) -import Control.Monad.State +import Control.Monad.State.Strict import Control.Reference import Data.List import Data.List.Split import Data.Maybe +import Data.Char import System.Directory import System.Exit import System.IO +import System.FilePath +import Data.Version (showVersion) import DynFlags as GHC import ErrUtils @@ -27,14 +30,15 @@ import Packages import Language.Haskell.Tools.PrettyPrint -import Language.Haskell.Tools.Refactor +import Language.Haskell.Tools.Refactor as HT import Language.Haskell.Tools.Refactor.GetModules import Language.Haskell.Tools.Refactor.Perform import Language.Haskell.Tools.Refactor.Session +import Paths_haskell_tools_cli (version) type CLIRefactorSession = StateT CLISessionState Ghc -data CLISessionState = +data CLISessionState = CLISessionState { _refactState :: RefactorSessionState , _actualMod :: Maybe SourceFileKey , _exiting :: Bool @@ -46,11 +50,13 @@ 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"] refactorSession :: Handle -> Handle -> [String] -> IO Bool +refactorSession _ _ args | "-v" `elem` args = do putStrLn $ showVersion version + return True refactorSession input output args = runGhc (Just libdir) $ handleSourceError printSrcErrors $ flip evalStateT initSession $ do lift $ initGhcFlags @@ -61,8 +67,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 +76,10 @@ 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 - Right (_, ignoredMods) -> do - 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) + res <- loadPackagesFrom (\ms -> liftIO $ hPutStrLn output ("Loaded module: " ++ modSumName ms)) (const $ return ()) (\_ _ -> return []) workingDirs + case res of + Right _ -> do + 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 +91,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 +102,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 +116,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,27 +124,40 @@ 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 - mod <- gets (lookupModInSCs (SourceFileKey NormalHs modName) . (^. refSessMCs)) - if isJust mod then modify $ actualMod .= fmap fst mod - else liftIO $ hPutStrLn output ("Cannot find module: " ++ modName) +performSessionCommand output (LoadModule modName) = do + files <- HT.findModule modName + mcs <- gets (^. refSessMCs) + case nub files of + [] -> liftIO $ hPutStrLn output ("Cannot find module: " ++ modName) + [fileName] -> do + mod <- gets (lookupModInSCs (SourceFileKey fileName modName) . (^. refSessMCs)) + modify $ actualMod .= fmap fst mod + _ -> liftIO $ hPutStrLn output ("Ambiguous module: " ++ modName ++ " found: " ++ show files ++ " " ++ show mcs) return [] 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 @@ -154,34 +167,40 @@ return [] Right resMods -> performChanges output inDryMode resMods - where performChanges output False resMods = - forM resMods $ \case - ModuleCreated n m otherM -> do + where performChanges :: HasModuleInfo dom => Handle -> Bool -> [RefactorChange dom] -> CLIRefactorSession [SourceFileKey] + performChanges output False resMods = + 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) - return (SourceFileKey NormalHs n) + liftIO $ withBinaryFile loc WriteMode $ \handle -> do + hSetEncoding handle utf8 + hPutStr handle (prettyPrint m) + return (SourceFileKey n (sourceFileModule (loc `makeRelative` 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) + let file = n ^. sfkFileName + 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)) + Just (_,m) <- gets (lookupSourceFileInSCs 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 modify $ (refSessMCs .- removeModule mod) liftIO $ removeFile file + return (SourceFileKey file mod) _ -> do liftIO $ hPutStrLn output ("Module " ++ mod ++ " could not be removed.") - return (SourceFileKey NormalHs mod) - performChanges output True resMods = do - forM_ resMods (liftIO . \case + return (SourceFileKey "" mod) + + 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 +211,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 - \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/cpp-opt/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/cpp-opt/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/cpp-opt/A.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/cpp-opt/A.hs 2017-05-03 22:13:55.000000000 +0200 @@ -0,0 +1,6 @@ +{-# LANGUAGE CPP #-} +module A where + +#ifndef MACRO +"The macro 'MACRO' defined in the cabal file is not applied." +#endif diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/cpp-opt/some-test-package.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/cpp-opt/some-test-package.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/cpp-opt/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/cpp-opt/some-test-package.cabal 2017-05-03 22:13:55.000000000 +0200 @@ -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 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/illegal-extension/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/illegal-extension/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/illegal-extension/A.hs 2017-01-15 14:39:30.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/illegal-extension/A.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,2 +0,0 @@ -{-# LANGUAGE CPP #-} -module A where \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package1/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package1/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package1/A.hs 2017-01-08 10:56:21.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package1/A.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,3 +0,0 @@ -module A where - -x = () \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package1/package1.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package1/package1.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package1/package1.cabal 2017-01-08 10:56:21.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package1/package1.cabal 1970-01-01 01:00:00.000000000 +0100 @@ -1,18 +0,0 @@ -name: package1 -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 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package2/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package2/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package2/A.hs 2017-01-08 10:56:21.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package2/A.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1 +0,0 @@ -module A where diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package2/package2.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package2/package2.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/multi-packages-same-module/package2/package2.cabal 2017-01-08 10:56:21.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/multi-packages-same-module/package2/package2.cabal 1970-01-01 01:00:00.000000000 +0100 @@ -1,18 +0,0 @@ -name: package2 -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 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-main/Main.hs new/haskell-tools-cli-0.8.0.0/examples/Project/with-main/Main.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-main/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-main/Main.hs 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,3 @@ +module Main where + +main = putStrLn "Hello World" \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-main/some-test-package.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/with-main/some-test-package.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-main/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-main/some-test-package.cabal 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,18 @@ +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 + +executable foo + main-is: Main.hs + build-depends: base + default-language: Haskell2010 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-main-renamed/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/with-main-renamed/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-main-renamed/A.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-main-renamed/A.hs 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,3 @@ +module Main where + +main = putStrLn "Hello World" \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-main-renamed/some-test-package.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/with-main-renamed/some-test-package.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-main-renamed/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-main-renamed/some-test-package.cabal 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,18 @@ +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 + +executable foo + main-is: A.hs + build-depends: base + default-language: Haskell2010 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/A.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/A.hs 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,5 @@ +module Main where + +import B + +main = putStrLn (b ++ " World") \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/B.hs new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/B.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/B.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/B.hs 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,3 @@ +module B where + +b = "Hello" \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/Main.hs new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/Main.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/Main.hs 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,3 @@ +module Main where + +main = putStrLn "Hello World" \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/some-test-package.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/some-test-package.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-multi-main/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-multi-main/some-test-package.cabal 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1,24 @@ +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 + +executable foo + main-is: A.hs + build-depends: base + default-language: Haskell2010 + other-modules: B + +executable bar + main-is: Main.hs + build-depends: base + default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-other-executable/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/with-other-executable/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-other-executable/A.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-other-executable/A.hs 2017-06-08 14:14:30.000000000 +0200 @@ -0,0 +1,3 @@ +module A where + +main = putStrLn "Hello World" \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/with-other-executable/some-test-package.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/with-other-executable/some-test-package.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/with-other-executable/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/with-other-executable/some-test-package.cabal 2017-06-08 14:14:30.000000000 +0200 @@ -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 + +executable foo + main-is: A.hs + build-depends: base + default-language: Haskell2010 + ghc-options: -main-is A.main diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/working-dir/some-test-package.cabal new/haskell-tools-cli-0.8.0.0/examples/Project/working-dir/some-test-package.cabal --- old/haskell-tools-cli-0.5.0.0/examples/Project/working-dir/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/working-dir/some-test-package.cabal 2017-06-17 11:26:16.000000000 +0200 @@ -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 + hs-source-dirs: src + build-depends: base, directory, filepath + default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/examples/Project/working-dir/src/A.hs new/haskell-tools-cli-0.8.0.0/examples/Project/working-dir/src/A.hs --- old/haskell-tools-cli-0.5.0.0/examples/Project/working-dir/src/A.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/examples/Project/working-dir/src/A.hs 2017-06-17 11:26:16.000000000 +0200 @@ -0,0 +1,7 @@ +{-# LANGUAGE TemplateHaskell #-} +module A where + +import Language.Haskell.TH +import System.FilePath + +$(location >>= \loc -> runIO (readFile (takeDirectory (takeDirectory (loc_filename loc)) </> "data.txt")) >> return []) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/haskell-tools-cli.cabal new/haskell-tools-cli-0.8.0.0/haskell-tools-cli.cabal --- old/haskell-tools-cli-0.5.0.0/haskell-tools-cli.cabal 2017-01-31 20:57:11.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/haskell-tools-cli.cabal 2017-07-01 13:09:12.000000000 +0200 @@ -1,5 +1,5 @@ name: haskell-tools-cli -version: 0.5.0.0 +version: 0.8.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 @@ -24,21 +26,26 @@ , examples/Project/multi-packages-flags/package1/*.cabal , examples/Project/multi-packages-flags/package2/*.hs , examples/Project/multi-packages-flags/package2/*.cabal - , examples/Project/multi-packages-same-module/package1/*.hs - , examples/Project/multi-packages-same-module/package1/*.cabal - , 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 , examples/Project/source-dir/src/*.hs , examples/Project/source-dir-outside/*.cabal + , examples/Project/working-dir/src/*.hs + , examples/Project/working-dir/*.cabal + , examples/Project/working-dir/*.txt + , examples/Project/with-main/*.hs + , examples/Project/with-main/*.cabal + , examples/Project/with-main-renamed/*.hs + , examples/Project/with-main-renamed/*.cabal + , examples/Project/with-multi-main/*.hs + , examples/Project/with-multi-main/*.cabal + , examples/Project/with-other-executable/*.hs + , examples/Project/with-other-executable/*.cabal , 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,68 +55,60 @@ , 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.8 && < 0.9 + , haskell-tools-prettyprint >= 0.8 && < 0.9 + , haskell-tools-refactor >= 0.8 && < 0.9 exposed-modules: Language.Haskell.Tools.Refactor.CLI + , Paths_haskell_tools_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.8 && < 0.9 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.8 && < 0.9 , 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 - , criterion >= 1.1 && < 1.2 + , haskell-tools-cli >= 0.8 && < 0.9 + , criterion >= 1.1 && < 1.3 , time >= 1.6 && < 1.7 - , aeson >= 1.0 && < 1.2 + , aeson >= 1.0 && < 1.3 , directory >= 1.2 && < 1.4 , filepath >= 1.4 && < 2.0 , knob >= 0.1 && < 0.2 , bytestring >= 0.10 && < 0.11 , split >= 0.2 && < 0.3 hs-source-dirs: benchmark - main-is: Main.hs - - + main-is: Main.hs diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/test/Main.hs new/haskell-tools-cli-0.8.0.0/test/Main.hs --- old/haskell-tools-cli-0.5.0.0/test/Main.hs 2017-01-31 20:34:13.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/test/Main.hs 2017-06-17 11:26:16.000000000 +0200 @@ -23,76 +23,86 @@ allTests = map makeCliTest cliTests 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 - exists <- doesDirectoryExist (dir ++ "_test") - when exists $ removeDirectoryRecursive (dir ++ "_test") - copyDir dir (dir ++ "_test") - inKnob <- newKnob (pack input) - inHandle <- newFileHandle inKnob "<input>" ReadMode - outKnob <- newKnob (pack []) - outHandle <- newFileHandle outKnob "<output>" WriteMode - res <- refactorSession inHandle outHandle (args ++ testdirs) - actualOut <- Data.Knob.getContents outKnob - assertEqual "" (filter (/= '\r') output) (filter (/= '\r') $ unpack actualOut) - `finally` removeDirectoryRecursive (dir ++ "_test") +makeCliTest (dirs, args, input, output) + = let dir = joinPath $ longestCommonPrefix $ map splitDirectories dirs + testdirs = map (\d -> if d == dir then dir ++ "_test" else (dir ++ "_test" </> makeRelative dir d)) dirs + in testCase dir $ do + exists <- doesDirectoryExist (dir ++ "_test") + when exists $ removeDirectoryRecursive (dir ++ "_test") + copyDir dir (dir ++ "_test") + inKnob <- newKnob (pack input) + inHandle <- newFileHandle inKnob "<input>" ReadMode + outKnob <- newKnob (pack []) + outHandle <- newFileHandle outKnob "<output>" WriteMode + res <- refactorSession inHandle outHandle (args ++ testdirs) + actualOut <- Data.Knob.getContents outKnob + assertEqual "" (filter (/= '\r') output) (filter (/= '\r') $ unpack actualOut) + `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" </> "working-dir"] + , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"OrganizeImports\""] + , "", oneShotPrefix ["A"] ++ "### Module changed: A\n### new content:\n{-# LANGUAGE TemplateHaskell #-}\nmodule A where\n\nimport Language.Haskell.TH\nimport System.FilePath\n\n$(location >>= \\loc -> runIO (readFile (takeDirectory (takeDirectory (loc_filename loc)) </> \"data.txt\")) >> return [])\n\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\""], "" , oneShotPrefix ["B", "A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nxx = \\case () -> ()\n" ) - , ( 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" - ++ "The following modules are ignored: A. Multiple modules with the same qualified name are not supported.\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") + , ( [testRoot </> "Project" </> "with-main"] + , ["-dry-run", "-one-shot", "-module-name=Main", "-refactoring=\"GenerateSignature 3:1\""] + , "", oneShotPrefix ["Main"] ++ "### Module changed: Main\n### new content:\nmodule Main where\n\nmain :: IO ()\nmain = putStrLn \"Hello World\"\n") + , ( [testRoot </> "Project" </> "with-main-renamed"] + , ["-dry-run", "-one-shot", "-module-name=Main", "-refactoring=\"GenerateSignature 3:1\""] + , "", oneShotPrefix ["Main"] ++ "### Module changed: Main\n### new content:\nmodule Main where\n\nmain :: IO ()\nmain = putStrLn \"Hello World\"\n") + , ( [testRoot </> "Project" </> "with-multi-main"], ["-dry-run", "-one-shot", "-module-name=B", "-refactoring=\"RenameDefinition 3:1 bb\""], "" + , oneShotPrefix ["Main", "B", "Main"] + ++ "### Module changed: B\n### new content:\nmodule B where\n\nbb = \"Hello\"\n" + ++ "### Module changed: Main\n### new content:\nmodule Main where\n\nimport B\n\nmain = putStrLn (bb ++ \" World\")\n") + , ( [testRoot </> "Project" </> "with-other-executable"] + , ["-dry-run", "-one-shot", "-module-name=A", "-refactoring=\"GenerateSignature 3:1\""] + , "", oneShotPrefix ["A"] ++ "### Module changed: A\n### new content:\nmodule A where\n\nmain :: IO ()\nmain = putStrLn \"Hello World\"\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 +117,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 +137,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 +176,4 @@ | otherwise = [] longestCommonPrefix :: (Eq a) => [[a]] -> [a] -longestCommonPrefix = foldl1 commonPrefix \ No newline at end of file +longestCommonPrefix = foldl1 commonPrefix diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/test-hackage/Main.hs new/haskell-tools-cli-0.8.0.0/test-hackage/Main.hs --- old/haskell-tools-cli-0.5.0.0/test-hackage/Main.hs 2017-01-31 20:34:13.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/test-hackage/Main.hs 1970-01-01 01:00:00.000000000 +0100 @@ -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 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-cli-0.5.0.0/test-stackage/Main.hs new/haskell-tools-cli-0.8.0.0/test-stackage/Main.hs --- old/haskell-tools-cli-0.5.0.0/test-stackage/Main.hs 2017-01-31 20:34:13.000000000 +0100 +++ new/haskell-tools-cli-0.8.0.0/test-stackage/Main.hs 2017-06-17 11:26:16.000000000 +0200 @@ -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 @@ -39,28 +41,45 @@ resultFile = "results.csv" noRetest = "-no-retest" `elem` args + noLoad = "-no-load" `elem` args testAndEvaluate p = do - res <- testPackage p - appendFile resultFile (p ++ ";" ++ show res ++ "\n") + (res, problem) <- testPackage noLoad 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 :: Bool -> String -> IO (Result, String) +testPackage noLoad pack = do + res <- runCommands $ load + ++ [ Left ("stack build --test --no-run-tests --bench --no-run-benchmarks > logs\\" ++ pack ++ "-build-log.txt 2>&1", BuildFailure) + -- correct rts option handling (on windows) requires stack 1.4 + , let autogenPath = "tested-package\\.stack-work\\dist\\" ++ snapshotId ++ "\\build\\autogen" + logPath = "logs\\" ++ pack ++ "-refact-log.txt 2>&1" + dbPaths = ["C:\\Users\\nboldi\\AppData\\Local\\Programs\\stack\\x86_64-windows\\ghc-8.0.2\\lib\\package.conf.d", "C:\\sr\\snapshots\\c095693b\\pkgdb"] + in Left ("stack exec ht-refact --stack-yaml=..\\stack.yaml --rts-options -M4G -- -one-shot -refactoring=ProjectOrganizeImports tested-package " ++ autogenPath ++ " -clear-package-db" ++ concatMap (" -package-db " ++) dbPaths ++ " -package base > " ++ logPath, 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' 5 + 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) + load = if noLoad then [] else [ Left ("cabal get " ++ pack, GetFailure), Right refreshDir ] 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 \ No newline at end of file +runCommands (Right act : rest) = act >> runCommands rest