August 2017 - openSUSE Commits - openSUSE Mailing Lists

commit ghc-haskell-tools-daemon for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-haskell-tools-daemon for openSUSE:Factory checked in at 2017-08-31 20:55:58 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-haskell-tools-daemon (Old) and /work/SRC/openSUSE:Factory/.ghc-haskell-tools-daemon.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-haskell-tools-daemon" Thu Aug 31 20:55:58 2017 rev:2 rq:513371 version:0.8.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-haskell-tools-daemon/ghc-haskell-tools-daemon.changes 2017-04-12 18:06:44.546333345 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-haskell-tools-daemon.new/ghc-haskell-tools-daemon.changes 2017-08-31 20:55:58.975467845 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:06:15 UTC 2017 - psimons(a)suse.com + +- Update to version 0.8.0.0. + +------------------------------------------------------------------- Old: ---- haskell-tools-daemon-0.5.0.0.tar.gz New: ---- haskell-tools-daemon-0.8.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-haskell-tools-daemon.spec ++++++ --- /var/tmp/diff_new_pack.hgiBmJ/_old 2017-08-31 20:56:00.067314437 +0200 +++ /var/tmp/diff_new_pack.hgiBmJ/_new 2017-08-31 20:56:00.083312189 +0200 @@ -19,7 +19,7 @@ %global pkg_name haskell-tools-daemon %bcond_with tests Name: ghc-%{pkg_name} -Version: 0.5.0.0 +Version: 0.8.0.0 Release: 0 Summary: Background process for Haskell-tools refactor that editors can connect to License: BSD-3-Clause @@ -28,6 +28,7 @@ Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: chrpath BuildRequires: ghc-Cabal-devel +BuildRequires: ghc-Diff-devel BuildRequires: ghc-aeson-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-containers-devel @@ -44,6 +45,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-HUnit-devel ++++++ haskell-tools-daemon-0.5.0.0.tar.gz -> haskell-tools-daemon-0.8.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/Language/Haskell/Tools/Refactor/Daemon/PackageDB.hs new/haskell-tools-daemon-0.8.0.0/Language/Haskell/Tools/Refactor/Daemon/PackageDB.hs --- old/haskell-tools-daemon-0.5.0.0/Language/Haskell/Tools/Refactor/Daemon/PackageDB.hs 2017-01-31 20:47:45.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/Language/Haskell/Tools/Refactor/Daemon/PackageDB.hs 2017-05-03 22:13:55.000000000 +0200 @@ -1,11 +1,13 @@ {-# LANGUAGE DeriveGeneric #-} module Language.Haskell.Tools.Refactor.Daemon.PackageDB where +import Control.Applicative (Applicative(..), (<$>), Alternative(..)) +import Control.Monad import Data.Aeson (FromJSON(..)) import Data.Char (isSpace) import Data.List import GHC.Generics (Generic(..)) -import System.Directory (withCurrentDirectory, doesFileExist, doesDirectoryExist) +import System.Directory import System.FilePath (FilePath, (</>)) import System.Process (readProcessWithExitCode) @@ -18,9 +20,6 @@ instance FromJSON PackageDB -packageDBLocs :: PackageDB -> [FilePath] -> IO [FilePath] -packageDBLocs pack = fmap concat . mapM (packageDBLoc pack) - packageDBLoc :: PackageDB -> FilePath -> IO [FilePath] packageDBLoc AutoDB path = (++) <$> packageDBLoc StackDB path <*> packageDBLoc CabalSandboxDB path packageDBLoc DefaultDB _ = return [] @@ -32,14 +31,43 @@ else return "" return $ map (drop (length "package-db: ")) $ filter ("package-db: " `isPrefixOf`) $ lines config packageDBLoc StackDB path = withCurrentDirectory path $ do - (_, snapshotDB, snapshotDBErrs) <- readProcessWithExitCode "stack" ["path", "--snapshot-pkg-db"] "" - (_, localDB, localDBErrs) <- readProcessWithExitCode "stack" ["path", "--local-pkg-db"] "" + (_, snapshotDB, snapshotDBErrs) <- readProcessWithExitCode "stack" ["path", "--allow-different-user", "--snapshot-pkg-db"] "" + (_, localDB, localDBErrs) <- readProcessWithExitCode "stack" ["path", "--allow-different-user", "--local-pkg-db"] "" return $ [trim localDB | null localDBErrs] ++ [trim snapshotDB | null snapshotDBErrs] packageDBLoc (ExplicitDB dir) path = do hasDir <- doesDirectoryExist (path </> dir) if hasDir then return [path </> dir] else return [] +-- | Gets the (probable) location of autogen folder depending on which type of +-- build we are using. +detectAutogen :: FilePath -> PackageDB -> IO (Maybe FilePath) +detectAutogen root AutoDB = do + defDB <- detectAutogen root DefaultDB + sandboxDB <- detectAutogen root CabalSandboxDB + stackDB <- detectAutogen root StackDB + return $ choose [ defDB, sandboxDB, stackDB ] +detectAutogen root DefaultDB = ifExists (root </> "dist" </> "build" </> "autogen") +detectAutogen root (ExplicitDB _) = ifExists (root </> "dist" </> "build" </> "autogen") +detectAutogen root CabalSandboxDB = ifExists (root </> "dist" </> "build" </> "autogen") +detectAutogen root StackDB = do + distExists <- doesDirectoryExist (root </> ".stack-work" </> "dist") + existing <- if distExists then (do + contents <- listDirectory (root </> ".stack-work" </> "dist") + let dirs = map ((root </> ".stack-work" </> "dist") </>) contents + subDirs <- mapM (\d -> map (d </>) <$> listDirectory d) dirs + mapM (ifExists . (</> "build" </> "autogen")) (dirs ++ concat subDirs)) else return [] + return (choose existing) + + trim :: String -> String trim = f . f - where f = reverse . dropWhile isSpace \ No newline at end of file + where f = reverse . dropWhile isSpace + +choose :: Alternative f => [f a] -> f a +choose = foldl (<|>) empty + +ifExists :: FilePath -> IO (Maybe FilePath) +ifExists fp = do exists <- doesDirectoryExist fp + if exists then return (Just fp) + else return Nothing diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/Language/Haskell/Tools/Refactor/Daemon/State.hs new/haskell-tools-daemon-0.8.0.0/Language/Haskell/Tools/Refactor/Daemon/State.hs --- old/haskell-tools-daemon-0.5.0.0/Language/Haskell/Tools/Refactor/Daemon/State.hs 2017-01-31 20:47:45.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/Language/Haskell/Tools/Refactor/Daemon/State.hs 2017-06-07 10:55:20.000000000 +0200 @@ -4,12 +4,14 @@ import Control.Reference import Language.Haskell.Tools.Refactor.Daemon.PackageDB +import Language.Haskell.Tools.Refactor.RefactorBase import Language.Haskell.Tools.Refactor.Session -data DaemonSessionState +data DaemonSessionState = DaemonSessionState { _refactorSession :: RefactorSessionState , _packageDB :: PackageDB , _packageDBSet :: Bool + , _packageDBLocs :: [FilePath] , _exiting :: Bool } @@ -17,4 +19,4 @@ instance IsRefactSessionState DaemonSessionState where refSessMCs = refactorSession & refSessMCs - initSession = DaemonSessionState initSession AutoDB False False \ No newline at end of file + initSession = DaemonSessionState initSession AutoDB False [] False diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/Language/Haskell/Tools/Refactor/Daemon.hs new/haskell-tools-daemon-0.8.0.0/Language/Haskell/Tools/Refactor/Daemon.hs --- old/haskell-tools-daemon-0.5.0.0/Language/Haskell/Tools/Refactor/Daemon.hs 2017-01-31 20:47:45.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/Language/Haskell/Tools/Refactor/Daemon.hs 2017-06-17 11:26:16.000000000 +0200 @@ -1,9 +1,11 @@ {-# LANGUAGE ScopedTypeVariables - , OverloadedStrings + , OverloadedStrings , DeriveGeneric , LambdaCase , TemplateHaskell , FlexibleContexts + , MultiWayIf + , TypeApplications #-} module Language.Haskell.Tools.Refactor.Daemon where @@ -11,13 +13,16 @@ import Control.Concurrent.MVar import Control.Exception import Control.Monad -import Control.Monad.State +import Control.Monad.State.Strict import Control.Reference import qualified Data.Aeson as A ((.=)) import Data.Aeson hiding ((.=)) +import Data.Algorithm.Diff +import qualified Data.ByteString.Char8 as StrictBS import Data.ByteString.Lazy.Char8 (ByteString) import Data.ByteString.Lazy.Char8 (unpack) import qualified Data.ByteString.Lazy.Char8 as BS +import Data.Either import Data.IORef import Data.List hiding (insert) import qualified Data.Map as Map @@ -29,6 +34,8 @@ import System.Directory import System.Environment import System.IO +import System.IO.Strict as StrictIO (hGetContents) +import Data.Version import Bag import DynFlags @@ -50,10 +57,7 @@ import Language.Haskell.Tools.Refactor.Prepare import Language.Haskell.Tools.Refactor.RefactorBase import Language.Haskell.Tools.Refactor.Session - -import Debug.Trace - --- TODO: handle boot files +import Paths_haskell_tools_daemon runDaemonCLI :: IO () runDaemonCLI = getArgs >>= runDaemon @@ -62,15 +66,14 @@ runDaemon args = withSocketsDo $ do let finalArgs = args ++ drop (length args) defaultArgs isSilent = read (finalArgs !! 1) + hSetBuffering stdout LineBuffering + hSetBuffering stderr LineBuffering when (not isSilent) $ putStrLn $ "Starting Haskell Tools daemon" - addrinfos <- getAddrInfo - (Just (defaultHints {addrFlags = [AI_PASSIVE]})) - Nothing (Just (finalArgs !! 0)) - let serveraddr = head addrinfos - sock <- socket (addrFamily serveraddr) Stream defaultProtocol + sock <- socket AF_INET Stream 0 setSocketOption sock ReuseAddr 1 - bind sock (addrAddress serveraddr) - listen sock 1 + when (not isSilent) $ putStrLn $ "Listening on port " ++ finalArgs !! 0 + bind sock (SockAddrInet (read (finalArgs !! 0)) iNADDR_ANY) + listen sock 4 clientLoop isSilent sock defaultArgs :: [String] @@ -115,58 +118,41 @@ -- | This function does the real job of acting upon client messages in a stateful environment of a client updateClient :: (ResponseMsg -> IO ()) -> ClientMessage -> StateT DaemonSessionState Ghc Bool +updateClient resp (Handshake _) = liftIO (resp $ HandshakeResponse $ versionBranch version) >> return True updateClient resp KeepAlive = liftIO (resp KeepAliveResponse) >> return True updateClient resp Disconnect = liftIO (resp Disconnected) >> return False -updateClient _ (SetPackageDB pkgDB) = modify (packageDB .= pkgDB) >> return True +updateClient _ (SetPackageDB pkgDB) = modify (packageDB .= pkgDB) >> return True updateClient resp (AddPackages packagePathes) = do - existingMCs <- gets (^. refSessMCs) - let existing = map ms_mod $ (existingMCs ^? traversal & filtered isTheAdded & mcModules & traversal & modRecMS) - needToReload <- (filter (\ms -> not $ ms_mod ms `elem` existing)) - <$> getReachableModules (\ms -> ms_mod ms `elem` existing) - modify $ refSessMCs .- filter (not . isTheAdded) -- remove the added package from the database - forM_ existing $ \mn -> removeTarget (TargetModule (GHC.moduleName mn)) - modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existing) . ms_mod) (hsc_mod_graph s) }) - initializePackageDBIfNeeded - res <- loadPackagesFrom (return . getModSumOrig) packagePathes - case res of - Right (modules, ignoredMods) -> do - mapM_ (reloadModule (\_ -> return ())) needToReload -- don't report consequent reloads (not expected) - liftIO $ resp - $ if not (null ignoredMods) - then ErrorMessage - $ "The following modules are ignored: " - ++ concat (intersperse ", " ignoredMods) - ++ ". Multiple modules with the same qualified name are not supported." - else LoadedModules modules - Left err -> liftIO $ resp $ either ErrorMessage CompilationProblem (getProblems err) + addPackages resp packagePathes return True - where isTheAdded mc = (mc ^. mcRoot) `elem` packagePathes - initializePackageDBIfNeeded = do - pkgDBAlreadySet <- gets (^. packageDBSet) - when (not pkgDBAlreadySet) $ do - pkgDB <- gets (^. packageDB) - pkgDBLocs <- liftIO $ packageDBLocs pkgDB packagePathes - usePackageDB pkgDBLocs - modify (packageDBSet .= True) - updateClient _ (RemovePackages packagePathes) = do mcs <- gets (^. refSessMCs) - let existing = map ms_mod (mcs ^? traversal & filtered isRemoved & mcModules & traversal & modRecMS) - lift $ forM_ existing (\modName -> removeTarget (TargetModule (GHC.moduleName modName))) + let existingFiles = concatMap @[] (map (^. sfkFileName) . Map.keys) (mcs ^? traversal & filtered isRemoved & mcModules) + lift $ forM_ existingFiles (\fs -> removeTarget (TargetFile fs Nothing)) lift $ deregisterDirs (mcs ^? traversal & filtered isRemoved & mcSourceDirs & traversal) modify $ refSessMCs .- filter (not . isRemoved) - modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existing) . ms_mod) (hsc_mod_graph s) }) + modifySession (\s -> s { hsc_mod_graph = filter ((`notElem` existingFiles) . getModSumOrig) (hsc_mod_graph s) }) + mcs <- gets (^. refSessMCs) + when (null mcs) $ modify (packageDBSet .= False) return True where isRemoved mc = (mc ^. mcRoot) `elem` packagePathes -updateClient resp (ReLoad changed removed) = - do removedMods <- gets (map ms_mod . filter ((`elem` removed) . getModSumOrig) . (^? refSessMCs & traversal & mcModules & traversal & modRecMS)) - lift $ forM_ removedMods (\modName -> removeTarget (TargetModule (GHC.moduleName modName))) - modify $ refSessMCs & traversal & mcModules - .- Map.filter (\m -> maybe True (not . (`elem` removed) . getModSumOrig) (m ^? modRecMS)) - modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` removedMods) . ms_mod) (hsc_mod_graph s) }) - reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [getModSumOrig ms])) +updateClient resp (ReLoad added changed removed) = + -- TODO: check for changed cabal files and reload their packages + do mcs <- gets (^. refSessMCs) + lift $ forM_ removed (\src -> removeTarget (TargetFile src Nothing)) + -- remove targets deleted + modify $ refSessMCs & traversal & mcModules + .- Map.filter (\m -> maybe True ((`notElem` removed) . getModSumOrig) (m ^? modRecMS)) + modifySession (\s -> s { hsc_mod_graph = filter (\mod -> getModSumOrig mod `notElem` removed) (hsc_mod_graph s) }) + -- reload changed modules + -- TODO: filter those that are in reloaded packages + reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)])) + (\mss -> resp (LoadingModules (map getModSumOrig mss))) (\ms -> getModSumOrig ms `elem` changed) + mcs <- gets (^. refSessMCs) + let mcsToReload = filter (\mc -> any ((mc ^. mcRoot) `isPrefixOf`) added && isNothing (moduleCollectionPkgId (mc ^. mcId))) mcs + addPackages resp (map (^. mcRoot) mcsToReload) -- reload packages containing added modules liftIO $ case reloadRes of Left errs -> resp (either ErrorMessage CompilationProblem (getProblems errs)) Right _ -> return () return True @@ -174,51 +160,135 @@ updateClient _ Stop = modify (exiting .= True) >> return False updateClient resp (PerformRefactoring refact modPath selection args) = do - (Just actualMod, otherMods) <- getFileMods modPath - let cmd = analyzeCommand refact (selection:args) - res <- lift $ performCommand cmd actualMod otherMods - case res of - Left err -> liftIO $ resp $ ErrorMessage err - Right diff -> do changedMods <- catMaybes <$> applyChanges diff - liftIO $ resp $ ModulesChanged (map snd changedMods) - -- when a new module is added, we need to compile it with the correct package db - void $ reloadChanges (map ((^. sfkModuleName) . fst) changedMods) + (selectedMod, otherMods) <- getFileMods modPath + case selectedMod of + Just actualMod -> do + case analyzeCommand refact (selection:args) of + Right cmd -> do res <- lift $ performCommand cmd actualMod otherMods + case res of + Left err -> liftIO $ resp $ ErrorMessage err + Right diff -> do changedMods <- applyChanges diff + liftIO $ resp $ ModulesChanged (map (either id (\(_,_,ch) -> ch)) changedMods) + void $ reloadChanges (map ((^. sfkModuleName) . (\(key,_,_) -> key)) (rights changedMods)) + Left err -> liftIO $ resp $ ErrorMessage err + Nothing -> liftIO $ resp $ ErrorMessage $ "The following file is not loaded to Haskell-tools: " + ++ modPath ++ ". Please add the containing package." return True - where applyChanges changes = do - forM changes $ \case - ModuleCreated n m otherM -> do + + where applyChanges changes = do + forM changes $ \case + ModuleCreated n m otherM -> do mcs <- gets (^. refSessMCs) Just (_, otherMR) <- gets (lookupModInSCs otherM . (^. refSessMCs)) let Just otherMS = otherMR ^? modRecMS Just mc = lookupModuleColl (otherM ^. sfkModuleName) mcs - modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcId) == (mc ^. mcId)) & mcModules - .- Map.insert (SourceFileKey NormalHs n) (ModuleNotLoaded False) otherSrcDir <- liftIO $ getSourceDir otherMS let loc = toFileName otherSrcDir n - liftIO $ withBinaryFile loc WriteMode (`hPutStr` prettyPrint m) - lift $ addTarget (Target (TargetModule (GHC.mkModuleName n)) True Nothing) - return $ Just (SourceFileKey NormalHs n, loc) + modify $ refSessMCs & traversal & filtered (\mc' -> (mc' ^. mcId) == (mc ^. mcId)) & mcModules + .- Map.insert (SourceFileKey loc n) (ModuleNotLoaded False False) + liftIO $ withBinaryFile loc WriteMode $ \handle -> do + hSetEncoding handle utf8 + hPutStr handle (prettyPrint m) + lift $ addTarget (Target (TargetFile loc Nothing) True Nothing) + return $ Right (SourceFileKey loc n, loc, RemoveAdded loc) ContentChanged (n,m) -> do - Just (_, mr) <- gets (lookupModInSCs n . (^. refSessMCs)) - let Just ms = mr ^? modRecMS - liftIO $ withBinaryFile (getModSumOrig ms) WriteMode (`hPutStr` prettyPrint m) - return $ Just (n, getModSumOrig ms) + let newCont = prettyPrint m + file = n ^. sfkFileName + origCont <- liftIO $ withBinaryFile file ReadMode $ \handle -> do + hSetEncoding handle utf8 + StrictIO.hGetContents handle + let undo = createUndo 0 $ getGroupedDiff origCont newCont + origCont <- liftIO $ withBinaryFile file WriteMode $ \handle -> do + hSetEncoding handle utf8 + hPutStr handle newCont + return $ Right (n, file, UndoChanges file undo) ModuleRemoved mod -> do - Just (_,m) <- gets (lookupModInSCs (SourceFileKey NormalHs mod) . (^. refSessMCs)) + Just (_,m) <- gets (lookupModuleInSCs mod . (^. refSessMCs)) let modName = GHC.moduleName $ fromJust $ fmap semanticsModule (m ^? typedRecModule) <|> fmap semanticsModule (m ^? renamedRecModule) ms <- getModSummary modName - lift $ removeTarget (TargetModule modName) + let file = getModSumOrig ms + origCont <- liftIO (StrictBS.unpack <$> StrictBS.readFile file) + lift $ removeTarget (TargetFile file Nothing) modify $ (refSessMCs .- removeModule mod) - liftIO $ removeFile (getModSumOrig ms) - return Nothing - - reloadChanges changedMods - = do reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [getModSumOrig ms])) + liftIO $ removeFile file + return $ Left $ RestoreRemoved file origCont + + reloadChanges changedMods + = do reloadRes <- reloadChangedModules (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)])) + (\mss -> resp (LoadingModules (map getModSumOrig mss))) (\ms -> modSumName ms `elem` changedMods) liftIO $ case reloadRes of Left errs -> resp (either ErrorMessage (ErrorMessage . ("The result of the refactoring contains errors: " ++) . show) (getProblems errs)) Right _ -> return () +addPackages :: (ResponseMsg -> IO ()) -> [FilePath] -> StateT DaemonSessionState Ghc () +addPackages resp [] = return () +addPackages resp packagePathes = do + nonExisting <- filterM ((return . not) <=< liftIO . doesDirectoryExist) packagePathes + if (not (null nonExisting)) + then liftIO $ resp $ ErrorMessage $ "The following packages are not found: " ++ concat (intersperse ", " nonExisting) + else do + -- clear existing removed packages + existingMCs <- gets (^. refSessMCs) + let existing = (existingMCs ^? traversal & filtered isTheAdded & mcModules & traversal & modRecMS) + existingModNames = map ms_mod existing + needToReload <- handleErrors $ (filter (\ms -> not $ ms_mod ms `elem` existingModNames)) + <$> getReachableModules (\_ -> return ()) (\ms -> ms_mod ms `elem` existingModNames) + modify $ refSessMCs .- filter (not . isTheAdded) -- remove the added package from the database + forM_ existing $ \ms -> removeTarget (TargetFile (getModSumOrig ms) Nothing) + modifySession (\s -> s { hsc_mod_graph = filter (not . (`elem` existingModNames) . ms_mod) (hsc_mod_graph s) }) + -- load new modules + pkgDBok <- initializePackageDBIfNeeded + if pkgDBok then do + res <- loadPackagesFrom (\ms -> resp (LoadedModules [(getModSumOrig ms, getModSumName ms)]) >> return (getModSumOrig ms)) + (resp . LoadingModules . map getModSumOrig) (\st fp -> maybeToList <$> detectAutogen fp (st ^. packageDB)) packagePathes + case res of + Right modules -> do + mapM_ (reloadModule (\_ -> return ())) (either (const []) id needToReload) -- don't report consequent reloads (not expected) + Left err -> liftIO $ resp $ either ErrorMessage CompilationProblem (getProblems err) + else liftIO $ resp $ ErrorMessage $ "Attempted to load two packages with different package DB. " + ++ "Stack, cabal-sandbox and normal packages cannot be combined" + where isTheAdded mc = (mc ^. mcRoot) `elem` packagePathes + initializePackageDBIfNeeded = do + pkgDBAlreadySet <- gets (^. packageDBSet) + pkgDB <- gets (^. packageDB) + locs <- liftIO $ mapM (packageDBLoc pkgDB) packagePathes + case locs of + firstLoc:rest -> + if | not (all (== firstLoc) rest) + -> return False + | pkgDBAlreadySet -> do + pkgDBLocs <- gets (^. packageDBLocs) + return (pkgDBLocs == firstLoc) + | otherwise -> do + usePackageDB firstLoc + modify ((packageDBSet .= True) . (packageDBLocs .= firstLoc)) + return True + [] -> return True + + +data UndoRefactor = RemoveAdded { undoRemovePath :: FilePath } + | RestoreRemoved { undoRestorePath :: FilePath + , undoRestoreContents :: String + } + | UndoChanges { undoChangedPath :: FilePath + , undoDiff :: FileDiff + } + deriving (Show, Generic) + +instance ToJSON UndoRefactor + +type FileDiff = [(Int, Int, String)] + +createUndo :: Eq a => Int -> [Diff [a]] -> [(Int, Int, [a])] +createUndo i (Both str _ : rest) = createUndo (i + length str) rest +createUndo i (First rem : Second add : rest) + = (i, i + length add, rem) : createUndo (i + length add) rest +createUndo i (First rem : rest) = (i, i, rem) : createUndo i rest +createUndo i (Second add : rest) + = (i, i + length add, []) : createUndo (i + length add) rest +createUndo _ [] = [] + initGhcSession :: IO Session initGhcSession = Session <$> (newIORef =<< runGhc (Just libdir) (initGhcFlags >> getSession)) @@ -226,9 +296,9 @@ usePackageDB [] = return () usePackageDB pkgDbLocs = do dfs <- getSessionDynFlags - dfs' <- liftIO $ fmap fst $ initPackages + dfs' <- liftIO $ fmap fst $ initPackages $ dfs { extraPkgConfs = (map PkgConfFile pkgDbLocs ++) . extraPkgConfs dfs - , pkgDatabase = Nothing + , pkgDatabase = Nothing } void $ setSessionDynFlags dfs' @@ -238,6 +308,7 @@ data ClientMessage = KeepAlive + | Handshake { clientVersion :: [Int] } | SetPackageDB { pkgDB :: PackageDB } | AddPackages { addedPathes :: [FilePath] } | RemovePackages { removedPathes :: [FilePath] } @@ -248,19 +319,22 @@ } | Stop | Disconnect - | ReLoad { changedModules :: [FilePath] + | ReLoad { addedModules :: [FilePath] + , changedModules :: [FilePath] , removedModules :: [FilePath] } deriving (Show, Generic) -instance FromJSON ClientMessage +instance FromJSON ClientMessage data ResponseMsg = KeepAliveResponse + | HandshakeResponse { serverVersion :: [Int] } | ErrorMessage { errorMsg :: String } | CompilationProblem { errorMarkers :: [(SrcSpan, String)] } - | ModulesChanged { moduleChanges :: [FilePath] } - | LoadedModules { loadedModules :: [FilePath] } + | ModulesChanged { undoChanges :: [UndoRefactor] } + | LoadedModules { loadedModules :: [(FilePath, String)] } + | LoadingModules { modulesToLoad :: [FilePath] } | Disconnected deriving (Show, Generic) @@ -268,9 +342,9 @@ instance ToJSON SrcSpan where toJSON (RealSrcSpan sp) = object [ "file" A..= unpackFS (srcSpanFile sp) - , "startRow" A..= srcLocLine (realSrcSpanStart sp) - , "startCol" A..= srcLocCol (realSrcSpanStart sp) - , "endRow" A..= srcLocLine (realSrcSpanEnd sp) + , "startRow" A..= srcLocLine (realSrcSpanStart sp) + , "startCol" A..= srcLocCol (realSrcSpanStart sp) + , "endRow" A..= srcLocLine (realSrcSpanEnd sp) , "endCol" A..= srcLocCol (realSrcSpanEnd sp) ] toJSON _ = Null diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/additional-files/A.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/additional-files/A.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/additional-files/A.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/additional-files/A.hs 2017-05-03 22:13:55.000000000 +0200 @@ -0,0 +1,5 @@ +module A where + +import B + +a = b \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/additional-files/B.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/additional-files/B.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/additional-files/B.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/additional-files/B.hs 2017-05-03 22:13:55.000000000 +0200 @@ -0,0 +1,3 @@ +module B where + +b = () \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/additional-files/some-test-package.cabal new/haskell-tools-daemon-0.8.0.0/examples/Project/additional-files/some-test-package.cabal --- old/haskell-tools-daemon-0.5.0.0/examples/Project/additional-files/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/additional-files/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(a)elte.hu +category: Language +build-type: Simple +cabal-version: >=1.10 +extra-src-files: B.hs + +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-daemon-0.5.0.0/examples/Project/cabal-sandbox/UseGroups.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/UseGroups.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/UseGroups.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/UseGroups.hs 2017-04-01 13:42:30.000000000 +0200 @@ -0,0 +1,7 @@ +module UseGroups where + +import Data.Group +import Data.Monoid + +x :: Sum Int +x = 3 `pow` 5 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE --- old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE 2017-04-01 13:42:30.000000000 +0200 @@ -0,0 +1,30 @@ +Copyright (c) 2013, Nathan "Taneb" van Doorn + +All rights reserved. + +Redistribution and use in source and binary forms, with or without +modification, are permitted provided that the following conditions are met: + + * Redistributions of source code must retain the above copyright + notice, this list of conditions and the following disclaimer. + + * Redistributions in binary form must reproduce the above + copyright notice, this list of conditions and the following + disclaimer in the documentation and/or other materials provided + with the distribution. + + * Neither the name of Nathan "Taneb" van Doorn nor the names of other + contributors may be used to endorse or promote products derived + from this software without specific prior written permission. + +THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS +"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT +LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR +A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT +OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, +SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT +LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, +DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY +THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT +(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE +OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs 2017-04-01 13:42:30.000000000 +0200 @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal --- old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal 2017-04-01 13:42:31.000000000 +0200 @@ -0,0 +1,19 @@ +name: groups +version: 0.4.0.0 +synopsis: Haskell 98 groups +description: + Haskell 98 groups. A group is a monoid with invertibility. +license: BSD3 +license-file: LICENSE +author: Nathan "Taneb" van Doorn +maintainer: nvd1234(a)gmail.com +copyright: Copyright (C) 2013 Nathan van Doorn +category: Algebra, Data, Math +build-type: Simple +cabal-version: >=1.8 + +library + exposed-modules: Data.Group + -- other-modules: + build-depends: base <5 + hs-source-dirs: src diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs 2017-04-01 13:42:30.000000000 +0200 @@ -0,0 +1,92 @@ +module Data.Group where + +import Data.Monoid + +-- |A 'Group' is a 'Monoid' plus a function, 'invert', such that: +-- +-- @a \<> invert a == mempty@ +-- +-- @invert a \<> a == mempty@ +class Monoid m => Group m where + invert :: m -> m + -- |@'pow' a n == a \<> a \<> ... \<> a @ + -- + -- @ (n lots of a) @ + -- + -- If n is negative, the result is inverted. + pow :: Integral x => m -> x -> m + pow x0 n0 = case compare n0 0 of + LT -> invert . f x0 $ negate n0 + EQ -> mempty + GT -> f x0 n0 + where + f x n + | even n = f (x `mappend` x) (n `quot` 2) + | n == 1 = x + | otherwise = g (x `mappend` x) ((n - 1) `quot` 2) x + g x n c + | even n = g (x `mappend` x) (n `quot` 2) c + | n == 1 = x `mappend` c + | otherwise = g (x `mappend` x) ((n - 1) `quot` 2) (x `mappend` c) + +instance Group () where + invert () = () + pow () _ = () + +instance Num a => Group (Sum a) where + invert = Sum . negate . getSum + {-# INLINE invert #-} + pow (Sum a) b = Sum (a * fromIntegral b) + +instance Fractional a => Group (Product a) where + invert = Product . recip . getProduct + {-# INLINE invert #-} + pow (Product a) b = Product (a ^^ b) + +instance Group a => Group (Dual a) where + invert = Dual . invert . getDual + {-# INLINE invert #-} + pow (Dual a) n = Dual (pow a n) + +instance Group b => Group (a -> b) where + invert f = invert . f + pow f n e = pow (f e) n + +instance (Group a, Group b) => Group (a, b) where + invert (a, b) = (invert a, invert b) + pow (a, b) n = (pow a n, pow b n) + +instance (Group a, Group b, Group c) => Group (a, b, c) where + invert (a, b, c) = (invert a, invert b, invert c) + pow (a, b, c) n = (pow a n, pow b n, pow c n) + +instance (Group a, Group b, Group c, Group d) => Group (a, b, c, d) where + invert (a, b, c, d) = (invert a, invert b, invert c, invert d) + pow (a, b, c, d) n = (pow a n, pow b n, pow c n, pow d n) + +instance (Group a, Group b, Group c, Group d, Group e) => Group (a, b, c, d, e) where + invert (a, b, c, d, e) = (invert a, invert b, invert c, invert d, invert e) + pow (a, b, c, d, e) n = (pow a n, pow b n, pow c n, pow d n, pow e n) + +-- |An 'Abelian' group is a 'Group' that follows the rule: +-- +-- @a \<> b == b \<> a@ +class Group g => Abelian g + +instance Abelian () + +instance Num a => Abelian (Sum a) + +instance Fractional a => Abelian (Product a) + +instance Abelian a => Abelian (Dual a) + +instance Abelian b => Abelian (a -> b) + +instance (Abelian a, Abelian b) => Abelian (a, b) + +instance (Abelian a, Abelian b, Abelian c) => Abelian (a, b, c) + +instance (Abelian a, Abelian b, Abelian c, Abelian d) => Abelian (a, b, c, d) + +instance (Abelian a, Abelian b, Abelian c, Abelian d, Abelian e) => Abelian (a, b, c, d, e) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/some-test-package.cabal new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/some-test-package.cabal --- old/haskell-tools-daemon-0.5.0.0/examples/Project/cabal-sandbox/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/cabal-sandbox/some-test-package.cabal 2017-04-01 13:42:30.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 +author: Boldizsar Nemeth +maintainer: nboldi(a)elte.hu +category: Language +build-type: Simple +cabal-version: >=1.10 + +library + exposed-modules: UseGroups + build-depends: base + , groups + default-language: Haskell2010 \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/th-added-later/package1/package1.cabal new/haskell-tools-daemon-0.8.0.0/examples/Project/th-added-later/package1/package1.cabal --- old/haskell-tools-daemon-0.5.0.0/examples/Project/th-added-later/package1/package1.cabal 2017-01-08 10:56:21.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/th-added-later/package1/package1.cabal 2017-05-03 22:13:55.000000000 +0200 @@ -1,7 +1,7 @@ name: package1 version: 1.2.3.4 synopsis: A package just for testing Haskell-tools support. Don't install it. -description: +description: homepage: https://github.com/nboldi/haskell-tools license: BSD3 @@ -14,5 +14,5 @@ library exposed-modules: A - build-depends: base + build-depends: base, template-haskell default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/th-added-later/package2/package2.cabal new/haskell-tools-daemon-0.8.0.0/examples/Project/th-added-later/package2/package2.cabal --- old/haskell-tools-daemon-0.5.0.0/examples/Project/th-added-later/package2/package2.cabal 2017-01-08 10:56:21.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/th-added-later/package2/package2.cabal 2017-05-03 22:13:55.000000000 +0200 @@ -1,7 +1,7 @@ name: package2 version: 1.2.3.4 synopsis: A package just for testing Haskell-tools support. Don't install it. -description: +description: homepage: https://github.com/nboldi/haskell-tools license: BSD3 @@ -14,5 +14,5 @@ library exposed-modules: B - build-depends: base, package1 + build-depends: base, package1, template-haskell default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/unused-mod/Main.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/unused-mod/Main.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/unused-mod/Main.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/unused-mod/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-daemon-0.5.0.0/examples/Project/unused-mod/Unused.hs new/haskell-tools-daemon-0.8.0.0/examples/Project/unused-mod/Unused.hs --- old/haskell-tools-daemon-0.5.0.0/examples/Project/unused-mod/Unused.hs 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/unused-mod/Unused.hs 2017-06-07 10:55:20.000000000 +0200 @@ -0,0 +1 @@ +Not a valid haskell program diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/examples/Project/unused-mod/some-test-package.cabal new/haskell-tools-daemon-0.8.0.0/examples/Project/unused-mod/some-test-package.cabal --- old/haskell-tools-daemon-0.5.0.0/examples/Project/unused-mod/some-test-package.cabal 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/examples/Project/unused-mod/some-test-package.cabal 2017-06-07 10:55:20.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(a)elte.hu +category: Language +build-type: Simple +cabal-version: >=1.10 + +executable foo + main-is: Main.hs + build-depends: base + default-language: Haskell2010 + other-modules: Unused diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/haskell-tools-daemon.cabal new/haskell-tools-daemon-0.8.0.0/haskell-tools-daemon.cabal --- old/haskell-tools-daemon-0.5.0.0/haskell-tools-daemon.cabal 2017-01-31 20:56:31.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/haskell-tools-daemon.cabal 2017-07-01 12:39:07.000000000 +0200 @@ -1,5 +1,5 @@ name: haskell-tools-daemon -version: 0.5.0.0 +version: 0.8.0.0 synopsis: Background process for Haskell-tools refactor that editors can connect to. description: Background process for Haskell-tools refactor that editors can connect to. homepage: https://github.com/haskell-tools/haskell-tools @@ -50,13 +50,24 @@ , examples/Project/load-error/*.hs , examples/Project/source-error/*.hs , examples/Project/empty/*.hs + , examples/Project/additional-files/*.hs + , examples/Project/additional-files/*.cabal + , examples/Project/cabal-sandbox/*.hs + , examples/Project/cabal-sandbox/*.cabal + , examples/Project/cabal-sandbox/groups-0.4.0.0/LICENSE + , examples/Project/cabal-sandbox/groups-0.4.0.0/Setup.hs + , examples/Project/cabal-sandbox/groups-0.4.0.0/groups.cabal + , examples/Project/cabal-sandbox/groups-0.4.0.0/src/Data/Group.hs + , examples/Project/unused-mod/*.hs + , examples/Project/unused-mod/*.cabal + library - ghc-options: -O2 build-depends: base >= 4.9 && < 5.0 - , aeson >= 1.0 && < 1.2 + , aeson >= 1.0 && < 1.3 , bytestring >= 0.10 && < 1.0 , filepath >= 1.4 && < 2.0 + , strict >= 0.3 && < 0.4 , containers >= 0.5 && < 0.6 , mtl >= 2.2 && < 2.3 , split >= 0.2 && < 1.0 @@ -66,30 +77,32 @@ , ghc-paths >= 0.1 && < 0.2 , references >= 0.3.2 && < 1.0 , network >= 2.6 && < 3.0 - , haskell-tools-ast >= 0.5 && < 0.6 - , haskell-tools-prettyprint >= 0.5 && < 0.6 - , haskell-tools-refactor >= 0.5 && < 0.6 + , Diff >= 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.Daemon , Language.Haskell.Tools.Refactor.Daemon.State , Language.Haskell.Tools.Refactor.Daemon.PackageDB + , Paths_haskell_tools_daemon default-language: Haskell2010 executable ht-daemon - ghc-options: -O2 + ghc-options: -rtsopts build-depends: base >= 4.9 && < 5.0 - , haskell-tools-daemon >= 0.5 && < 0.6 + , haskell-tools-daemon >= 0.8 && < 0.9 hs-source-dirs: exe main-is: Main.hs default-language: Haskell2010 test-suite haskell-tools-daemon-tests type: exitcode-stdio-1.0 - ghc-options: -with-rtsopts=-M2.5g -O2 + ghc-options: -with-rtsopts=-M2.5g hs-source-dirs: test - main-is: Main.hs + main-is: Main.hs build-depends: base >= 4.9 && < 4.10 - , HUnit >= 1.5 && < 1.6 + , HUnit >= 1.5 && < 1.7 , ghc >= 8.0 && < 8.1 , tasty >= 0.11 && < 0.12 , tasty-hunit >= 0.9 && < 0.10 @@ -98,6 +111,6 @@ , filepath >= 1.4 && < 2.0 , bytestring >= 0.10 && < 0.11 , network >= 2.6 && < 2.7 - , aeson >= 1.0 && < 1.2 - , haskell-tools-daemon >= 0.5 && < 0.6 - default-language: Haskell2010 \ No newline at end of file + , aeson >= 1.0 && < 1.3 + , haskell-tools-daemon >= 0.8 && < 0.9 + default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-daemon-0.5.0.0/test/Main.hs new/haskell-tools-daemon-0.8.0.0/test/Main.hs --- old/haskell-tools-daemon-0.5.0.0/test/Main.hs 2017-01-31 20:34:13.000000000 +0100 +++ new/haskell-tools-daemon-0.8.0.0/test/Main.hs 2017-06-07 10:55:20.000000000 +0200 @@ -17,6 +17,7 @@ import Network.Socket.ByteString.Lazy as Sock import qualified Data.ByteString.Lazy.Char8 as BS import qualified Data.List as List +import Data.List (sort) import Data.Aeson import Data.Maybe import System.IO @@ -32,37 +33,38 @@ main :: IO () main = do unsetEnv "GHC_PACKAGE_PATH" - portCounter <- newMVar pORT_NUM_START + portCounter <- newMVar pORT_NUM_START tr <- canonicalizePath testRoot - isStackRun <- isJust <$> lookupEnv "STACK_EXE" - defaultMain (allTests isStackRun tr portCounter) + hasStack <- isJust <$> findExecutable "stack" + hasCabal <- isJust <$> findExecutable "cabal" + defaultMain (allTests (hasStack && hasCabal) tr portCounter) allTests :: Bool -> FilePath -> MVar Int -> TestTree allTests isSource testRoot portCounter - = localOption (mkTimeout ({- 10s -} 1000 * 1000 * 10)) - $ testGroup "daemon-tests" - [ testGroup "simple-tests" - $ map (makeDaemonTest portCounter . (\(label, input, output) -> (Nothing, label, input, output))) simpleTests - , testGroup "loading-tests" - $ map (makeDaemonTest portCounter . (\(label, input, output) -> (Nothing, label, input, output))) loadingTests - , testGroup "refactor-tests" - $ map (makeDaemonTest portCounter . (\(label, dir, input, output) -> (Just (testRoot </> dir), label, input, output))) (refactorTests testRoot) - , testGroup "reload-tests" + = localOption (mkTimeout ({- 10s -} 1000 * 1000 * 20)) + $ testGroup "daemon-tests" + [ testGroup "simple-tests" + $ map (makeDaemonTest portCounter) simpleTests + , testGroup "loading-tests" + $ map (makeDaemonTest portCounter) loadingTests + , testGroup "refactor-tests" + $ map (makeRefactorTest portCounter) (refactorTests testRoot) + , testGroup "reload-tests" $ map (makeReloadTest portCounter) reloadingTests - , testGroup "compilation-problem-tests" + , testGroup "compilation-problem-tests" $ map (makeCompProblemTest portCounter) compProblemTests -- if not a stack build, we cannot guarantee that stack is on the path , if isSource then testGroup "pkg-db-tests" $ map (makePkgDbTest portCounter) pkgDbTests else testCase "IGNORED pkg-db-tests" (return ()) -- cannot execute this when the source is not present - , if isSource then selfLoadingTest portCounter else testCase "IGNORED self-load" (return ()) + -- , if isSource then selfLoadingTest portCounter else testCase "IGNORED self-load" (return ()) ] testSuffix = "_test" simpleTests :: [(String, [ClientMessage], [ResponseMsg])] -simpleTests = +simpleTests = [ ( "empty-test", [], [] ) , ( "keep-alive", [KeepAlive], [KeepAliveResponse] ) ] @@ -71,199 +73,207 @@ loadingTests = [ ( "load-package" , [AddPackages [testRoot </> "has-cabal"]] - , [LoadedModules [testRoot </> "has-cabal" </> "A.hs"]] ) + , [ LoadingModules [testRoot </> "has-cabal" </> "A.hs"] + , LoadedModules [(testRoot </> "has-cabal" </> "A.hs", "A")]] ) , ( "no-cabal" , [AddPackages [testRoot </> "no-cabal"]] - , [LoadedModules [testRoot </> "no-cabal" </> "A.hs"]] ) + , [ LoadingModules [testRoot </> "no-cabal" </> "A.hs"] + , LoadedModules [(testRoot </> "no-cabal" </> "A.hs", "A")]] ) , ( "source-dir" , [AddPackages [testRoot </> "source-dir"]] - , [LoadedModules [testRoot </> "source-dir" </> "src" </> "A.hs"]] ) + , [ LoadingModules [testRoot </> "source-dir" </> "src" </> "A.hs"] + , LoadedModules [(testRoot </> "source-dir" </> "src" </> "A.hs", "A")]] ) , ( "source-dir-outside" , [AddPackages [testRoot </> "source-dir-outside"]] - , [LoadedModules [testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs"]] ) + , [ LoadingModules [testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs"] + , LoadedModules [(testRoot </> "source-dir-outside" </> ".." </> "src" </> "A.hs", "A")]] ) , ( "multi-packages" , [ AddPackages [ testRoot </> "multi-packages" </> "package1" , testRoot </> "multi-packages" </> "package2" ]] - , [ LoadedModules [ testRoot </> "multi-packages" </> "package2" </> "B.hs" - , testRoot </> "multi-packages" </> "package1" </> "A.hs"]] ) + , [ LoadingModules [ testRoot </> "multi-packages" </> "package2" </> "B.hs" + , testRoot </> "multi-packages" </> "package1" </> "A.hs" ] + , LoadedModules [ (testRoot </> "multi-packages" </> "package2" </> "B.hs", "B") ] + , LoadedModules [ (testRoot </> "multi-packages" </> "package1" </> "A.hs", "A") ] ] ) , ( "multi-packages-flags" , [ AddPackages [ testRoot </> "multi-packages-flags" </> "package1" , testRoot </> "multi-packages-flags" </> "package2" ]] - , [ LoadedModules [ testRoot </> "multi-packages-flags" </> "package2" </> "B.hs" - , testRoot </> "multi-packages-flags" </> "package1" </> "A.hs"]] ) + , [ LoadingModules [ testRoot </> "multi-packages-flags" </> "package2" </> "B.hs" + , testRoot </> "multi-packages-flags" </> "package1" </> "A.hs" ] + , LoadedModules [ (testRoot </> "multi-packages-flags" </> "package2" </> "B.hs", "B") ] + , LoadedModules [ (testRoot </> "multi-packages-flags" </> "package1" </> "A.hs", "A") ] ] ) , ( "multi-packages-dependent" , [ AddPackages [ testRoot </> "multi-packages-dependent" </> "package1" , testRoot </> "multi-packages-dependent" </> "package2" ]] - , [ LoadedModules [ testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs" - , testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs"]] ) + , [ LoadingModules [ testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs" + , testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs" ] + , LoadedModules [ (testRoot </> "multi-packages-dependent" </> "package1" </> "A.hs", "A") ] + , LoadedModules [ (testRoot </> "multi-packages-dependent" </> "package2" </> "B.hs", "B") ] ] ) , ( "has-th" , [AddPackages [testRoot </> "has-th"]] - , [LoadedModules [testRoot </> "has-th" </> "TH.hs", testRoot </> "has-th" </> "A.hs"]] ) + , [ LoadingModules [ testRoot </> "has-th" </> "TH.hs", testRoot </> "has-th" </> "A.hs" ] + , LoadedModules [ (testRoot </> "has-th" </> "TH.hs", "TH") ] + , LoadedModules [ (testRoot </> "has-th" </> "A.hs", "A") ] ] ) , ( "th-added-later" , [ AddPackages [testRoot </> "th-added-later" </> "package1"] , AddPackages [testRoot </> "th-added-later" </> "package2"] ] - , [ LoadedModules [testRoot </> "th-added-later" </> "package1" </> "A.hs"] - , LoadedModules [testRoot </> "th-added-later" </> "package2" </> "B.hs"]] ) + , [ LoadingModules [ testRoot </> "th-added-later" </> "package1" </> "A.hs" ] + , LoadedModules [(testRoot </> "th-added-later" </> "package1" </> "A.hs", "A")] + , LoadingModules [ testRoot </> "th-added-later" </> "package2" </> "B.hs" ] + , LoadedModules [(testRoot </> "th-added-later" </> "package2" </> "B.hs", "B")] ] ) + , ( "unused-module" + , [ AddPackages [testRoot </> "unused-mod"] ] + , [ LoadingModules [ testRoot </> "unused-mod" </> "Main.hs" ] + , LoadedModules [ (testRoot </> "unused-mod" </> "Main.hs", "Main") ] ] ) ] compProblemTests :: [(String, [Either (IO ()) ClientMessage], [ResponseMsg] -> Bool)] -compProblemTests = +compProblemTests = [ ( "load-error" - , [ Right $ AddPackages [testRoot </> "load-error"] ] - , \case [CompilationProblem {}] -> True; _ -> False) + , [ Right $ SetPackageDB DefaultDB, Right $ AddPackages [testRoot </> "load-error"] ] + , \case [LoadingModules{}, CompilationProblem {}] -> True; _ -> False) , ( "source-error" - , [ Right $ AddPackages [testRoot </> "source-error"] ] - , \case [CompilationProblem {}] -> True; _ -> False) + , [ Right $ SetPackageDB DefaultDB, Right $ AddPackages [testRoot </> "source-error"] ] + , \case [LoadingModules{}, CompilationProblem {}] -> True; _ -> False) , ( "reload-error" - , [ Right $ AddPackages [testRoot </> "empty"] + , [ Right $ SetPackageDB DefaultDB, Right $ AddPackages [testRoot </> "empty"] , Left $ appendFile (testRoot </> "empty" </> "A.hs") "\n\nimport No.Such.Module" - , Right $ ReLoad [testRoot </> "empty" </> "A.hs"] [] + , Right $ ReLoad [] [testRoot </> "empty" </> "A.hs"] [] , Left $ writeFile (testRoot </> "empty" </> "A.hs") "module A where"] - , \case [LoadedModules {}, CompilationProblem {}] -> True; _ -> False) + , \case [LoadingModules {}, LoadedModules {}, LoadingModules {}, CompilationProblem {}] -> True; _ -> False) , ( "reload-source-error" - , [ Right $ AddPackages [testRoot </> "empty"] + , [ Right $ SetPackageDB DefaultDB, Right $ AddPackages [testRoot </> "empty"] , Left $ appendFile (testRoot </> "empty" </> "A.hs") "\n\naa = 3 + ()" - , Right $ ReLoad [testRoot </> "empty" </> "A.hs"] [] + , Right $ ReLoad [] [testRoot </> "empty" </> "A.hs"] [] , Left $ writeFile (testRoot </> "empty" </> "A.hs") "module A where"] - , \case [LoadedModules {}, CompilationProblem {}] -> True; _ -> False) + , \case [LoadingModules {}, LoadedModules {}, LoadingModules {}, CompilationProblem {}] -> True; _ -> False) + , ( "no-such-file" + , [ Right $ PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "3:1-3:2" ["y"] ] + , \case [ ErrorMessage _ ] -> True; _ -> False ) + , ( "additional-files" + , [ Right $ SetPackageDB DefaultDB, Right $ AddPackages [testRoot </> "additional-files"] ] + , \case [ LoadingModules {}, ErrorMessage _ ] -> True; _ -> False ) ] sourceRoot = ".." </> ".." </> "src" selfLoadingTest :: MVar Int -> TestTree -selfLoadingTest port = localOption (mkTimeout ({- 5 min -} 1000 * 1000 * 60 * 5)) $ testCase "self-load" $ do +selfLoadingTest port = localOption (mkTimeout ({- 5 min -} 1000 * 1000 * 60 * 5)) $ testCase "self-load" $ do actual <- communicateWithDaemon port - [ Right $ AddPackages (map (sourceRoot </>) ["ast", "backend-ghc", "prettyprint", "rewrite", "refactor", "daemon"]) ] - assertBool ("The expected result is a nonempty response message list that does not contain errors. Actual result: " ++ show actual) + [ Right $ AddPackages (map (sourceRoot </>) ["ast", "backend-ghc", "prettyprint", "rewrite", "refactor"]) ] + assertBool ("The expected result is a nonempty response message list that does not contain errors. Actual result: " ++ show actual) (not (null actual) && all (\case ErrorMessage {} -> False; _ -> True) actual) -refactorTests :: FilePath -> [(String, FilePath, [ClientMessage], [ResponseMsg])] +refactorTests :: FilePath -> [(String, FilePath, [ClientMessage], [ResponseMsg] -> Bool)] refactorTests testRoot = - [ ( "simple-refactor", "simple-refactor" + [ ( "simple-refactor", testRoot </> "simple-refactor" , [ AddPackages [ testRoot </> "simple-refactor" ++ testSuffix ] , PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "3:1-3:2" ["y"] ] - , [ LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ] - , ModulesChanged [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ] - , LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ] - ] ) - , ( "hs-boots", "hs-boots" + , \case [ LoadingModules{}, LoadedModules [ (aPath, _) ], ModulesChanged _, LoadingModules{}, LoadedModules [ (aPath', _) ]] + -> aPath == testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" && aPath == aPath'; _ -> False ) + , ( "hs-boots", testRoot </> "hs-boots" , [ AddPackages [ testRoot </> "hs-boots" ++ testSuffix ] , PerformRefactoring "RenameDefinition" (testRoot </> "hs-boots" ++ testSuffix </> "A.hs") "5:1-5:2" ["aa"] ] - , [ LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs-boot", testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" - , testRoot </> "hs-boots" ++ testSuffix </> "A.hs", testRoot </> "hs-boots" ++ testSuffix </> "B.hs" ] - , ModulesChanged [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs", testRoot </> "hs-boots" ++ testSuffix </> "B.hs" - , testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" ] - , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs-boot" ] - , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs-boot" ] - , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "A.hs" ] - , LoadedModules [ testRoot </> "hs-boots" ++ testSuffix </> "B.hs" ] - ] ) - , ( "remove-module", "simple-refactor" + , \case [ LoadingModules{}, LoadedModules _, LoadedModules _, LoadedModules _, LoadedModules _, ModulesChanged _ + , LoadingModules{}, LoadedModules [ (path1, _) ], LoadedModules [ (path2, _) ] + , LoadedModules [ (path3, _) ], LoadedModules [ (path4, _) ] + ] -> let allPathes = map ((testRoot </> "hs-boots" ++ testSuffix) </>) ["A.hs","B.hs","A.hs-boot","B.hs-boot"] + in sort [path1,path2,path3,path4] == sort allPathes + _ -> False ) + , ( "remove-module", testRoot </> "simple-refactor" , [ AddPackages [ testRoot </> "simple-refactor" ++ testSuffix ] , PerformRefactoring "RenameDefinition" (testRoot </> "simple-refactor" ++ testSuffix </> "A.hs") "1:8-1:9" ["AA"] ] - , [ LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" ] - , ModulesChanged [ testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" ] - , LoadedModules [ testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" ] - ] ) + , \case [ LoadingModules{},LoadedModules [ (aPath, _) ], ModulesChanged _, LoadingModules{},LoadedModules [ (aaPath, _) ]] + -> aPath == testRoot </> "simple-refactor" ++ testSuffix </> "A.hs" + && aaPath == testRoot </> "simple-refactor" ++ testSuffix </> "AA.hs" + _ -> False ) ] -reloadingTests :: [(String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg])] +reloadingTests :: [(String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg] -> Bool)] reloadingTests = [ ( "reloading-module", testRoot </> "reloading", [ AddPackages [ testRoot </> "reloading" ++ testSuffix ]] - , writeFile (testRoot </> "reloading" ++ testSuffix </> "C.hs") "module C where\nc = ()" - , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "C.hs"] [] - , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "2:1-2:2" ["d"] - ] - , [ LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" - , testRoot </> "reloading" ++ testSuffix </> "B.hs" - , testRoot </> "reloading" ++ testSuffix </> "A.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "B.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "A.hs" ] - , ModulesChanged [ testRoot </> "reloading" ++ testSuffix </> "C.hs" - , testRoot </> "reloading" ++ testSuffix </> "B.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "B.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "A.hs" ] - ] - ) + , writeFile (testRoot </> "reloading" ++ testSuffix </> "C.hs") "module C where\nc = ()" + , [ ReLoad [] [testRoot </> "reloading" ++ testSuffix </> "C.hs"] [] + , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "2:1-2:2" ["d"] + ] + , \case [ LoadingModules{}, LoadedModules [(pathC'',_)], LoadedModules [(pathB'',_)], LoadedModules [(pathA'',_)] + , LoadingModules{}, LoadedModules [(pathC,_)], LoadedModules [(pathB,_)], LoadedModules [(pathA,_)] + , ModulesChanged _, LoadingModules{},LoadedModules [(pathC',_)], LoadedModules [(pathB',_)], LoadedModules [(pathA',_)] + ] -> let allPathes = map ((testRoot </> "reloading" ++ testSuffix) </>) ["C.hs","B.hs","A.hs"] + in [pathC,pathB,pathA] == allPathes + && [pathC',pathB',pathA'] == allPathes + && [pathC'',pathB'',pathA''] == allPathes + _ -> False ) , ( "reloading-package", testRoot </> "changing-cabal" , [ AddPackages [ testRoot </> "changing-cabal" ++ testSuffix ]] - , appendFile (testRoot </> "changing-cabal" ++ testSuffix </> "some-test-package.cabal") ", B" + , appendFile (testRoot </> "changing-cabal" ++ testSuffix </> "some-test-package.cabal") ", B" , [ AddPackages [testRoot </> "changing-cabal" ++ testSuffix] - , PerformRefactoring "RenameDefinition" (testRoot </> "changing-cabal" ++ testSuffix </> "A.hs") "3:1-3:2" ["z"] - ] - , [ LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" ] - , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" - , testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ] - , ModulesChanged [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" - , testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ] - , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "A.hs" ] - , LoadedModules [ testRoot </> "changing-cabal" ++ testSuffix </> "B.hs" ] + , PerformRefactoring "RenameDefinition" (testRoot </> "changing-cabal" ++ testSuffix </> "A.hs") "3:1-3:2" ["z"] ] - ) + , \case [ LoadingModules{}, LoadedModules [(pathA,_)], LoadingModules{}, LoadedModules [(pathA',_)] + , LoadedModules [(pathB',_)], ModulesChanged _ + , LoadingModules{}, LoadedModules [(pathA'',_)], LoadedModules [(pathB'',_)] + ] -> let [pA,pB] = map ((testRoot </> "changing-cabal" ++ testSuffix) </>) ["A.hs","B.hs"] + in pA == pathA && pA == pathA' && pA == pathA'' && pB == pathB' && pB == pathB'' + _ -> False ) + , ( "adding-module", testRoot </> "reloading", [AddPackages [ testRoot </> "reloading" ++ testSuffix ]] + , writeFile (testRoot </> "reloading" ++ testSuffix </> "D.hs") "module D where\nd = ()" + , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "D.hs"] [] [] ] + , \case [ LoadingModules {}, LoadedModules {}, LoadedModules {}, LoadedModules {}, LoadingModules {} + , LoadingModules {}, LoadedModules {}, LoadedModules {}, LoadedModules {}, LoadedModules {}] -> True + _ -> False ) , ( "reloading-remove", testRoot </> "reloading", [ AddPackages [ testRoot </> "reloading" ++ testSuffix ]] , do removeFile (testRoot </> "reloading" ++ testSuffix </> "A.hs") removeFile (testRoot </> "reloading" ++ testSuffix </> "B.hs") - , [ ReLoad [testRoot </> "reloading" ++ testSuffix </> "C.hs"] - [testRoot </> "reloading" ++ testSuffix </> "A.hs", testRoot </> "reloading" ++ testSuffix </> "B.hs"] - , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "3:1-3:2" ["d"] - ] - , [ LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" - , testRoot </> "reloading" ++ testSuffix </> "B.hs" - , testRoot </> "reloading" ++ testSuffix </> "A.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ] - , ModulesChanged [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ] - , LoadedModules [ testRoot </> "reloading" ++ testSuffix </> "C.hs" ] - ] - ) + , [ ReLoad [] [testRoot </> "reloading" ++ testSuffix </> "C.hs"] + [testRoot </> "reloading" ++ testSuffix </> "A.hs", testRoot </> "reloading" ++ testSuffix </> "B.hs"] + , PerformRefactoring "RenameDefinition" (testRoot </> "reloading" ++ testSuffix </> "C.hs") "3:1-3:2" ["d"] + ] + , \case [ LoadingModules{}, LoadedModules [(pathC,_)], LoadedModules [(pathB,_)], LoadedModules [(pathA,_)] + , LoadingModules{}, LoadedModules [(pathC',_)], ModulesChanged _, LoadingModules{}, LoadedModules [(pathC'',_)] ] + -> let [pC,pB,pA] = map ((testRoot </> "reloading" ++ testSuffix) </>) ["C.hs","B.hs","A.hs"] + in pA == pathA && pB == pathB && pC == pathC && pC == pathC' && pC == pathC'' + _ -> False ) , ( "remove-package", testRoot </> "multi-packages-dependent" , [ AddPackages [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" , testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2" ]] , removeDirectoryRecursive (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2") - , [ RemovePackages [testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2"] - , PerformRefactoring "RenameDefinition" (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs") - "3:1-3:2" ["d"] - ] - , [ LoadedModules [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" - , testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2" </> "B.hs" ] - , ModulesChanged [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" ] - , LoadedModules [ testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs" ] - ] - ) + , [ RemovePackages [testRoot </> "multi-packages-dependent" ++ testSuffix </> "package2"] + , PerformRefactoring "RenameDefinition" (testRoot </> "multi-packages-dependent" ++ testSuffix </> "package1" </> "A.hs") + "3:1-3:2" ["d"] + ] + , \case [ LoadingModules{}, LoadedModules [(pathA',_)], LoadedModules [(pathB',_)], ModulesChanged _, LoadingModules{}, LoadedModules [(pathA,_)] ] + -> let [pA,pB] = map ((testRoot </> "multi-packages-dependent" ++ testSuffix) </>) [ "package1" </> "A.hs", "package2" </> "B.hs"] + in pA == pathA && pA == pathA' && pB == pathB' + _ -> False ) ] pkgDbTests :: [(String, IO (), [ClientMessage], [ResponseMsg])] -pkgDbTests - = [ {- ( "stack" - , withCurrentDirectory (testRoot </> "stack") initStack - , [SetPackageDB StackDB, AddPackages [testRoot </> "stack"]] - , [LoadedModules [testRoot </> "stack" </> "UseGroups.hs"]] ) - , -} ( "cabal-sandbox" +pkgDbTests + = [ ( "cabal-sandbox" , withCurrentDirectory (testRoot </> "cabal-sandbox") initCabalSandbox , [SetPackageDB CabalSandboxDB, AddPackages [testRoot </> "cabal-sandbox"]] - , [LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]] ) + , [ LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] + , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")]] ) , ( "cabal-sandbox-auto" , withCurrentDirectory (testRoot </> "cabal-sandbox") initCabalSandbox , [SetPackageDB AutoDB, AddPackages [testRoot </> "cabal-sandbox"]] - , [LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"]] ) - -- , ( "stack-auto" - -- , withCurrentDirectory (testRoot </> "stack") initStack - -- , [SetPackageDB AutoDB, AddPackages [testRoot </> "stack"]] - -- , [LoadedModules [testRoot </> "stack" </> "UseGroups.hs"]] ) + , [ LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] + , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")]] ) , ( "pkg-db-reload" , withCurrentDirectory (testRoot </> "cabal-sandbox") initCabalSandbox , [ SetPackageDB AutoDB , AddPackages [testRoot </> "cabal-sandbox"] - , ReLoad [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] []] - , [ LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] - , LoadedModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] ]) - ] + , ReLoad [] [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] []] + , [ LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] + , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")] + , LoadingModules [testRoot </> "cabal-sandbox" </> "UseGroups.hs"] + , LoadedModules [(testRoot </> "cabal-sandbox" </> "UseGroups.hs", "UseGroups")] ]) + ] where initCabalSandbox = do sandboxExists <- doesDirectoryExist ".cabal-sandbox" when sandboxExists $ tryToExecute "cabal" ["sandbox", "delete"] @@ -277,48 +287,50 @@ execute :: String -> [String] -> IO () -execute cmd args +execute cmd args = do let command = (cmd ++ concat (map (" " ++) args)) (_, Just stdOut, Just stdErr, handle) <- createProcess ((shell command) { std_out = CreatePipe, std_err = CreatePipe }) exitCode <- waitForProcess handle - when (exitCode /= ExitSuccess) $ do + when (exitCode /= ExitSuccess) $ do output <- hGetContents stdOut errors <- hGetContents stdErr error ("Command exited with nonzero: " ++ command ++ " output:\n" ++ output ++ "\nerrors:\n" ++ errors) tryToExecute :: String -> [String] -> IO () -tryToExecute cmd args +tryToExecute cmd args = do let command = (cmd ++ concat (map (" " ++) args)) (_, _, _, handle) <- createProcess ((shell command) { std_out = NoStream, std_err = NoStream }) void $ waitForProcess handle -makeDaemonTest :: MVar Int -> (Maybe FilePath, String, [ClientMessage], [ResponseMsg]) -> TestTree -makeDaemonTest port (Nothing, label, input, expected) = testCase label $ do +makeDaemonTest :: MVar Int -> (String, [ClientMessage], [ResponseMsg]) -> TestTree +makeDaemonTest port (label, input, expected) = testCase label $ do actual <- communicateWithDaemon port (map Right (SetPackageDB DefaultDB : input)) assertEqual "" expected actual -makeDaemonTest port (Just dir, label, input, expected) = testCase label $ do + +makeRefactorTest :: MVar Int -> (String, FilePath, [ClientMessage], [ResponseMsg] -> Bool) -> TestTree +makeRefactorTest port (label, dir, input, validator) = testCase label $ do exists <- doesDirectoryExist (dir ++ testSuffix) -- clear the target directory from possible earlier test runs when exists $ removeDirectoryRecursive (dir ++ testSuffix) copyDir dir (dir ++ testSuffix) actual <- communicateWithDaemon port (map Right (SetPackageDB DefaultDB : input)) - assertEqual "" expected actual + assertBool ("The responses are not the expected: " ++ show actual) (validator actual) `finally` removeDirectoryRecursive (dir ++ testSuffix) -makeReloadTest :: MVar Int -> (String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg]) -> TestTree -makeReloadTest port (label, dir, input1, io, input2, expected) = testCase label $ do +makeReloadTest :: MVar Int -> (String, FilePath, [ClientMessage], IO (), [ClientMessage], [ResponseMsg] -> Bool) -> TestTree +makeReloadTest port (label, dir, input1, io, input2, validator) = testCase label $ do exists <- doesDirectoryExist (dir ++ testSuffix) -- clear the target directory from possible earlier test runs when exists $ removeDirectoryRecursive (dir ++ testSuffix) copyDir dir (dir ++ testSuffix) actual <- communicateWithDaemon port (map Right (SetPackageDB DefaultDB : input1) ++ [Left io] ++ map Right input2) - assertEqual "" expected actual + assertBool ("The responses are not the expected: " ++ show actual) (validator actual) `finally` removeDirectoryRecursive (dir ++ testSuffix) makePkgDbTest :: MVar Int -> (String, IO (), [ClientMessage], [ResponseMsg]) -> TestTree -makePkgDbTest port (label, prepare, inputs, expected) - = localOption (mkTimeout ({- 30s -} 1000 * 1000 * 30)) - $ testCase label $ do +makePkgDbTest port (label, prepare, inputs, expected) + = localOption (mkTimeout ({- 30s -} 1000 * 1000 * 30)) + $ testCase label $ do actual <- communicateWithDaemon port ([Left prepare] ++ map Right inputs) assertEqual "" expected actual @@ -344,14 +356,14 @@ sendAll sock $ encode Stop close sock return (concat intermedRes ++ resps) - where waitToConnect sock addr + where waitToConnect sock addr = connect sock addr `catch` \(e :: SomeException) -> waitToConnect sock addr - retryConnect port = do portNum <- readMVar port + retryConnect port = do portNum <- readMVar port forkIO $ runDaemon [show portNum, "True"] return portNum `catch` \(e :: SomeException) -> do putStrLn ("exception caught: `" ++ show e ++ "` trying with a new port") - modifyMVar_ port (\i -> if i < pORT_NUM_END - then return (i+1) + modifyMVar_ port (\i -> if i < pORT_NUM_END + then return (i+1) else error "The port number reached the maximum") retryConnect port @@ -360,18 +372,20 @@ readSockResponsesUntil sock rsp bs = do resp <- recv sock 2048 let fullBS = bs `BS.append` resp - if BS.null resp + if BS.null resp then return [] else let splitted = BS.split '\n' fullBS recognized = catMaybes $ map decode splitted - in if rsp `elem` recognized - then return $ List.delete rsp recognized + in if rsp `elem` recognized + then return $ List.delete rsp recognized else readSockResponsesUntil sock rsp fullBS testRoot = "examples" </> "Project" +deriving instance Eq UndoRefactor deriving instance Eq ResponseMsg +instance FromJSON UndoRefactor instance FromJSON ResponseMsg instance ToJSON ClientMessage instance ToJSON PackageDB @@ -400,15 +414,15 @@ longestCommonPrefix = foldl1 commonPrefix instance FromJSON SrcSpan where - parseJSON (Object v) = mkSrcSpanReal <$> v .: "file" - <*> v .: "startRow" - <*> v .: "startCol" + parseJSON (Object v) = mkSrcSpanReal <$> v .: "file" + <*> v .: "startRow" + <*> v .: "startCol" <*> v .: "endRow" <*> v .: "endCol" parseJSON _ = fail "not an object" mkSrcSpanReal :: String -> Int -> Int -> Int -> Int -> SrcSpan -mkSrcSpanReal file startRow startCol endRow endCol +mkSrcSpanReal file startRow startCol endRow endCol = mkSrcSpan (mkSrcLoc (mkFastString file) startRow startCol) (mkSrcLoc (mkFastString file) endRow endCol)

1 0

commit ghc-haskell-tools-cli for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

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(a)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(a)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(a)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(a)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(a)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(a)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(a)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(a)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(a)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

1 0

commit ghc-haskell-tools-backend-ghc for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-haskell-tools-backend-ghc for openSUSE:Factory checked in at 2017-08-31 20:55:53 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-haskell-tools-backend-ghc (Old) and /work/SRC/openSUSE:Factory/.ghc-haskell-tools-backend-ghc.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-haskell-tools-backend-ghc" Thu Aug 31 20:55:53 2017 rev:2 rq:513369 version:0.8.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-haskell-tools-backend-ghc/ghc-haskell-tools-backend-ghc.changes 2017-04-12 18:06:43.234518829 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-haskell-tools-backend-ghc.new/ghc-haskell-tools-backend-ghc.changes 2017-08-31 20:55:53.984169140 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:04:32 UTC 2017 - psimons(a)suse.com + +- Update to version 0.8.0.0. + +------------------------------------------------------------------- Old: ---- haskell-tools-backend-ghc-0.5.0.0.tar.gz New: ---- haskell-tools-backend-ghc-0.8.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-haskell-tools-backend-ghc.spec ++++++ --- /var/tmp/diff_new_pack.wXIuK8/_old 2017-08-31 20:55:55.000026408 +0200 +++ /var/tmp/diff_new_pack.wXIuK8/_new 2017-08-31 20:55:55.008025284 +0200 @@ -18,7 +18,7 @@ %global pkg_name haskell-tools-backend-ghc Name: ghc-%{pkg_name} -Version: 0.5.0.0 +Version: 0.8.0.0 Release: 0 Summary: Creating the Haskell-Tools AST from GHC's representations License: BSD-3-Clause @@ -28,6 +28,7 @@ BuildRequires: ghc-Cabal-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-containers-devel +BuildRequires: ghc-ghc-boot-th-devel BuildRequires: ghc-ghc-devel BuildRequires: ghc-haskell-tools-ast-devel BuildRequires: ghc-mtl-devel ++++++ haskell-tools-backend-ghc-0.5.0.0.tar.gz -> haskell-tools-backend-ghc-0.8.0.0.tar.gz ++++++ ++++ 3040 lines of diff (skipped)

1 0

commit ghc-haskell-tools-ast for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-haskell-tools-ast for openSUSE:Factory checked in at 2017-08-31 20:55:51 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-haskell-tools-ast (Old) and /work/SRC/openSUSE:Factory/.ghc-haskell-tools-ast.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-haskell-tools-ast" Thu Aug 31 20:55:51 2017 rev:2 rq:513368 version:0.8.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-haskell-tools-ast/ghc-haskell-tools-ast.changes 2017-04-12 18:06:42.482625143 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-haskell-tools-ast.new/ghc-haskell-tools-ast.changes 2017-08-31 20:55:52.724346149 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:03:15 UTC 2017 - psimons(a)suse.com + +- Update to version 0.8.0.0. + +------------------------------------------------------------------- Old: ---- haskell-tools-ast-0.5.0.0.tar.gz New: ---- haskell-tools-ast-0.8.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-haskell-tools-ast.spec ++++++ --- /var/tmp/diff_new_pack.QbZwND/_old 2017-08-31 20:55:53.640217466 +0200 +++ /var/tmp/diff_new_pack.QbZwND/_new 2017-08-31 20:55:53.644216904 +0200 @@ -18,7 +18,7 @@ %global pkg_name haskell-tools-ast Name: ghc-%{pkg_name} -Version: 0.5.0.0 +Version: 0.8.0.0 Release: 0 Summary: Haskell AST for efficient tooling License: BSD-3-Clause ++++++ haskell-tools-ast-0.5.0.0.tar.gz -> haskell-tools-ast-0.8.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Ann.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Ann.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Ann.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Ann.hs 2017-05-03 22:13:55.000000000 +0200 @@ -166,7 +166,7 @@ , HasRange (SpanInfo stage) , HasRange (ListInfo stage) , HasRange (OptionalInfo stage) - ) + ) => SourceInfo stage where -- | UType of source info for normal AST elements data SpanInfo stage :: * @@ -182,13 +182,13 @@ data ListInfo RangeStage = ListPos { _listBefore :: String , _listAfter :: String , _listDefaultSep :: String - , _listIndented :: Bool - , _listPos :: SrcLoc + , _listIndented :: Maybe [Bool] + , _listPos :: SrcLoc } deriving (Data) data OptionalInfo RangeStage = OptionalPos { _optionalBefore :: String - , _optionalAfter :: String - , _optionalPos :: SrcLoc + , _optionalAfter :: String + , _optionalPos :: SrcLoc } deriving (Data) @@ -207,13 +207,13 @@ data ListInfo NormRangeStage = NormListInfo { _normListBefore :: String , _normListAfter :: String , _normListDefaultSep :: String - , _normListIndented :: Bool - , _normListSpan :: SrcSpan + , _normListIndented :: Maybe [Bool] + , _normListSpan :: SrcSpan } deriving (Data) data OptionalInfo NormRangeStage = NormOptInfo { _normOptBefore :: String - , _normOptAfter :: String - , _normOptSpan :: SrcSpan + , _normOptAfter :: String + , _normOptSpan :: SrcSpan } deriving (Data) @@ -228,8 +228,8 @@ -- | A short form of showing a range, without file name, for debugging purposes. shortShowSpan :: SrcSpan -> String -shortShowSpan (UnhelpfulSpan _) = "??-??" -shortShowSpan sp@(RealSrcSpan _) +shortShowSpan (UnhelpfulSpan _) = "??-??" +shortShowSpan sp@(RealSrcSpan _) = shortShowLoc (srcSpanStart sp) ++ "-" ++ shortShowLoc (srcSpanEnd sp) -- | A short form of showing a range, without file name, for debugging purposes. @@ -239,7 +239,7 @@ -- | A class for marking a source information stage. All programs, regardless of -- correct Haskell programs or not, must go through these stages to be refactored. -class SourceInfo stage +class SourceInfo stage => RangeInfo stage where nodeSpan :: Simple Lens (SpanInfo stage) GHC.SrcSpan listPos :: Simple Lens (ListInfo stage) GHC.SrcLoc @@ -253,40 +253,40 @@ -- * Annotations -- | Semantic and source code related information for an AST node. -data NodeInfo sema src +data NodeInfo sema src = NodeInfo { _semanticInfo :: sema , _sourceInfo :: src } deriving (Eq, Show, Data) - + makeReferences ''NodeInfo -- | An element of the AST keeping extra information. data Ann elem dom stage -- The type parameters are organized this way because we want the annotation type to --- be more flexible, but the annotation is the first parameter because it eases +-- be more flexible, but the annotation is the first parameter because it eases -- pattern matching. = Ann { _annotation :: NodeInfo (SemanticInfo dom elem) (SpanInfo stage) -- ^ The extra information for the AST part , _element :: elem dom stage -- ^ The original AST part } - + makeReferences ''Ann -- | A list of AST elements -data AnnListG elem dom stage = AnnListG { _annListAnnot :: NodeInfo (SemanticInfo dom (AnnListG elem)) (ListInfo stage) +data AnnListG elem dom stage = AnnListG { _annListAnnot :: NodeInfo (SemanticInfo dom (AnnListG elem)) (ListInfo stage) , _annListElems :: [Ann elem dom stage] } makeReferences ''AnnListG - -annList :: Traversal (AnnListG e d s) (AnnListG e d s) (Ann e d s) (Ann e d s) + +annList :: Traversal (AnnListG e d s) (AnnListG e d s) (Ann e d s) (Ann e d s) annList = annListElems & traversal -- | An optional AST element data AnnMaybeG elem dom stage = AnnMaybeG { _annMaybeAnnot :: NodeInfo (SemanticInfo dom (AnnMaybeG elem)) (OptionalInfo stage) , _annMaybe :: Maybe (Ann elem dom stage) } - + makeReferences ''AnnMaybeG class HasSourceInfo e where @@ -304,8 +304,8 @@ instance HasSourceInfo (AnnMaybeG elem dom stage) where type SourceInfoType (AnnMaybeG elem dom stage) = OptionalInfo stage srcInfo = annMaybeAnnot & sourceInfo - -annJust :: Partial (AnnMaybeG e d s) (AnnMaybeG e d s) (Ann e d s) (Ann e d s) + +annJust :: Partial (AnnMaybeG e d s) (AnnMaybeG e d s) (Ann e d s) (Ann e d s) annJust = annMaybe & just -- | An empty list of AST elements @@ -366,7 +366,7 @@ setRange sp = annMaybeAnnot & sourceInfo .- setRange sp -- | A class for changing semantic information throught the AST. -class ApplySemaChange cls where +class ApplySemaChange cls where appSemaChange :: SemaTrf f dom1 dom2 -> SemanticInfo' dom1 cls -> f (SemanticInfo' dom2 cls) instance ApplySemaChange SameInfoNameCls where appSemaChange = trfSemaNameCls @@ -377,7 +377,7 @@ instance ApplySemaChange SameInfoDefaultCls where appSemaChange = trfSemaDefault -- | A class for traversing semantic information in an AST -class ApplySemaChange (SemaInfoClassify a) +class ApplySemaChange (SemaInfoClassify a) => SemanticTraversal a where semaTraverse :: Monad f => SemaTrf f dom1 dom2 -> a dom1 st -> f (a dom2 st) @@ -412,26 +412,25 @@ } instance SourceInfoTraversal e => SourceInfoTraversal (Ann e) where - sourceInfoTraverse trf (Ann (NodeInfo sema src) e) + sourceInfoTraverse trf (Ann (NodeInfo sema src) e) = Ann <$> (NodeInfo sema <$> trfSpanInfo trf src) <*> sourceInfoTraverse trf e - sourceInfoTraverseDown trf desc asc (Ann (NodeInfo sema src) e) + sourceInfoTraverseDown trf desc asc (Ann (NodeInfo sema src) e) = Ann <$> (NodeInfo sema <$> trfSpanInfo trf src) <*> (desc *> sourceInfoTraverseDown trf desc asc e <* asc) - sourceInfoTraverseUp trf desc asc (Ann (NodeInfo sema src) e) + sourceInfoTraverseUp trf desc asc (Ann (NodeInfo sema src) e) = flip Ann <$> (desc *> sourceInfoTraverseUp trf desc asc e <* asc) <*> (NodeInfo sema <$> trfSpanInfo trf src) instance SourceInfoTraversal e => SourceInfoTraversal (AnnListG e) where - sourceInfoTraverse trf (AnnListG (NodeInfo sema src) e) + sourceInfoTraverse trf (AnnListG (NodeInfo sema src) e) = AnnListG <$> (NodeInfo sema <$> trfListInfo trf src) <*> mapM (sourceInfoTraverse trf) e - sourceInfoTraverseDown trf desc asc (AnnListG (NodeInfo sema src) e) + sourceInfoTraverseDown trf desc asc (AnnListG (NodeInfo sema src) e) = AnnListG <$> (NodeInfo sema <$> trfListInfo trf src) <*> (desc *> mapM (sourceInfoTraverseDown trf desc asc) e <* asc) - sourceInfoTraverseUp trf desc asc (AnnListG (NodeInfo sema src) e) + sourceInfoTraverseUp trf desc asc (AnnListG (NodeInfo sema src) e) = flip AnnListG <$> (desc *> mapM (sourceInfoTraverseUp trf desc asc) e <* asc) <*> (NodeInfo sema <$> trfListInfo trf src) instance SourceInfoTraversal e => SourceInfoTraversal (AnnMaybeG e) where - sourceInfoTraverse trf (AnnMaybeG (NodeInfo sema src) e) + sourceInfoTraverse trf (AnnMaybeG (NodeInfo sema src) e) = AnnMaybeG <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> sequence (fmap (sourceInfoTraverse trf) e) - sourceInfoTraverseDown trf desc asc (AnnMaybeG (NodeInfo sema src) e) + sourceInfoTraverseDown trf desc asc (AnnMaybeG (NodeInfo sema src) e) = AnnMaybeG <$> (NodeInfo sema <$> trfOptionalInfo trf src) <*> (desc *> sequence (fmap (sourceInfoTraverseDown trf desc asc) e) <* asc) - sourceInfoTraverseUp trf desc asc (AnnMaybeG (NodeInfo sema src) e) + sourceInfoTraverseUp trf desc asc (AnnMaybeG (NodeInfo sema src) e) = flip AnnMaybeG <$> (desc *> sequence (fmap (sourceInfoTraverseUp trf desc asc) e) <* asc) <*> (NodeInfo sema <$> trfOptionalInfo trf src) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Helpers.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Helpers.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Helpers.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Helpers.hs 2017-05-22 15:12:54.000000000 +0200 @@ -1,6 +1,6 @@ -{-# LANGUAGE FlexibleContexts - , LambdaCase - , RankNTypes +{-# LANGUAGE FlexibleContexts + , LambdaCase + , RankNTypes , ScopedTypeVariables , TypeFamilies , FlexibleInstances @@ -29,14 +29,18 @@ import Language.Haskell.Tools.AST.Representation.Patterns (UPattern) import Language.Haskell.Tools.AST.Representation.Types (UType(..)) import Language.Haskell.Tools.AST.SemaInfoTypes (Scope) - + -- | Does the import declaration import only the explicitly listed elements? importIsExact :: Ann UImportDecl dom stage -> Bool -importIsExact = isJust . (^? importSpec&annJust&importSpecList) +importIsExact = isJust . (^? importSpec&annJust&importSpecList) + +-- | Does the import declaration import all elements that are not excluded explicitly? +importIsHiding :: Ann UImportDecl dom stage -> Bool +importIsHiding = isJust . (^? importSpec&annJust&importSpecHiding) -- | Accesses the name of a function or value binding bindingName :: Simple Traversal (Ann UValueBind dom stage) (Ann UQualifiedName dom stage) -bindingName = (valBindPat&patternName&simpleName +bindingName = (valBindPat&patternName&simpleName &+& funBindMatches&annList&matchLhs &(matchLhsName&simpleName &+& matchLhsOperator&operatorName)) @@ -62,9 +66,9 @@ semantics = annotation&semanticInfo -- | Get all nodes that contain a given source range -nodesContaining :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) +nodesContaining :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) => RealSrcSpan -> Simple Traversal (node dom stage) (inner dom stage) -nodesContaining rng = biplateRef & filtered (isInside rng) +nodesContaining rng = biplateRef & filtered (isInside rng) -- | Return true if the node contains a given range isInside :: HasRange (inner dom stage) => RealSrcSpan -> inner dom stage -> Bool @@ -72,26 +76,26 @@ _ -> False -- | Get all nodes that are contained in a given source range -nodesContained :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) +nodesContained :: (HasRange (inner dom stage), Biplate (node dom stage) (inner dom stage)) => RealSrcSpan -> Simple Traversal (node dom stage) (inner dom stage) -nodesContained rng = biplateRef & filtered (isContained rng) +nodesContained rng = biplateRef & filtered (isContained rng) -- | Return true if the node contains a given range isContained :: HasRange (inner dom stage) => RealSrcSpan -> inner dom stage -> Bool isContained rng nd = case getRange nd of RealSrcSpan sp -> rng `containsSpan` sp _ -> False --- | Get the nodes that have exactly the given range -nodesWithRange :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage) +-- | Get the nodes that have exactly the given range +nodesWithRange :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage) => RealSrcSpan -> Simple Traversal (Ann node dom stage) (Ann inner dom stage) -nodesWithRange rng = biplateRef & filtered (hasRange rng) - where -- True, if the node has the given range +nodesWithRange rng = biplateRef & filtered (hasRange rng) + where -- True, if the node has the given range hasRange :: SourceInfo stage => RealSrcSpan -> Ann inner dom stage -> Bool hasRange rng node = case getRange node of RealSrcSpan sp -> sp == rng _ -> False --- | Get the shortest source range that contains the given -getNodeContaining :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage, HasRange (Ann inner dom stage)) +-- | Get the shortest source range that contains the given +getNodeContaining :: (Biplate (Ann node dom stage) (Ann inner dom stage), SourceInfo stage, HasRange (Ann inner dom stage)) => RealSrcSpan -> Ann node dom stage -> Maybe (Ann inner dom stage) getNodeContaining sp node = case node ^? nodesContaining sp of [] -> Nothing @@ -110,22 +114,22 @@ elementName :: Simple Traversal (Ann elem dom st) (Ann UQualifiedName dom st) instance NamedElement UDecl where - elementName = (declHead & declHeadNames) + elementName = (declHead & declHeadNames) &+& (declTypeFamily & tfHead & declHeadNames) &+& (declValBind & bindingName) &+& (declName & simpleName) &+& (declPatSyn & patLhs & (patName & simpleName &+& patSynOp & operatorName)) instance NamedElement ULocalBind where - elementName = localVal&bindingName - &+& localSig&tsName&annList&simpleName + elementName = localVal&bindingName + &+& localSig&tsName&annList&simpleName &+& localFixity&fixityOperators&annList&operatorName inScope :: GHC.Name -> Scope -> Bool -inScope n sc = any (n `elem`) sc +inScope n sc = any ((n `elem`) . map fst) sc -- * Pattern synonyms for annotated lists and maybes - + pattern AnnList :: [Ann elem dom stage] -> AnnListG elem dom stage pattern AnnList elems <- AnnListG _ elems @@ -133,4 +137,4 @@ pattern AnnNothing <- AnnMaybeG _ Nothing pattern AnnJust :: Ann elem dom stage -> AnnMaybeG elem dom stage -pattern AnnJust elem <- AnnMaybeG _ (Just elem) \ No newline at end of file +pattern AnnJust elem <- AnnMaybeG _ (Just elem) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Data.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Data.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Data.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Data.hs 2017-05-17 10:56:30.000000000 +0200 @@ -80,6 +80,7 @@ deriving instance (Domain dom, SourceInfo stage) => Data (UBracket dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UTopLevelPragma dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (URule dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (URuleVar dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UAnnotationSubject dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UMinimalFormula dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UExprPragma dom stage) @@ -108,6 +109,7 @@ deriving instance (Domain dom, SourceInfo stage) => Data (ULanguageExtension dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UMatchLhs dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UInlinePragma dom stage) +deriving instance (Domain dom, SourceInfo stage) => Data (USpecializePragma dom stage) -- ULiteral deriving instance (Domain dom, SourceInfo stage) => Data (ULiteral dom stage) @@ -133,4 +135,4 @@ deriving instance (Domain dom, SourceInfo stage) => Data (LineNumber dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (UPhaseControl dom stage) deriving instance (Domain dom, SourceInfo stage) => Data (PhaseNumber dom stage) -deriving instance (Domain dom, SourceInfo stage) => Data (PhaseInvert dom stage) \ No newline at end of file +deriving instance (Domain dom, SourceInfo stage) => Data (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Eq.hs 2017-05-17 10:56:30.000000000 +0200 @@ -83,6 +83,7 @@ deriving instance Eq (UBracket dom stage) deriving instance Eq (UTopLevelPragma dom stage) deriving instance Eq (URule dom stage) +deriving instance Eq (URuleVar dom stage) deriving instance Eq (UAnnotationSubject dom stage) deriving instance Eq (UMinimalFormula dom stage) deriving instance Eq (UExprPragma dom stage) @@ -111,6 +112,7 @@ deriving instance Eq (ULanguageExtension dom stage) deriving instance Eq (UMatchLhs dom stage) deriving instance Eq (UInlinePragma dom stage) +deriving instance Eq (USpecializePragma dom stage) -- ULiteral deriving instance Eq (ULiteral dom stage) @@ -136,4 +138,4 @@ deriving instance Eq (LineNumber dom stage) deriving instance Eq (UPhaseControl dom stage) deriving instance Eq (PhaseNumber dom stage) -deriving instance Eq (PhaseInvert dom stage) \ No newline at end of file +deriving instance Eq (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Generic.hs 2017-05-17 10:56:30.000000000 +0200 @@ -80,6 +80,7 @@ deriving instance Domain dom => Generic (UBracket dom stage) deriving instance Domain dom => Generic (UTopLevelPragma dom stage) deriving instance Domain dom => Generic (URule dom stage) +deriving instance Domain dom => Generic (URuleVar dom stage) deriving instance Domain dom => Generic (UAnnotationSubject dom stage) deriving instance Domain dom => Generic (UMinimalFormula dom stage) deriving instance Domain dom => Generic (UExprPragma dom stage) @@ -108,6 +109,7 @@ deriving instance Domain dom => Generic (ULanguageExtension dom stage) deriving instance Domain dom => Generic (UMatchLhs dom stage) deriving instance Domain dom => Generic (UInlinePragma dom stage) +deriving instance Domain dom => Generic (USpecializePragma dom stage) -- Literal @@ -134,4 +136,4 @@ deriving instance Domain dom => Generic (LineNumber dom stage) deriving instance Domain dom => Generic (UPhaseControl dom stage) deriving instance Domain dom => Generic (PhaseNumber dom stage) -deriving instance Domain dom => Generic (PhaseInvert dom stage) \ No newline at end of file +deriving instance Domain dom => Generic (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SemanticTraversal.hs 2017-05-17 10:56:30.000000000 +0200 @@ -76,6 +76,7 @@ deriveSemanticTraversal ''UBracket deriveSemanticTraversal ''UTopLevelPragma deriveSemanticTraversal ''URule +deriveSemanticTraversal ''URuleVar deriveSemanticTraversal ''UAnnotationSubject deriveSemanticTraversal ''UMinimalFormula deriveSemanticTraversal ''UExprPragma @@ -106,6 +107,7 @@ deriveSemanticTraversal ''UCaseRhs' deriveSemanticTraversal ''UGuardedCaseRhs' deriveSemanticTraversal ''UInlinePragma +deriveSemanticTraversal ''USpecializePragma -- ULiteral deriveSemanticTraversal ''ULiteral diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Show.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Show.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/Show.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/Show.hs 2017-05-17 10:56:30.000000000 +0200 @@ -21,7 +21,7 @@ instance (Show (e dom stage)) => Show (AnnMaybeG e dom stage) where show (AnnMaybeG _ e) = show e - + instance (Show (e dom stage)) => Show (AnnListG e dom stage) where show (AnnListG _ e) = show e @@ -83,6 +83,7 @@ deriving instance Show (UBracket dom stage) deriving instance Show (UTopLevelPragma dom stage) deriving instance Show (URule dom stage) +deriving instance Show (URuleVar dom stage) deriving instance Show (UAnnotationSubject dom stage) deriving instance Show (UMinimalFormula dom stage) deriving instance Show (UExprPragma dom stage) @@ -111,6 +112,7 @@ deriving instance Show (ULanguageExtension dom stage) deriving instance Show (UMatchLhs dom stage) deriving instance Show (UInlinePragma dom stage) +deriving instance Show (USpecializePragma dom stage) -- ULiteral @@ -137,4 +139,4 @@ deriving instance Show (LineNumber dom stage) deriving instance Show (UPhaseControl dom stage) deriving instance Show (PhaseNumber dom stage) -deriving instance Show (PhaseInvert dom stage) \ No newline at end of file +deriving instance Show (PhaseInvert dom stage) diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Instances/SourceInfoTraversal.hs 2017-05-17 10:56:30.000000000 +0200 @@ -76,6 +76,7 @@ deriveSourceInfoTraversal ''UBracket deriveSourceInfoTraversal ''UTopLevelPragma deriveSourceInfoTraversal ''URule +deriveSourceInfoTraversal ''URuleVar deriveSourceInfoTraversal ''UAnnotationSubject deriveSourceInfoTraversal ''UMinimalFormula deriveSourceInfoTraversal ''UExprPragma @@ -106,6 +107,7 @@ deriveSourceInfoTraversal ''UCaseRhs' deriveSourceInfoTraversal ''UGuardedCaseRhs' deriveSourceInfoTraversal ''UInlinePragma +deriveSourceInfoTraversal ''USpecializePragma -- ULiteral deriveSourceInfoTraversal ''ULiteral diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/References.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/References.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/References.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/References.hs 2017-05-03 22:13:55.000000000 +0200 @@ -66,6 +66,7 @@ $(toASTReferences (makeReferences ''UInstanceHead)) $(toASTReferences (makeReferences ''UTypeEqn)) $(toASTReferences (makeReferences ''URule)) +$(toASTReferences (makeReferences ''URuleVar)) $(toASTReferences (makeReferences ''UOverlapPragma)) $(toASTReferences (makeReferences ''UCallConv)) $(toASTReferences (makeReferences ''USafety)) @@ -139,4 +140,3 @@ $(toASTReferences (makeReferences ''UQualifiedName)) $(toASTReferences (makeReferences ''UNamePart)) $(toASTReferences (makeReferences ''UStringNode)) - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Binds.hs 2017-05-03 22:13:55.000000000 +0200 @@ -12,17 +12,17 @@ = USimpleBind { _valBindPat :: Ann UPattern dom stage , _valBindRhs :: Ann URhs dom stage , _valBindLocals :: AnnMaybeG ULocalBinds dom stage - } -- ^ Non-function binding (@ v = "12" @) + } -- ^ Non-function binding (@ v = "12" @) -- TODO: use one name for a function instead of names in each match | UFunBind { _funBindMatches :: AnnListG UMatch dom stage } -- ^ Function binding (@ f 0 = 1; f x = x @). All matches must have the same name. --- | Clause of function binding +-- | Clause of function binding data UMatch dom stage = UMatch { _matchLhs :: Ann UMatchLhs dom stage , _matchRhs :: Ann URhs dom stage , _matchBinds :: AnnMaybeG ULocalBinds dom stage - } + } -- | Something on the left side of the match data UMatchLhs dom stage @@ -34,12 +34,12 @@ , _matchLhsRhs :: Ann UPattern dom stage , _matchLhsArgs :: AnnListG UPattern dom stage } -- ^ An infix match lhs for an operator (@ a + b @) - --- | Local bindings attached to a declaration (@ where x = 42 @) + +-- | Local bindings attached to a declaration (@ where x = 42 @) data ULocalBinds dom stage = ULocalBinds { _localBinds :: AnnListG ULocalBind dom stage } - + -- | Bindings that are enabled in local blocks (where or let). data ULocalBind dom stage -- TODO: check that no other signature can be inside a local binding @@ -51,13 +51,13 @@ } -- ^ A local fixity declaration | ULocalInline { _localInline :: Ann UInlinePragma dom stage } -- ^ A local inline pragma - + -- | A type signature (@ f :: Int -> Int @) data UTypeSignature dom stage = UTypeSignature { _tsName :: AnnListG UName dom stage , _tsType :: Ann UType dom stage - } - + } + -- * Fixities -- | A fixity signature (@ infixl 5 +, - @). @@ -72,10 +72,10 @@ = AssocNone -- ^ non-associative operator (declared with @infix@) | AssocLeft -- ^ left-associative operator (declared with @infixl@) | AssocRight -- ^ right-associative operator (declared with @infixr@) - + -- | Numeric precedence of an operator data Precedence dom stage - = Precedence { _precedenceValue :: Int } + = Precedence { _precedenceValue :: Int } -- | Right hand side of a value binding (possible with guards): (@ = 3 @ or @ | x == 1 = 3; | otherwise = 4 @) data URhs dom stage @@ -83,12 +83,12 @@ } -- ^ An unguarded right-hand-side (@ = 3 @) | UGuardedRhss { _rhsGuards :: AnnListG UGuardedRhs dom stage } -- ^ An unguarded right-hand-side (@ | x == 1 = 3; | otherwise = 4 @) - --- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @) + +-- | A guarded right-hand side of a value binding (@ | x > 3 = 2 @) data UGuardedRhs dom stage = UGuardedRhs { _guardStmts :: AnnListG URhsGuard dom stage -- ^ Cannot be empty. , _guardExpr :: Ann UExpr dom stage - } + } -- | Guards for value bindings and pattern matches (@ Just v <- x, v > 1 @) data URhsGuard dom stage @@ -118,12 +118,12 @@ -- | Controls the activation of a rewrite rule (@ [1] @) data UPhaseControl dom stage = UPhaseControl { _phaseUntil :: AnnMaybeG PhaseInvert dom stage - , _phaseNumber :: Ann PhaseNumber dom stage - } + , _phaseNumber :: AnnMaybeG PhaseNumber dom stage + } -- | Phase number for rewrite rules data PhaseNumber dom stage = PhaseNumber { _phaseNum :: Integer } -- | A tilde that marks the inversion of the phase number -data PhaseInvert dom stage = PhaseInvert \ No newline at end of file +data PhaseInvert dom stage = PhaseInvert diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Decls.hs 2017-05-17 13:32:17.000000000 +0200 @@ -1,4 +1,4 @@ --- | Representation of Haskell AST definitions. These include definition of data types, classes, instances and so on. +-- | Representation of Haskell AST definitions. These include definition of data types, classes, instances and so on. -- The definition of value bindings are in the Binds module. module Language.Haskell.Tools.AST.Representation.Decls where @@ -21,7 +21,7 @@ | UTypeFamilyDecl { _declTypeFamily :: Ann UTypeFamily dom stage } -- ^ A type family declaration ( @type family F x@ ) | UClosedTypeFamilyDecl { _declHead :: Ann UDeclHead dom stage - , _declKind :: AnnMaybeG UKindConstraint dom stage + , _declSpec :: AnnMaybeG UTypeFamilySpec dom stage , _declDecl :: AnnListG UTypeEqn dom stage -- ^ cannot be empty } -- ^ A closed type family declaration | UDataDecl { _declNewtype :: Ann UDataOrNewtypeKeyword dom stage @@ -29,7 +29,7 @@ , _declHead :: Ann UDeclHead dom stage , _declCons :: AnnListG UConDecl dom stage , _declDeriving :: AnnMaybeG UDeriving dom stage - } -- ^ A data or newtype declaration. Empty data type declarations without + } -- ^ A data or newtype declaration. Empty data type declarations without -- where keyword are always belong to DataDecl. | UGDataDecl { _declNewtype :: Ann UDataOrNewtypeKeyword dom stage , _declCtx :: AnnMaybeG UContext dom stage @@ -78,11 +78,11 @@ | UForeignImport { _declCallConv :: Ann UCallConv dom stage , _declSafety :: AnnMaybeG USafety dom stage , _declName :: Ann UName dom stage - , _declType :: Ann UType dom stage + , _declForeignType :: Ann UType dom stage } -- ^ Foreign import (@ foreign import _foo :: Int -> IO Int @) | UForeignExport { _declCallConv :: Ann UCallConv dom stage , _declName :: Ann UName dom stage - , _declType :: Ann UType dom stage + , _declForeignType :: Ann UType dom stage } -- ^ Foreign export (@ foreign export ccall _foo :: Int -> IO Int @) | UPragmaDecl { _declPragma :: Ann UTopLevelPragma dom stage } -- ^ Top-level pragmas @@ -112,18 +112,20 @@ data UClassBody dom stage = UClassBody { _cbElements :: AnnListG UClassElement dom stage } - --- | Members of a class declaration + +-- | Members of a class declaration data UClassElement dom stage = UClsSig { _ceTypeSig :: Ann UTypeSignature dom stage } -- ^ Signature: @ f :: A -> B @ + | UClsFixity { _clsFixity :: Ann UFixitySignature dom stage + } -- ^ Fixity signature in class: @ infixl 1 >>- @ | UClsDef { _ceBind :: Ann UValueBind dom stage } -- ^ Default binding: @ f x = "aaa" @ | UClsTypeFam { _ceTypeFam :: Ann UTypeFamily dom stage - } -- ^ Declaration of an associated type synonym: @ type T x :: * @ + } -- ^ Declaration of an associated type synonym: @ type T x :: * @ | UClsTypeDef { _ceHead :: Ann UDeclHead dom stage , _ceKind :: Ann UType dom stage - } -- ^ Default choice for type synonym: @ type T x = TE @ or @ type instance T x = TE @ + } -- ^ Default choice for type synonym: @ type T x = TE @ or @ type instance T x = TE @ | UClsDefSig { _ceName :: Ann UName dom stage , _ceType :: Ann UType dom stage } -- ^ Default signature (by using @DefaultSignatures@): @ default _enum :: (Generic a, GEnum (Rep a)) => [a] @ @@ -136,7 +138,7 @@ -- } -- ^ Pattern signature in a class declaration (by using @PatternSynonyms@) -- * Type class instances - + -- | The instance declaration rule, which is, roughly, the part of the instance declaration before the where keyword. data UInstanceRule dom stage = UInstanceRule { _irVars :: AnnMaybeG (AnnListG UTyVar) dom stage @@ -149,7 +151,7 @@ = UInstanceHeadCon { _ihConName :: Ann UName dom stage } -- ^ Type or class name | UInstanceHeadInfix { _ihLeftOp :: Ann UType dom stage - , _ihOperator :: Ann UName dom stage + , _ihOperator :: Ann UOperator dom stage } -- ^ Infix application of the type/class name to the left operand | UInstanceHeadParen { _ihHead :: Ann UInstanceHead dom stage } -- ^ Parenthesized instance head @@ -185,11 +187,13 @@ } -- ^ Specialize instance pragma (no phase selection is allowed) | UInlineInstance { _instanceInline :: Ann UInlinePragma dom stage } -- ^ Inline-like pragma in a class instance + | UInstanceSpecialize { _specializeInstance :: Ann USpecializePragma dom stage + } -- ^ Specialize pragma -- not supported yet -- | UInstBodyPatSyn { _instBodyPatSyn :: Ann UPatternSynonym dom stage -- } -- ^ A pattern synonym in a class instance --- | Overlap pragmas. Can be applied to class declarations and class instance declarations. +-- | Overlap pragmas. Can be applied to class declarations and class instance declarations. data UOverlapPragma dom stage = UEnableOverlap -- ^ @OVERLAP@ pragma | UDisableOverlap -- ^ @NO_OVERLAP@ pragma @@ -218,7 +222,7 @@ -- | Injectivity annotation for type families (@ = r | r -> a @) data UInjectivityAnn dom stage - = UInjectivityAnn { _injAnnRes :: Ann UName dom stage + = UInjectivityAnn { _injAnnRes :: Ann UTyVar dom stage , _injAnnDeps :: AnnListG UName dom stage } @@ -233,9 +237,11 @@ -- | GADT constructor declaration (@ D1 :: { val :: Int } -> T String @) data UGadtConDecl dom stage = UGadtConDecl { _gadtConNames :: AnnListG UName dom stage + , _gadtConTypeArgs :: AnnListG UTyVar dom stage + , _gadtConTypeCtx :: AnnMaybeG UContext dom stage , _gadtConType :: Ann UGadtConType dom stage } - + -- | The @data@ or the @newtype@ keyword to define ADTs. data UDataOrNewtypeKeyword dom stage = UDataKeyword @@ -249,36 +255,42 @@ , _gadtConResultType :: Ann UType dom stage } --- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas +-- | A list of functional dependencies: @ | a -> b, c -> d @ separated by commas data UFunDeps dom stage = UFunDeps { _funDeps :: AnnListG UFunDep dom stage - } - --- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@ + } + +-- | A functional dependency, given on the form @l1 ... ln -> r1 ... rn@ data UFunDep dom stage = UFunDep { _funDepLhs :: AnnListG UName dom stage , _funDepRhs :: AnnListG UName dom stage } - + -- | A constructor declaration for a datatype data UConDecl dom stage - = UConDecl { _conDeclName :: Ann UName dom stage + = UConDecl { _conTypeArgs :: AnnListG UTyVar dom stage + , _conTypeCtx :: AnnMaybeG UContext dom stage + , _conDeclName :: Ann UName dom stage , _conDeclArgs :: AnnListG UType dom stage } -- ^ Ordinary data constructor (@ C t1 t2 @) - | URecordDecl { _conDeclName :: Ann UName dom stage + | URecordDecl { _conTypeArgs :: AnnListG UTyVar dom stage + , _conTypeCtx :: AnnMaybeG UContext dom stage + , _conDeclName :: Ann UName dom stage , _conDeclFields :: AnnListG UFieldDecl dom stage } -- ^ Record data constructor (@ C { _n1 :: t1, _n2 :: t2 } @) - | UInfixConDecl { _conDeclLhs :: Ann UType dom stage + | UInfixConDecl { _conTypeArgs :: AnnListG UTyVar dom stage + , _conTypeCtx :: AnnMaybeG UContext dom stage + , _conDeclLhs :: Ann UType dom stage , _conDeclOp :: Ann UOperator dom stage , _conDeclRhs :: Ann UType dom stage } -- ^ Infix data constructor (@ t1 :+: t2 @) - + -- | Field declaration (@ fld :: Int @) data UFieldDecl dom stage = UFieldDecl { _fieldNames :: AnnListG UName dom stage , _fieldType :: Ann UType dom stage } - + -- | A deriving clause following a data type declaration. (@ deriving Show @ or @ deriving (Show, Eq) @) data UDeriving dom stage = UDerivingOne { _oneDerived :: Ann UInstanceHead dom stage } @@ -290,7 +302,7 @@ data UPatternTypeSignature dom stage = UPatternTypeSignature { _patSigName :: Ann UName dom stage , _patSigType :: Ann UType dom stage - } + } -- | Pattern synonyms: @ pattern Arrow t1 t2 = App "->" [t1, t2] @ data UPatternSynonym dom stage @@ -325,7 +337,7 @@ = UPatSynWhere { _patOpposite :: AnnListG UMatch dom stage } -- * Foreign imports - + -- | Call conventions of foreign functions data UCallConv dom stage = UStdCall @@ -359,10 +371,10 @@ = URulePragma { _pragmaRule :: AnnListG URule dom stage } -- ^ A pragma that introduces source rewrite rules (@ {-# RULES "map/map" [2] forall f g xs. map f (map g xs) = map (f.g) xs #-} @) | UDeprPragma { _pragmaObjects :: AnnListG UName dom stage - , _pragmaMessage :: Ann UStringNode dom stage + , _deprMessage :: AnnListG UStringNode dom stage } -- ^ A pragma that marks definitions as deprecated (@ {-# DEPRECATED f "f will be replaced by g" @) | UWarningPragma { _pragmaObjects :: AnnListG UName dom stage - , _pragmaMessage :: Ann UStringNode dom stage + , _warnMessage :: AnnListG UStringNode dom stage } -- ^ A pragma that marks definitions as deprecated (@ {-# WARNING unsafePerformIO "you should know what you are doing" @) | UAnnPragma { _annotationSubject :: Ann UAnnotationSubject dom stage , _annotateExpr :: Ann UExpr dom stage @@ -372,7 +384,10 @@ | ULinePragma { _pragmaLineNum :: Ann LineNumber dom stage , _pragmaFileName :: AnnMaybeG UStringNode dom stage } -- ^ A pragma for maintaining line numbers in generated sources (@ {-# LINE 123 "somefile" #-} @) - | USpecializePragma { _pragmaPhase :: AnnMaybeG UPhaseControl dom stage + | USpecializeDecl { _specializePragma :: Ann USpecializePragma dom stage } + +data USpecializePragma dom stage + = USpecializePragma { _pragmaPhase :: AnnMaybeG UPhaseControl dom stage , _specializeDef :: Ann UName dom stage , _specializeType :: AnnListG UType dom stage } -- ^ A pragma that tells the compiler that a polymorph function should be optimized for a given type (@ {-# SPECIALISE f :: Int -> b -> b #-} @) @@ -381,12 +396,20 @@ data URule dom stage = URule { _ruleName :: Ann UStringNode dom stage -- ^ User name of the rule , _rulePhase :: AnnMaybeG UPhaseControl dom stage -- ^ The compilation phases in which the rule can be applied - , _ruleBounded :: AnnListG UTyVar dom stage -- ^ Variables bound in the rule + , _ruleBounded :: AnnListG URuleVar dom stage -- ^ Variables bound in the rule , _ruleLhs :: Ann UExpr dom stage -- ^ The transformed expression , _ruleRhs :: Ann UExpr dom stage -- ^ The resulting expression } - --- | Annotation allows you to connect an expression to any declaration. + +-- | A variable for a rewrite rule. With or without type signature. +data URuleVar dom stage + = URuleVar { _ruleVarName :: Ann UName dom stage + } -- ^ A simple rule variable + | USigRuleVar { _ruleVarName :: Ann UName dom stage + , _ruleVarType :: Ann UType dom stage + } -- ^ A rule variable with signature + +-- | Annotation allows you to connect an expression to any declaration. data UAnnotationSubject dom stage = UNameAnnotation { _annotateName :: Ann UName dom stage } -- ^ The definition with the given name is annotated @@ -407,4 +430,4 @@ -- | A line number for a line pragma. data LineNumber dom stage - = LineNumber { _lineNumber :: Int } + = LineNumber { _lineNumber :: Int } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Exprs.hs 2017-05-03 22:13:55.000000000 +0200 @@ -12,7 +12,7 @@ -- | Haskell expressions data UExpr dom stage - = UVar { _exprName :: Ann UName dom stage + = UVar { _exprName :: Ann UName dom stage } -- ^ A variable or a data constructor (@ a @) | ULit { _exprLit :: Ann ULiteral dom stage } -- ^ Literal expression (@ 42 @) @@ -116,7 +116,7 @@ | UStaticPtr { _exprInner :: Ann UExpr dom stage } -- ^ Static pointer expression (@ static e @). The inner expression must be closed (cannot have variables bound outside) -- XML expressions omitted - + -- | Field update expressions data UFieldUpdate dom stage = UNormalFieldUpdate { _fieldName :: Ann UName dom stage @@ -126,7 +126,7 @@ } -- ^ Update the field to the value of the same name (@ x @) | UFieldWildcard { _fieldWildcard :: Ann UFieldWildcard dom stage } -- ^ Update the fields of the bounded names to their values (@ .. @). Must be the last initializer. Cannot be used in a record update expression. - + -- | Marker for a field wildcard. Only needed to attach semantic information in a type-safe way. data UFieldWildcard dom stage = FldWildcard @@ -135,7 +135,7 @@ = Present { _tupSecExpr :: Ann UExpr dom stage } -- ^ An existing element in a tuple section | Missing -- ^ A missing element in a tuple section - + -- | Clause of case expression (@ Just x -> x + 1 @) data UAlt' expr dom stage = UAlt { _altPattern :: Ann UPattern dom stage @@ -145,7 +145,7 @@ type UAlt = UAlt' UExpr type UCmdAlt = UAlt' UCmd - + -- | Right hand side of a match (possible with guards): (@ -> 3 @ or @ | x == 1 -> 3; | otherwise -> 4 @) data UCaseRhs' expr dom stage = UUnguardedCaseRhs { _rhsCaseExpr :: Ann expr dom stage @@ -154,15 +154,15 @@ } -- ^ Guarded right-hand sides of a pattern match (@ | x == 1 -> 3; | otherwise -> 4 @) type UCaseRhs = UCaseRhs' UExpr type UCmdCaseRhs = UCaseRhs' UCmd - --- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @) + +-- | A guarded right-hand side of pattern matches binding (@ | x > 3 -> 2 @) data UGuardedCaseRhs' expr dom stage = UGuardedCaseRhs { _caseGuardStmts :: AnnListG URhsGuard dom stage -- ^ Cannot be empty. , _caseGuardExpr :: Ann expr dom stage - } + } type UGuardedCaseRhs = UGuardedCaseRhs' UExpr type UCmdGuardedCaseRhs = UGuardedCaseRhs' UCmd - + -- | Pragmas that can be applied to expressions data UExprPragma dom stage = UCorePragma { _pragmaStr :: Ann UStringNode dom stage @@ -179,12 +179,12 @@ , _srFromCol :: Ann Number dom stage , _srToLine :: Ann Number dom stage , _srToCol :: Ann Number dom stage - } + } data Number dom stage - = Number { _numberInteger :: Integer + = Number { _numberInteger :: Integer } - + -- * Arrows data UCmd dom stage @@ -204,7 +204,7 @@ } -- ^ An infix command application | ULambdaCmd { _cmdBindings :: AnnListG UPattern dom stage -- ^ at least one , _cmdInner :: Ann UCmd dom stage - } -- ^ A lambda command + } -- ^ A lambda command | UParenCmd { _cmdInner :: Ann UCmd dom stage } -- ^ A parenthesized command | UCaseCmd { _cmdExpr :: Ann UExpr dom stage diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Kinds.hs 2017-05-17 10:56:30.000000000 +0200 @@ -2,13 +2,14 @@ module Language.Haskell.Tools.AST.Representation.Kinds where import Language.Haskell.Tools.AST.Ann (Ann, AnnListG) -import Language.Haskell.Tools.AST.Representation.Names (UName) +import Language.Haskell.Tools.AST.Representation.Names (UName, UOperator) +import {-# SOURCE #-} Language.Haskell.Tools.AST.Representation.Types (UType) -- | Kind constraint (@ :: * -> * @) data UKindConstraint dom stage - = UKindConstraint { _kindConstr :: Ann UKind dom stage + = UKindConstraint { _kindConstr :: Ann UKind dom stage } - + -- | Haskell kinds data UKind dom stage = UStarKind -- ^ @*@, the kind of types @@ -21,22 +22,30 @@ | UVarKind { _kindVar :: Ann UName dom stage } -- ^ Kind variable (using @PolyKinds@ extension) | UAppKind { _kindAppFun :: Ann UKind dom stage - , _kindAppArg :: Ann UKind dom stage + , _kindAppArg :: Ann UKind dom stage } -- ^ Kind application (@ k1 k2 @) + | UInfixAppKind { _kindLhs ::Ann UKind dom stage + , _kindAppOp :: Ann UOperator dom stage + , _kindRhs :: Ann UKind dom stage + } -- ^ Infix kind application (@ k1 ~> k2 @) | UListKind { _kindElem :: Ann UKind dom stage } -- ^ A list kind (@ [k] @) + | UTupleKind { _kindElems :: AnnListG UKind dom stage + } -- ^ A tuple kind (@ (Symbol, *) @) | UPromotedKind { _kindPromoted :: Ann (UPromoted UKind) dom stage } -- ^ A promoted kind (@ '(k1,k2,k3) @) + | UTypeKind { _kindType :: Ann UType dom stage + } -- ^ A type on the kind level with @TypeInType@ data UPromoted t dom stage - = UPromotedInt { _promotedIntValue :: Integer + = UPromotedInt { _promotedIntValue :: Integer } -- ^ Numeric value promoted to the kind level. - | UPromotedString { _promotedStringValue :: String + | UPromotedString { _promotedStringValue :: String } -- ^ String value promoted to the kind level. - | UPromotedCon { _promotedConName :: Ann UName dom stage + | UPromotedCon { _promotedConName :: Ann UName dom stage } -- ^ A data constructor value promoted to the kind level. - | UPromotedList { _promotedElements :: AnnListG t dom stage + | UPromotedList { _promotedElements :: AnnListG t dom stage } -- ^ A list of elements as a kind. - | UPromotedTuple { _promotedElements :: AnnListG t dom stage + | UPromotedTuple { _promotedElements :: AnnListG t dom stage } -- ^ A tuple of elements as a kind. - | UPromotedUnit -- ^ Kind of the unit value @()@. \ No newline at end of file + | UPromotedUnit -- ^ Kind of the unit value @()@. diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Names.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Names.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Names.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Names.hs 2017-05-03 22:13:55.000000000 +0200 @@ -6,39 +6,39 @@ -- | Simple AST elements of Haskell module Language.Haskell.Tools.AST.Representation.Names where - + import Language.Haskell.Tools.AST.Ann (Ann, AnnListG(..)) data UOperator dom stage - = UBacktickOp { _operatorName :: Ann UQualifiedName dom stage + = UBacktickOp { _operatorName :: Ann UQualifiedName dom stage } -- ^ A normal name used as an operator with backticks: @ a `mod` b @ - | UNormalOp { _operatorName :: Ann UQualifiedName dom stage + | UNormalOp { _operatorName :: Ann UQualifiedName dom stage } -- ^ A normal operator used as an operator. data UName dom stage - = UParenName { _simpleName :: Ann UQualifiedName dom stage + = UParenName { _simpleName :: Ann UQualifiedName dom stage } -- ^ Parenthesized name: @ foldl (+) 0 @ - | UNormalName { _simpleName :: Ann UQualifiedName dom stage + | UNormalName { _simpleName :: Ann UQualifiedName dom stage } -- ^ A normal, non-operator name. - | UImplicitName { _simpleName :: Ann UQualifiedName dom stage + | UImplicitName { _simpleName :: Ann UQualifiedName dom stage } -- ^ Implicit name: @ ?var @ -- | Possible qualified names. Contains also implicit names. -- Linear implicit parameter: @%x@. Non-linear implicit parameter: @?x@. data UQualifiedName dom stage = UQualifiedName { _qualifiers :: AnnListG UNamePart dom stage - , _unqualifiedName :: Ann UNamePart dom stage - } + , _unqualifiedName :: Ann UNamePart dom stage + } nameFromList :: AnnListG UNamePart dom stage -> UQualifiedName dom stage -nameFromList (AnnListG a xs) | not (null xs) - = UQualifiedName (AnnListG a (init xs)) (last xs) +nameFromList (AnnListG a xs) | not (null xs) + = UQualifiedName (AnnListG a (init xs)) (last xs) nameFromList _ = error "nameFromList: empty list" - --- | Parts of a qualified name. + +-- | Parts of a qualified name. data UNamePart dom stage - = UNamePart { _simpleNameStr :: String } - + = UNamePart { _simpleNameStr :: String } + -- | Program elements formatted as string literals (import packages, pragma texts) data UStringNode dom stage - = UStringNode { _stringNodeStr :: String } + = UStringNode { _stringNodeStr :: String } diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs 2017-05-03 22:13:55.000000000 +0200 @@ -65,10 +65,8 @@ -- One or more assertions data UContext dom stage - = UContextOne { _contextAssertion :: Ann UAssertion dom stage - } -- ^ One assertion (@ C a => ... @) - | UContextMulti { _contextAssertions :: AnnListG UAssertion dom stage - } -- ^ A set of assertions (@ (C1 a, C2 b) => ... @, but can be one: @ (C a) => ... @) + = UContext { _contextAssertion :: Ann UAssertion dom stage + } -- ^ Assertions with the fat arrow (@ C a => ... @) -- | A single assertion in the context data UAssertion dom stage @@ -82,5 +80,6 @@ | UImplicitAssert { _assertImplVar :: Ann UName dom stage , _assertImplType :: Ann UType dom stage } -- ^ Assertion for implicit parameter binding (@ ?cmp :: a -> a -> Bool @) - - \ No newline at end of file + | UTupleAssert { _innerAsserts :: AnnListG UAssertion dom stage + } -- ^ Multiple assertions in one (@ (Ord a, Show a) @) + | UWildcardAssert -- ^ Wildcard assertion (@ _ @), enabled by @PartialTypeSignatures@ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot 1970-01-01 01:00:00.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Representation/Types.hs-boot 2017-05-03 22:13:55.000000000 +0200 @@ -0,0 +1,6 @@ +{-# LANGUAGE RoleAnnotations #-} +-- | Representation of Haskell types +module Language.Haskell.Tools.AST.Representation.Types where + +type role UType nominal nominal +data UType dom stage diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoClasses.hs 2017-05-22 15:12:54.000000000 +0200 @@ -4,7 +4,7 @@ , TypeFamilies , UndecidableInstances #-} -module Language.Haskell.Tools.AST.SemaInfoClasses where +module Language.Haskell.Tools.AST.SemaInfoClasses (module Language.Haskell.Tools.AST.SemaInfoClasses, UsageSpec(..)) where import GHC import Id as GHC (Id, idName) @@ -33,7 +33,7 @@ semanticsName = fmap idName . (^? cnameInfo) instance HasNameInfo dom => HasNameInfo' (Ann UQualifiedName dom st) where - semanticsName = semanticsName . (^. annotation&semanticInfo) + semanticsName = semanticsName . (^. annotation&semanticInfo) -- * Information about typed names @@ -47,7 +47,7 @@ semanticsId = (^. cnameInfo) instance HasIdInfo dom => HasIdInfo' (Ann UQualifiedName dom st) where - semanticsId = semanticsId . (^. annotation&semanticInfo) + semanticsId = semanticsId . (^. annotation&semanticInfo) -- * Fixity information @@ -61,7 +61,7 @@ semanticsFixity = (^. cnameFixity) instance HasFixityInfo dom => HasFixityInfo' (Ann UQualifiedName dom st) where - semanticsFixity = semanticsFixity . (^. annotation&semanticInfo) + semanticsFixity = semanticsFixity . (^. annotation&semanticInfo) -- * Scope information @@ -81,10 +81,10 @@ semanticsScope = (^. exprScopedLocals) instance HasScopeInfo dom => HasScopeInfo' (Ann UExpr dom st) where - semanticsScope = semanticsScope . (^. annotation&semanticInfo) + semanticsScope = semanticsScope . (^. annotation&semanticInfo) instance HasScopeInfo dom => HasScopeInfo' (Ann UQualifiedName dom st) where - semanticsScope = semanticsScope . (^. annotation&semanticInfo) + semanticsScope = semanticsScope . (^. annotation&semanticInfo) -- * Information about names being defined @@ -101,7 +101,7 @@ semanticsDefining = (^. cnameIsDefined) instance HasDefiningInfo dom => HasDefiningInfo' (Ann UQualifiedName dom st) where - semanticsDefining = semanticsDefining . (^. annotation&semanticInfo) + semanticsDefining = semanticsDefining . (^. annotation&semanticInfo) -- * Information about source info in sema @@ -117,6 +117,7 @@ class HasModuleInfo' si where semanticsModule :: si -> GHC.Module + semanticsDynFlags :: si -> GHC.DynFlags isBootModule :: si -> Bool semanticsImplicitImports :: si -> [GHC.Name] semanticsPrelOrphanInsts :: si -> [ClsInst] @@ -124,6 +125,7 @@ instance HasModuleInfo' (AST.ModuleInfo GHC.Name) where semanticsModule = (^. defModuleName) + semanticsDynFlags = (^. defDynFlags) isBootModule = (^. defIsBootModule) semanticsImplicitImports = (^. implicitNames) semanticsPrelOrphanInsts = (^. prelOrphanInsts) @@ -131,22 +133,24 @@ instance HasModuleInfo' (AST.ModuleInfo GHC.Id) where semanticsModule = (^. defModuleName) + semanticsDynFlags = (^. defDynFlags) isBootModule = (^. defIsBootModule) semanticsImplicitImports = map idName . (^. implicitNames) semanticsPrelOrphanInsts = (^. prelOrphanInsts) semanticsPrelFamInsts = (^. prelFamInsts) instance HasModuleInfo dom => HasModuleInfo' (Ann UModule dom st) where - semanticsModule = semanticsModule . (^. annotation&semanticInfo) - isBootModule = isBootModule . (^. annotation&semanticInfo) - semanticsImplicitImports = semanticsImplicitImports . (^. annotation&semanticInfo) - semanticsPrelOrphanInsts = semanticsPrelOrphanInsts . (^. annotation&semanticInfo) - semanticsPrelFamInsts = semanticsPrelFamInsts . (^. annotation&semanticInfo) + semanticsModule = semanticsModule . (^. annotation&semanticInfo) + semanticsDynFlags = semanticsDynFlags . (^. annotation&semanticInfo) + isBootModule = isBootModule . (^. annotation&semanticInfo) + semanticsImplicitImports = semanticsImplicitImports . (^. annotation&semanticInfo) + semanticsPrelOrphanInsts = semanticsPrelOrphanInsts . (^. annotation&semanticInfo) + semanticsPrelFamInsts = semanticsPrelFamInsts . (^. annotation&semanticInfo) -- * Information about imports type HasImportInfo dom = (Domain dom, HasImportInfo' (SemanticInfo dom AST.UImportDecl)) - + class HasImportInfo' si where semanticsImportedModule :: si -> GHC.Module semanticsAvailable :: si -> [GHC.Name] @@ -169,16 +173,16 @@ semanticsFamInsts = (^. importedFamInsts) instance HasImportInfo dom => HasImportInfo' (Ann UImportDecl dom st) where - semanticsImportedModule = semanticsImportedModule . (^. annotation&semanticInfo) - semanticsAvailable = semanticsAvailable . (^. annotation&semanticInfo) - semanticsImported = semanticsImported . (^. annotation&semanticInfo) - semanticsOrphanInsts = semanticsOrphanInsts . (^. annotation&semanticInfo) - semanticsFamInsts = semanticsFamInsts . (^. annotation&semanticInfo) + semanticsImportedModule = semanticsImportedModule . (^. annotation&semanticInfo) + semanticsAvailable = semanticsAvailable . (^. annotation&semanticInfo) + semanticsImported = semanticsImported . (^. annotation&semanticInfo) + semanticsOrphanInsts = semanticsOrphanInsts . (^. annotation&semanticInfo) + semanticsFamInsts = semanticsFamInsts . (^. annotation&semanticInfo) --- * Information about implicitely bounded fields +-- * Information about implicitly bounded fields type HasImplicitFieldsInfo dom = (Domain dom, HasImplicitFieldsInfo' (SemanticInfo dom AST.UFieldWildcard)) - + class HasImplicitFieldsInfo' si where semanticsImplicitFlds :: si -> [(GHC.Name, GHC.Name)] @@ -186,7 +190,7 @@ semanticsImplicitFlds = (^. implicitFieldBindings) instance HasImplicitFieldsInfo dom => HasImplicitFieldsInfo' (Ann UFieldWildcard dom st) where - semanticsImplicitFlds = semanticsImplicitFlds . (^. annotation&semanticInfo) + semanticsImplicitFlds = semanticsImplicitFlds . (^. annotation&semanticInfo) -- * AST elements with no information diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/SemaInfoTypes.hs 2017-05-22 15:12:54.000000000 +0200 @@ -1,18 +1,18 @@ {-# LANGUAGE DeriveDataTypeable - , StandaloneDeriving - , TemplateHaskell + , StandaloneDeriving + , TemplateHaskell , UndecidableInstances , FlexibleContexts , FlexibleInstances #-} module Language.Haskell.Tools.AST.SemaInfoTypes - ( -- types + ( -- types NoSemanticInfo, ScopeInfo, NameInfo, CNameInfo, ModuleInfo, ImportInfo, ImplicitFieldInfo - , Scope + , Scope, UsageSpec(..) -- references , exprScopedLocals, nameScopedLocals, nameIsDefined, nameInfo, ambiguousName, nameLocation , implicitName, cnameScopedLocals, cnameIsDefined, cnameInfo, cnameFixity - , defModuleName, defIsBootModule, implicitNames, importedModule, availableNames, importedNames + , defModuleName, defDynFlags, defIsBootModule, implicitNames, importedModule, availableNames, importedNames , implicitFieldBindings, importedOrphanInsts, importedFamInsts, prelOrphanInsts, prelFamInsts -- creator functions , mkNoSemanticInfo, mkScopeInfo, mkNameInfo, mkAmbiguousNameInfo, mkImplicitNameInfo, mkCNameInfo @@ -20,6 +20,7 @@ ) where import BasicTypes as GHC +import DynFlags as GHC import FamInstEnv as GHC import Id as GHC import InstEnv as GHC @@ -34,18 +35,30 @@ import Control.Reference -type Scope = [[Name]] +type Scope = [[(Name, Maybe [UsageSpec])]] --- | Semantic info type for any node not +data UsageSpec = UsageSpec { usageQualified :: Bool + , usageQualifier :: String + , usageAs :: String + } + deriving (Eq, Data) + +instance Outputable UsageSpec where + ppr (UsageSpec q useQ asQ) + = GHC.text $ (if q then "qualified " else "") ++ "as " ++ (if useQ == asQ || q then asQ else asQ ++ " or " ++ useQ) + pprPrec _ (UsageSpec q useQ asQ) + = GHC.text $ (if q then "qualified " else "") ++ "as " ++ (if useQ == asQ || q then asQ else asQ ++ " or " ++ useQ) + +-- | Semantic info type for any node not -- carrying additional semantic information -data NoSemanticInfo = NoSemanticInfo +data NoSemanticInfo = NoSemanticInfo deriving (Eq, Data) mkNoSemanticInfo :: NoSemanticInfo mkNoSemanticInfo = NoSemanticInfo -- | Info for expressions that tells which definitions are in scope -data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope +data ScopeInfo = ScopeInfo { _exprScopedLocals :: Scope } deriving (Eq, Data) @@ -57,7 +70,7 @@ data NameInfo n = NameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool , _nameInfo :: n - } + } | AmbiguousNameInfo { _nameScopedLocals :: Scope , _nameIsDefined :: Bool , _ambiguousName :: RdrName @@ -96,24 +109,33 @@ mkCNameInfo = CNameInfo -- | Info for the module element -data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module +data ModuleInfo n = ModuleInfo { _defModuleName :: GHC.Module + , _defDynFlags :: DynFlags -- ^ The compilation flags that are set up when the module was compiled , _defIsBootModule :: Bool -- ^ True if this module is created from a hs-boot file - , _implicitNames :: [n] -- ^ Implicitely imported names - , _prelOrphanInsts :: [ClsInst] -- ^ Class instances implicitely passed from Prelude. - , _prelFamInsts :: [FamInst] -- ^ Family instances implicitely passed from Prelude. - } + , _implicitNames :: [n] -- ^ implicitly imported names + , _prelOrphanInsts :: [ClsInst] -- ^ Class instances implicitly passed from Prelude. + , _prelFamInsts :: [FamInst] -- ^ Family instances implicitly passed from Prelude. + } deriving Data +instance Data DynFlags where + gunfold k z c = error "Cannot construct dyn flags" + toConstr _ = dynFlagsCon + dataTypeOf _ = dynFlagsType + +dynFlagsType = mkDataType "DynFlags.DynFlags" [dynFlagsCon] +dynFlagsCon = mkConstr dynFlagsType "DynFlags" [] Prefix + -- | Creates semantic information for the module element -mkModuleInfo :: GHC.Module -> Bool -> [n] -> [ClsInst] -> [FamInst] -> ModuleInfo n +mkModuleInfo :: GHC.Module -> DynFlags -> Bool -> [n] -> [ClsInst] -> [FamInst] -> ModuleInfo n mkModuleInfo = ModuleInfo -- | Info corresponding to an import declaration data ImportInfo n = ImportInfo { _importedModule :: GHC.Module -- ^ The name and package of the imported module , _availableNames :: [n] -- ^ Names available from the imported module , _importedNames :: [n] -- ^ Names actually imported from the module. - , _importedOrphanInsts :: [ClsInst] -- ^ Class instances implicitely passed. - , _importedFamInsts :: [FamInst] -- ^ Family instances implicitely passed. + , _importedOrphanInsts :: [ClsInst] -- ^ Class instances implicitly passed. + , _importedFamInsts :: [FamInst] -- ^ Family instances implicitly passed. } deriving Data @@ -125,8 +147,8 @@ mkImportInfo = ImportInfo -- | Info corresponding to an record-wildcard -data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)] -- ^ The implicitely bounded names - } +data ImplicitFieldInfo = ImplicitFieldInfo { _implicitFieldBindings :: [(Name, Name)] -- ^ The implicitly bounded names + } deriving (Eq, Data) -- | Creates semantic information for a wildcard field binding @@ -145,13 +167,13 @@ show (CNameInfo locals defined nameInfo fixity) = "(CNameInfo " ++ showSDocUnsafe (ppr locals) ++ " " ++ show defined ++ " " ++ showSDocUnsafe (ppr nameInfo) ++ showSDocUnsafe (ppr fixity) ++ ")" instance Outputable n => Show (ModuleInfo n) where - show (ModuleInfo mod isboot imp clsInsts famInsts) - = "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ " " + show (ModuleInfo mod _ isboot imp clsInsts famInsts) + = "(ModuleInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ show isboot ++ " " ++ showSDocUnsafe (ppr imp) ++ " " ++ showSDocUnsafe (ppr clsInsts) ++ " " ++ showSDocUnsafe (ppr famInsts) ++ ")" instance Outputable n => Show (ImportInfo n) where - show (ImportInfo mod avail imported clsInsts famInsts) - = "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ " " + show (ImportInfo mod avail imported clsInsts famInsts) + = "(ImportInfo " ++ showSDocUnsafe (ppr mod) ++ " " ++ showSDocUnsafe (ppr avail) ++ " " ++ showSDocUnsafe (ppr imported) ++ " " ++ showSDocUnsafe (ppr clsInsts) ++ " " ++ showSDocUnsafe (ppr famInsts) ++ ")" instance Show ImplicitFieldInfo where @@ -192,10 +214,9 @@ traverse _ (ImplicitNameInfo locals defined nameInfo span) = pure $ ImplicitNameInfo locals defined nameInfo span instance Traversable ModuleInfo where - traverse f (ModuleInfo mod isboot imp clsInsts famInsts) - = ModuleInfo mod isboot <$> traverse f imp <*> pure clsInsts <*> pure famInsts + traverse f (ModuleInfo mod dfs isboot imp clsInsts famInsts) + = ModuleInfo mod dfs isboot <$> traverse f imp <*> pure clsInsts <*> pure famInsts instance Traversable ImportInfo where - traverse f (ImportInfo mod avail imps clsInsts famInsts) + traverse f (ImportInfo mod avail imps clsInsts famInsts) = ImportInfo mod <$> traverse f avail <*> traverse f imps <*> pure clsInsts <*> pure famInsts - diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs 2017-01-31 20:47:40.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST/Utils/OrdSrcSpan.hs 1970-01-01 01:00:00.000000000 +0100 @@ -1,30 +0,0 @@ --- | A wrapper for SrcSpans that is ordered. -module Language.Haskell.Tools.AST.Utils.OrdSrcSpan where - -import FastString (FastString) -import SrcLoc - --- | Wraps the SrcSpan into an ordered source span -ordSrcSpan :: SrcSpan -> OrdSrcSpan -ordSrcSpan (RealSrcSpan sp) = OrdSrcSpan sp -ordSrcSpan (UnhelpfulSpan fs) = NoOrdSrcSpan fs - --- | Unwrap the ordered source span -fromOrdSrcSpan :: OrdSrcSpan -> SrcSpan -fromOrdSrcSpan (OrdSrcSpan sp) = RealSrcSpan sp -fromOrdSrcSpan (NoOrdSrcSpan fs) = UnhelpfulSpan fs - --- | A wrapper for SrcSpans that is ordered. -data OrdSrcSpan - = OrdSrcSpan RealSrcSpan - | NoOrdSrcSpan FastString - deriving (Show, Eq) - -instance Ord OrdSrcSpan where - compare (NoOrdSrcSpan _) (NoOrdSrcSpan _) = EQ - compare (OrdSrcSpan _) (NoOrdSrcSpan _) = GT - compare (NoOrdSrcSpan _) (OrdSrcSpan _) = LT - compare (OrdSrcSpan rsp1) (OrdSrcSpan rsp2) - = compare (realSrcSpanStart rsp1) (realSrcSpanStart rsp2) - `mappend` compare (realSrcSpanEnd rsp1) (realSrcSpanEnd rsp2) - \ No newline at end of file diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST.hs new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST.hs --- old/haskell-tools-ast-0.5.0.0/Language/Haskell/Tools/AST.hs 2017-01-31 20:47:39.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/Language/Haskell/Tools/AST.hs 2017-05-03 22:13:55.000000000 +0200 @@ -1,7 +1,7 @@ -- | A custom AST representation for Haskell tools. -- Different layers of the AST are recursive, to separate them into modules -- we introduced source imports. -module Language.Haskell.Tools.AST +module Language.Haskell.Tools.AST ( module Language.Haskell.Tools.AST.References , module Language.Haskell.Tools.AST.Helpers , module Language.Haskell.Tools.AST.Representation.Modules @@ -16,7 +16,6 @@ , module Language.Haskell.Tools.AST.Representation.Literals , module Language.Haskell.Tools.AST.Representation.Names , module Language.Haskell.Tools.AST.Ann - , module Language.Haskell.Tools.AST.Utils.OrdSrcSpan , module Language.Haskell.Tools.AST.SemaInfoClasses ) where @@ -37,4 +36,3 @@ import Language.Haskell.Tools.AST.Representation.TH import Language.Haskell.Tools.AST.Representation.Types import Language.Haskell.Tools.AST.SemaInfoClasses -import Language.Haskell.Tools.AST.Utils.OrdSrcSpan diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/haskell-tools-ast-0.5.0.0/haskell-tools-ast.cabal new/haskell-tools-ast-0.8.0.0/haskell-tools-ast.cabal --- old/haskell-tools-ast-0.5.0.0/haskell-tools-ast.cabal 2017-01-31 20:57:34.000000000 +0100 +++ new/haskell-tools-ast-0.8.0.0/haskell-tools-ast.cabal 2017-07-01 12:34:40.000000000 +0200 @@ -1,5 +1,5 @@ name: haskell-tools-ast -version: 0.5.0.0 +version: 0.8.0.0 synopsis: Haskell AST for efficient tooling description: A representation of a Haskell Syntax tree that contain source-related and semantic annotations. These annotations help developer tools to work with the defined program. The source information enables refactoring and program transformation tools to change the source code without losing the original format (layout, comments) of the source. Semantic information helps analyzing the program. The representation is different from the GHC's syntax tree. It contains information from all representations in GHC (different version of syntax trees, lexical and module-level information). The module is split up to put the representation of different language elements into different modules. Additionally, it contains the representation of semantic and source annotations, helper functions and generated instances for the representation of language elements. Because langauge elements may refer each other (there can be a pattern inside an expression in case of a pattern match and an expression inside a pattern if view patterns are enabled), we use hs-boot files to break up dependency cycles. @@ -13,13 +13,13 @@ cabal-version: >=1.10 library - ghc-options: -O2 + ghc-options: -O2 exposed-modules: Language.Haskell.Tools.AST , Language.Haskell.Tools.AST.References , Language.Haskell.Tools.AST.Helpers , Language.Haskell.Tools.AST.Ann , Language.Haskell.Tools.AST.SemaInfoTypes - , Language.Haskell.Tools.AST.SemaInfoClasses + , Language.Haskell.Tools.AST.SemaInfoClasses other-modules: Language.Haskell.Tools.AST.Representation.Modules , Language.Haskell.Tools.AST.Representation.TH @@ -34,7 +34,6 @@ , Language.Haskell.Tools.AST.Representation.Names , Language.Haskell.Tools.AST.MakeASTReferences - , Language.Haskell.Tools.AST.Utils.OrdSrcSpan , Language.Haskell.Tools.AST.Utils.GHCInstances , Language.Haskell.Tools.AST.Instances @@ -46,11 +45,11 @@ , Language.Haskell.Tools.AST.Instances.SourceInfoTraversal , Language.Haskell.Tools.AST.TH.SemanticTraversal , Language.Haskell.Tools.AST.TH.SourceInfoTraversal - + build-depends: base >= 4.9 && < 4.10 , ghc >= 8.0 && < 8.1 , references >= 0.3 && < 0.4 , uniplate >= 1.6 && < 1.7 , mtl >= 2.2 && < 2.3 , template-haskell >= 2.11 && < 2.12 - default-language: Haskell2010 \ No newline at end of file + default-language: Haskell2010

1 0

commit ghc-happstack-server-tls for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-happstack-server-tls for openSUSE:Factory checked in at 2017-08-31 20:55:50 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-happstack-server-tls (Old) and /work/SRC/openSUSE:Factory/.ghc-happstack-server-tls.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-happstack-server-tls" Thu Aug 31 20:55:50 2017 rev:2 rq:513365 version:7.1.6.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-happstack-server-tls/ghc-happstack-server-tls.changes 2017-04-14 13:32:30.851543260 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-happstack-server-tls.new/ghc-happstack-server-tls.changes 2017-08-31 20:55:50.612642850 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:02:51 UTC 2017 - psimons(a)suse.com + +- Update to version 7.1.6.3. + +------------------------------------------------------------------- Old: ---- happstack-server-tls-7.1.6.2.tar.gz New: ---- happstack-server-tls-7.1.6.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-happstack-server-tls.spec ++++++ --- /var/tmp/diff_new_pack.irGNi7/_old 2017-08-31 20:55:51.752482699 +0200 +++ /var/tmp/diff_new_pack.irGNi7/_new 2017-08-31 20:55:51.776479327 +0200 @@ -1,7 +1,7 @@ # # spec file for package ghc-happstack-server-tls # -# Copyright (c) 2016 SUSE LINUX GmbH, Nuernberg, Germany. +# Copyright (c) 2017 SUSE LINUX GmbH, Nuernberg, Germany. # # All modifications and additions to the file contributed by third parties # remain the property of their copyright owners, unless otherwise agreed @@ -18,15 +18,14 @@ %global pkg_name happstack-server-tls Name: ghc-%{pkg_name} -Version: 7.1.6.2 +Version: 7.1.6.3 Release: 0 Summary: Extend happstack-server with https:// support (TLS/SSL) License: BSD-3-Clause -Group: System/Libraries +Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… BuildRequires: ghc-Cabal-devel -# Begin cabal-rpm deps: BuildRequires: ghc-HsOpenSSL-devel BuildRequires: ghc-bytestring-devel BuildRequires: ghc-extensible-exceptions-devel @@ -39,7 +38,6 @@ BuildRequires: ghc-unix-devel BuildRequires: libopenssl-devel BuildRoot: %{_tmppath}/%{name}-%{version}-build -# End cabal-rpm deps %description Extend happstack-server with https:// support (TLS/SSL). @@ -49,11 +47,9 @@ Group: Development/Libraries/Other Requires: %{name} = %{version}-%{release} Requires: ghc-compiler = %{ghc_version} -# Begin cabal-rpm deps: Requires: libopenssl-devel Requires(post): ghc-compiler = %{ghc_version} Requires(postun): ghc-compiler = %{ghc_version} -# End cabal-rpm deps %description devel This package provides the Haskell %{pkg_name} library development @@ -62,15 +58,12 @@ %prep %setup -q -n %{pkg_name}-%{version} - %build %ghc_lib_build - %install %ghc_lib_install - %post devel %ghc_pkg_recache ++++++ happstack-server-tls-7.1.6.2.tar.gz -> happstack-server-tls-7.1.6.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/happstack-server-tls-7.1.6.2/happstack-server-tls.cabal new/happstack-server-tls-7.1.6.3/happstack-server-tls.cabal --- old/happstack-server-tls-7.1.6.2/happstack-server-tls.cabal 2016-06-05 23:03:09.000000000 +0200 +++ new/happstack-server-tls-7.1.6.3/happstack-server-tls.cabal 2017-07-21 20:14:51.000000000 +0200 @@ -1,5 +1,5 @@ Name: happstack-server-tls -Version: 7.1.6.2 +Version: 7.1.6.3 Synopsis: extend happstack-server with https:// support (TLS/SSL) Description: extend happstack-server with https:// support (TLS/SSL) Homepage: http://www.happstack.com/ @@ -10,7 +10,7 @@ Copyright: 2012 Jeremy Shaw Category: Web, Happstack Build-type: Simple -Cabal-version: >=1.6 +Cabal-version: >=1.10 tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 extra-source-files: README.md @@ -19,6 +19,7 @@ location: https://github.com/Happstack/happstack-server-tls.git Library + Default-language: Haskell2010 hs-source-dirs: src ghc-options: -Wall -fno-warn-unused-do-bind Exposed-modules: Happstack.Server.Internal.TimeoutSocketTLS @@ -28,7 +29,7 @@ Build-Depends: base < 5, bytestring >= 0.9 && < 0.11, extensible-exceptions == 0.1.*, - happstack-server >= 6.6.4 && < 7.5, + happstack-server >= 6.6.4 && < 7.6, hslogger >= 1.1 && < 1.3, HsOpenSSL >= 0.10 && < 0.12, network >= 2.3 && < 2.7,

1 0

commit ghc-happstack-jmacro for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-happstack-jmacro for openSUSE:Factory checked in at 2017-08-31 20:55:47 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-happstack-jmacro (Old) and /work/SRC/openSUSE:Factory/.ghc-happstack-jmacro.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-happstack-jmacro" Thu Aug 31 20:55:47 2017 rev:2 rq:513364 version:7.0.12 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-happstack-jmacro/ghc-happstack-jmacro.changes 2017-05-16 14:39:58.102856078 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-happstack-jmacro.new/ghc-happstack-jmacro.changes 2017-08-31 20:55:49.508797945 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:46 UTC 2017 - psimons(a)suse.com + +- Update to version 7.0.12. + +------------------------------------------------------------------- Old: ---- happstack-jmacro-7.0.11.tar.gz New: ---- happstack-jmacro-7.0.12.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-happstack-jmacro.spec ++++++ --- /var/tmp/diff_new_pack.rPgpcw/_old 2017-08-31 20:55:50.304686120 +0200 +++ /var/tmp/diff_new_pack.rPgpcw/_new 2017-08-31 20:55:50.312684996 +0200 @@ -18,7 +18,7 @@ %global pkg_name happstack-jmacro Name: ghc-%{pkg_name} -Version: 7.0.11 +Version: 7.0.12 Release: 0 Summary: Support for using JMacro with Happstack License: BSD-3-Clause ++++++ happstack-jmacro-7.0.11.tar.gz -> happstack-jmacro-7.0.12.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/happstack-jmacro-7.0.11/happstack-jmacro.cabal new/happstack-jmacro-7.0.12/happstack-jmacro.cabal --- old/happstack-jmacro-7.0.11/happstack-jmacro.cabal 2015-12-01 00:28:14.000000000 +0100 +++ new/happstack-jmacro-7.0.12/happstack-jmacro.cabal 2017-07-21 20:01:40.000000000 +0200 @@ -1,6 +1,7 @@ Name: happstack-jmacro -Version: 7.0.11 +Version: 7.0.12 Synopsis: Support for using JMacro with Happstack +Description: Support for using JMacro with Happstack Homepage: http://www.happstack.com/ License: BSD3 License-file: LICENSE @@ -11,6 +12,7 @@ Category: Web, Happstack Build-type: Simple Cabal-version: >=1.6 +tested-with: GHC == 7.6.3, GHC == 7.8.4, GHC == 7.10.3, GHC == 8.0.1 Library Exposed-modules: Happstack.Server.JMacro @@ -20,7 +22,7 @@ bytestring >= 0.9 && < 0.11, cereal >= 0.3 && < 0.6, digest == 0.0.*, - happstack-server >= 6.4 && < 7.5, + happstack-server >= 6.4 && < 7.6, jmacro == 0.6.*, wl-pprint-text == 1.1.*, text >= 0.9 && < 1.3,

1 0

commit ghc-happstack-hsp for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-happstack-hsp for openSUSE:Factory checked in at 2017-08-31 20:55:45 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-happstack-hsp (Old) and /work/SRC/openSUSE:Factory/.ghc-happstack-hsp.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-happstack-hsp" Thu Aug 31 20:55:45 2017 rev:2 rq:513363 version:7.3.7.3 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-happstack-hsp/ghc-happstack-hsp.changes 2017-05-16 14:39:55.535216834 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-happstack-hsp.new/ghc-happstack-hsp.changes 2017-08-31 20:55:47.689053625 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:04:31 UTC 2017 - psimons(a)suse.com + +- Update to version 7.3.7.3. + +------------------------------------------------------------------- Old: ---- happstack-hsp-7.3.7.2.tar.gz New: ---- happstack-hsp-7.3.7.3.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-happstack-hsp.spec ++++++ --- /var/tmp/diff_new_pack.224jjU/_old 2017-08-31 20:55:48.872887292 +0200 +++ /var/tmp/diff_new_pack.224jjU/_new 2017-08-31 20:55:48.892884482 +0200 @@ -18,7 +18,7 @@ %global pkg_name happstack-hsp Name: ghc-%{pkg_name} -Version: 7.3.7.2 +Version: 7.3.7.3 Release: 0 Summary: Support for using HSP templates in Happstack License: BSD-3-Clause ++++++ happstack-hsp-7.3.7.2.tar.gz -> happstack-hsp-7.3.7.3.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/happstack-hsp-7.3.7.2/happstack-hsp.cabal new/happstack-hsp-7.3.7.3/happstack-hsp.cabal --- old/happstack-hsp-7.3.7.2/happstack-hsp.cabal 2017-03-08 23:00:18.000000000 +0100 +++ new/happstack-hsp-7.3.7.3/happstack-hsp.cabal 2017-07-21 20:03:23.000000000 +0200 @@ -1,5 +1,5 @@ Name: happstack-hsp -Version: 7.3.7.2 +Version: 7.3.7.3 Synopsis: Support for using HSP templates in Happstack Description: Happstack is a web application framework. HSP is an XML templating solution. This package makes it easy to use HSP templates with Happstack. Homepage: http://www.happstack.com/ @@ -27,7 +27,7 @@ Build-depends: base >= 3.0 && < 5.0, bytestring >= 0.9 && < 0.11, - happstack-server >= 6.0 && < 7.5, + happstack-server >= 6.0 && < 7.6, harp >= 0.4 && < 0.5, hsp >= 0.9.2 && < 0.11, hsx2hs >= 0.13.0 && < 0.15,

1 0

commit ghc-hakyll for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-hakyll for openSUSE:Factory checked in at 2017-08-31 20:55:42 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hakyll (Old) and /work/SRC/openSUSE:Factory/.ghc-hakyll.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hakyll" Thu Aug 31 20:55:42 2017 rev:3 rq:513361 version:4.9.8.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hakyll/ghc-hakyll.changes 2017-06-21 13:55:28.733866007 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hakyll.new/ghc-hakyll.changes 2017-08-31 20:55:45.349382357 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:38 UTC 2017 - psimons(a)suse.com + +- Update to version 4.9.8.0. + +------------------------------------------------------------------- Old: ---- hakyll-4.9.7.0.tar.gz New: ---- hakyll-4.9.8.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hakyll.spec ++++++ --- /var/tmp/diff_new_pack.TPUyFx/_old 2017-08-31 20:55:46.553213214 +0200 +++ /var/tmp/diff_new_pack.TPUyFx/_new 2017-08-31 20:55:46.557212653 +0200 @@ -20,13 +20,14 @@ %global pkg_name hakyll %bcond_with tests Name: ghc-%{pkg_name} -Version: 4.9.7.0 +Version: 4.9.8.0 Release: 0 Summary: A static website compiler library License: BSD-3-Clause Group: Development/Languages/Other Url: https://hackage.haskell.org/package/%{pkg_name} Source0: https://hackage.haskell.org/package/%{pkg_name}-%{version}/%{pkg_name}-%{ve… +BuildRequires: chrpath BuildRequires: ghc-Cabal-devel BuildRequires: ghc-binary-devel BuildRequires: ghc-blaze-html-devel @@ -111,6 +112,7 @@ %install %ghc_lib_install +%ghc_fix_rpath %{pkg_name}-%{version} %check %cabal_test ++++++ hakyll-4.9.7.0.tar.gz -> hakyll-4.9.8.0.tar.gz ++++++ ++++ 14848 lines of diff (skipped)

1 0

commit ghc-hackernews for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-hackernews for openSUSE:Factory checked in at 2017-08-31 20:55:37 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-hackernews (Old) and /work/SRC/openSUSE:Factory/.ghc-hackernews.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-hackernews" Thu Aug 31 20:55:37 2017 rev:4 rq:513360 version:1.2.0.0 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-hackernews/ghc-hackernews.changes 2017-07-11 08:25:31.394173810 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-hackernews.new/ghc-hackernews.changes 2017-08-31 20:55:42.329806618 +0200 @@ -1,0 +2,5 @@ +Thu Jul 27 14:07:11 UTC 2017 - psimons(a)suse.com + +- Update to version 1.2.0.0. + +------------------------------------------------------------------- Old: ---- hackernews-1.1.2.0.tar.gz New: ---- hackernews-1.2.0.0.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-hackernews.spec ++++++ --- /var/tmp/diff_new_pack.j2qFPq/_old 2017-08-31 20:55:44.717471143 +0200 +++ /var/tmp/diff_new_pack.j2qFPq/_new 2017-08-31 20:55:44.721470581 +0200 @@ -19,7 +19,7 @@ %global pkg_name hackernews %bcond_with tests Name: ghc-%{pkg_name} -Version: 1.1.2.0 +Version: 1.2.0.0 Release: 0 Summary: API for Hacker News License: MIT ++++++ hackernews-1.1.2.0.tar.gz -> hackernews-1.2.0.0.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hackernews-1.1.2.0/ghc-src/Web/HackerNews.hs new/hackernews-1.2.0.0/ghc-src/Web/HackerNews.hs --- old/hackernews-1.1.2.0/ghc-src/Web/HackerNews.hs 2017-05-25 07:43:53.000000000 +0200 +++ new/hackernews-1.2.0.0/ghc-src/Web/HackerNews.hs 2017-06-01 22:26:38.000000000 +0200 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE TypeFamilies #-} @@ -118,7 +119,11 @@ toError = first go where go :: ServantError -> HackerNewsError +#if MIN_VERSION_servant_client(0,11,0) + go (FailureResponse _ Status{..} _ body) = +#else go (FailureResponse Status{..} _ body) = +#endif FailureResponseError statusCode (cs statusMessage) (cs body) go (DecodeFailure _ _ "null") = NotFound go (DecodeFailure err _ body) = diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/hackernews-1.1.2.0/hackernews.cabal new/hackernews-1.2.0.0/hackernews.cabal --- old/hackernews-1.1.2.0/hackernews.cabal 2017-05-25 07:43:53.000000000 +0200 +++ new/hackernews-1.2.0.0/hackernews.cabal 2017-06-01 22:26:38.000000000 +0200 @@ -1,5 +1,5 @@ name: hackernews -version: 1.1.2.0 +version: 1.2.0.0 description: API for news.ycombinator.com license: MIT synopsis: API for Hacker News @@ -23,13 +23,13 @@ if impl (ghcjs) build-depends: base - , hackernews == 1.1.* + , hackernews == 1.2.* , ghcjs-base hs-source-dirs: ghcjs-examples else build-depends: base - , hackernews == 1.1.* + , hackernews == 1.2.* , http-client-tls , http-client hs-source-dirs: ghc-examples @@ -39,7 +39,7 @@ if impl(ghcjs) hs-source-dirs: ghcjs-tests build-depends: base - , hackernews == 1.1.* + , hackernews == 1.2.* , ghcjs-base , hspec , hspec-core @@ -55,7 +55,7 @@ , Web.HackerNews.Types hs-source-dirs: src build-depends: - servant >= 0.9 && < 0.11 + servant >= 0.9 && < 0.12 , QuickCheck , quickcheck-instances if impl(ghcjs) @@ -72,7 +72,7 @@ hs-source-dirs: ghc-src build-depends: aeson , base < 5 - , servant-client >= 0.9 && < 0.11 + , servant-client >= 0.9 && < 0.12 , http-client == 0.5.* , string-conversions == 0.4.* , http-types == 0.9.* @@ -89,7 +89,7 @@ hs-source-dirs: ghc-tests build-depends: aeson , base - , hackernews == 1.1.* + , hackernews == 1.2.* , hspec , http-client-tls , http-client

1 0

commit ghc-google-translate for openSUSE:Factory
by root＠hilbert.suse.de 31 Aug '17

31 Aug '17

Hello community, here is the log from the commit of package ghc-google-translate for openSUSE:Factory checked in at 2017-08-31 20:55:35 ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Comparing /work/SRC/openSUSE:Factory/ghc-google-translate (Old) and /work/SRC/openSUSE:Factory/.ghc-google-translate.new (New) ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Package is "ghc-google-translate" Thu Aug 31 20:55:35 2017 rev:2 rq:513359 version:0.4.1 Changes: -------- --- /work/SRC/openSUSE:Factory/ghc-google-translate/ghc-google-translate.changes 2017-05-10 20:54:44.435092006 +0200 +++ /work/SRC/openSUSE:Factory/.ghc-google-translate.new/ghc-google-translate.changes 2017-08-31 20:55:36.722594451 +0200 @@ -1,0 +2,10 @@ +Sat Jul 29 03:02:12 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4.1. + +------------------------------------------------------------------- +Fri Jul 28 09:43:11 UTC 2017 - psimons(a)suse.com + +- Update to version 0.4. + +------------------------------------------------------------------- Old: ---- google-translate-0.3.tar.gz New: ---- google-translate-0.4.1.tar.gz ++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++++ Other differences: ------------------ ++++++ ghc-google-translate.spec ++++++ --- /var/tmp/diff_new_pack.GUE68h/_old 2017-08-31 20:55:37.838437671 +0200 +++ /var/tmp/diff_new_pack.GUE68h/_new 2017-08-31 20:55:37.842437109 +0200 @@ -18,7 +18,7 @@ %global pkg_name google-translate Name: ghc-%{pkg_name} -Version: 0.3 +Version: 0.4.1 Release: 0 Summary: Google Translate API bindings License: BSD-2-Clause ++++++ google-translate-0.3.tar.gz -> google-translate-0.4.1.tar.gz ++++++ diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/google-translate-0.3/google-translate.cabal new/google-translate-0.4.1/google-translate.cabal --- old/google-translate-0.3/google-translate.cabal 2016-10-18 22:04:59.000000000 +0200 +++ new/google-translate-0.4.1/google-translate.cabal 2017-07-29 03:33:36.000000000 +0200 @@ -1,5 +1,5 @@ name: google-translate -version: 0.3 +version: 0.4.1 synopsis: Google Translate API bindings license: BSD3 license-file: LICENSE @@ -16,7 +16,7 @@ library exposed-modules: Web.Google.Translate - ghc-options: -Wall + ghc-options: -Wall hs-source-dirs: src build-depends: aeson , base >= 4.7 && < 5 @@ -24,8 +24,8 @@ , transformers >= 0.4 && < 0.6 , http-api-data >= 0.2 && < 0.4 , http-client >= 0.4 && < 0.6 - , servant >= 0.7 && < 0.10 - , servant-client >= 0.7 && < 0.10 + , servant >= 0.7 && < 0.12 + , servant-client >= 0.7 && < 0.12 , text == 1.2.* default-language: Haskell2010 diff -urN '--exclude=CVS' '--exclude=.cvsignore' '--exclude=.svn' '--exclude=.svnignore' old/google-translate-0.3/src/Web/Google/Translate.hs new/google-translate-0.4.1/src/Web/Google/Translate.hs --- old/google-translate-0.3/src/Web/Google/Translate.hs 2016-10-18 22:04:59.000000000 +0200 +++ new/google-translate-0.4.1/src/Web/Google/Translate.hs 2017-07-29 03:33:36.000000000 +0200 @@ -41,11 +41,10 @@ , Language (..) ) where ------------------------------------------------------------------------------ -import Control.Monad.Trans.Except import Data.Aeson import Data.Proxy -import Data.Text (Text) -import qualified Data.Text as T +import Data.Text (Text) +import qualified Data.Text as T import GHC.Generics import Network.HTTP.Client (Manager) import Servant.API @@ -161,6 +160,7 @@ :> QueryParam "target" Target :> Get '[JSON] LanguageResponse ------------------------------------------------------------------------------ +-- | API type api :: Proxy GoogleTranslateAPI api = Proxy ------------------------------------------------------------------------------

1 0