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 - [email protected]
+
+- 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: [email protected]
+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: [email protected]
-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: [email protected]
-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: [email protected]
+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: [email protected]
+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: [email protected]
+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: [email protected]
+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: [email protected]
+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
