module-management 0.10.1 → 0.11
raw patch · 17 files changed
+226/−289 lines, 17 filesPVP ok
version bump matches the API change (PVP)
API changes (from Hackage documentation)
+ Language.Haskell.Modules: splitModuleDecls :: MonadClean m => ModuleName -> m ()
+ Language.Haskell.Modules.Split: Exported :: Name -> DeclName
+ Language.Haskell.Modules.Split: Instance :: DeclName
+ Language.Haskell.Modules.Split: Internal :: Name -> DeclName
+ Language.Haskell.Modules.Split: ReExported :: Name -> DeclName
+ Language.Haskell.Modules.Split: data DeclName
+ Language.Haskell.Modules.Split: splitModuleDecls :: MonadClean m => ModuleName -> m ()
- Language.Haskell.Modules: splitModule :: MonadClean m => ModuleName -> m ()
+ Language.Haskell.Modules: splitModule :: MonadClean m => (DeclName -> ModuleName) -> ModuleName -> m ()
- Language.Haskell.Modules.Split: splitModule :: MonadClean m => ModuleName -> m ()
+ Language.Haskell.Modules.Split: splitModule :: MonadClean m => (DeclName -> ModuleName) -> ModuleName -> m ()
Files
- Language/Haskell/Modules.hs +15/−11
- Language/Haskell/Modules/Fold.hs +1/−9
- Language/Haskell/Modules/Imports.hs +4/−8
- Language/Haskell/Modules/Internal.hs +11/−2
- Language/Haskell/Modules/Merge.hs +2/−7
- Language/Haskell/Modules/Params.hs +1/−1
- Language/Haskell/Modules/Split.hs +132/−144
- Language/Haskell/Modules/Util/SrcLoc.hs +1/−1
- Tests.hs +13/−13
- Tests/Fold.hs +4/−16
- Tests/Imports.hs +5/−25
- Tests/Merge.hs +3/−21
- Tests/Split.hs +23/−28
- debian/changelog +8/−0
- module-management.cabal +1/−1
- scripts/CLI.hs +2/−2
- testdata.tar.gz binary
Language/Haskell/Modules.hs view
@@ -2,23 +2,27 @@ -- function uses ghc's -ddump-minimal-imports flag to generate -- minimized and explicit imports and re-insert them into the module. ----- The 'splitModule' moves each declaration of a module into a--- separate new module, and may also create three additional modules:--- ReExported (for identifiers that were re-exported from other--- imports), Instances (for declarations that don't result in an+-- The 'splitModuleDecls' function moves each declaration of a module+-- into a separate new module, and may also create three additional+-- modules: ReExported (for identifiers that were re-exported from+-- other imports), Instances (for declarations that don't result in an -- identifier to export), and OtherSymbols (for declarations that -- can't be turned into a module name.) ----- In addition to creating new modules, 'splitModule' also scans the+-- In addition to creating new modules, 'splitModuleDecls' also scans the -- a set of modules (known as the moduVerse) and updates their imports -- to account for the new locations of the symbols. The moduVerse is -- stored in MonadClean's state, and is updated as modules are created -- and destroyed by 'splitModule' and 'catModules'. ----- The 'catModules' function is the inverse operation of 'splitModule',--- it merges two or more modules into a new or existing module, updating--- imports of the moduVerse elements as necessary.+-- The 'splitModule' function is a version of 'splitModuleDecls' that+-- allows the caller to customize the mapping from symbols to new+-- modules. --+-- The 'mergeModules' function is the inverse operation of+-- 'splitModule', it merges two or more modules into a new or existing+-- module, updating imports of the moduVerse elements as necessary.+-- -- There are several features worth noting. The 'Params' type in the -- state of 'MonadClean' has a 'removeEmptyImports' field, which is -- True by default. This determines whether imports that turn into@@ -58,6 +62,7 @@ module Language.Haskell.Modules ( cleanImports , splitModule+ , splitModuleDecls , mergeModules , module Language.Haskell.Modules.Params , module Language.Haskell.Modules.Fold@@ -69,8 +74,7 @@ import Language.Haskell.Modules.Fold (echo, echo2, foldDecls, foldExports, foldHeader, foldImports, foldModule, ignore, ignore2) import Language.Haskell.Modules.Imports (cleanImports) import Language.Haskell.Modules.Merge (mergeModules)-import Language.Haskell.Modules.Params (runMonadClean, modifyDryRun, modifyExtensions, modifyHsFlags, modifyModuVerse,- modifyRemoveEmptyImports, modifySourceDirs, modifyTestMode)-import Language.Haskell.Modules.Split (splitModule)+import Language.Haskell.Modules.Params (modifyDryRun, modifyExtensions, modifyHsFlags, modifyModuVerse, modifyRemoveEmptyImports, modifySourceDirs, modifyTestMode, runMonadClean)+import Language.Haskell.Modules.Split (splitModule, splitModuleDecls) import Language.Haskell.Modules.Util.QIO (noisily, quietly) import Language.Haskell.Modules.Util.Test (findModules, findPaths)
Language/Haskell/Modules/Fold.hs view
@@ -18,25 +18,17 @@ import Control.Applicative ((<$>)) import Control.Monad (when) import Control.Monad.State (get, put, runState, State)-import Control.Monad.Trans (liftIO) import Data.Char (isSpace) import Data.Default (Default(def)) import Data.List (tails) import Data.Map (Map)-import Data.Maybe (mapMaybe) import Data.Monoid ((<>), Monoid) import Data.Sequence (Seq, (|>))-import Data.Set.Extra as Set (fromList)-import Data.Tree (Tree(..))-import Language.Haskell.Exts.Annotated (ParseResult(..)) import qualified Language.Haskell.Exts.Annotated.Syntax as A (Decl, ExportSpec, ExportSpec(..), ExportSpecList(ExportSpecList), ImportDecl, Module(..), ModuleHead(..), ModuleName, ModulePragma, WarningText) import Language.Haskell.Exts.Comments (Comment(..)) import Language.Haskell.Exts.SrcLoc (SrcLoc(..), SrcSpan(..), SrcSpanInfo(..)) import qualified Language.Haskell.Exts.Syntax as S (ModuleName)-import Language.Haskell.Modules.Common (withCurrentDirectory)-import Language.Haskell.Modules.Internal (parseFileWithComments, runMonadClean)-import Language.Haskell.Modules.Util.SrcLoc (endLoc, HasSpanInfo(..), increaseSrcLoc, makeTree, srcLoc, srcPairText, srcPairText)-import Test.HUnit (assertEqual, Test(TestList, TestCase, TestLabel))+import Language.Haskell.Modules.Util.SrcLoc (endLoc, HasSpanInfo(..), increaseSrcLoc, srcLoc, srcPairText) type Module = A.Module SrcSpanInfo --type ModuleHead = A.ModuleHead SrcSpanInfo
Language/Haskell/Modules/Imports.hs view
@@ -19,23 +19,19 @@ import Language.Haskell.Exts.Annotated (ParseResult(..)) import Language.Haskell.Exts.Annotated.Simplify as S (sImportDecl, sImportSpec, sModuleName, sName) import qualified Language.Haskell.Exts.Annotated.Syntax as A (Decl(DerivDecl), ImportDecl(..), ImportSpec(..), ImportSpecList(ImportSpecList), InstHead(..), Module(..), ModuleHead(ModuleHead), ModuleName(ModuleName), QName(..), Type(..))-import Language.Haskell.Exts.Extension (Extension(PackageImports, StandaloneDeriving, TypeSynonymInstances, FlexibleInstances))+import Language.Haskell.Exts.Extension (Extension(PackageImports)) import Language.Haskell.Exts.Pretty (defaultMode, PPHsMode(layout), PPLayout(PPInLine), prettyPrintWithMode) import Language.Haskell.Exts.SrcLoc (SrcSpanInfo) import qualified Language.Haskell.Exts.Syntax as S (ImportDecl(importLoc, importModule, importSpecs), ModuleName(..), Name(..))-import Language.Haskell.Modules.Common (modulePathBase, withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, foldDecls, foldExports, foldHeader, foldImports)-import Language.Haskell.Modules.Internal (getParams, markForDelete, modifyParams, ModuleResult(..), MonadClean, Params(..), parseFile, parseFileWithComments, runMonadClean, scratchDir)-import Language.Haskell.Modules.Params (modifyTestMode)+import Language.Haskell.Modules.Fold (foldDecls, foldExports, foldHeader, foldImports, ModuleInfo)+import Language.Haskell.Modules.Internal (markForDelete, modifyParams, ModuleResult(Modified, Unchanged), MonadClean(getParams), Params(extensions, hsFlags, removeEmptyImports, scratchDir, sourceDirs), parseFile, parseFileWithComments) import Language.Haskell.Modules.Util.DryIO (replaceFile, tildeBackup) import Language.Haskell.Modules.Util.QIO (qLnPutStr, quietly) import Language.Haskell.Modules.Util.Symbols (symbols)-import System.Cmd (system) import System.Directory (createDirectoryIfMissing, getCurrentDirectory) import System.Exit (ExitCode(..))-import System.FilePath ((<.>), (</>))+import System.FilePath ((<.>)) import System.Process (readProcessWithExitCode, showCommandForUser)-import Test.HUnit (assertEqual, Test(..)) {- -- | This is designed to be called from the postConf script of your
Language/Haskell/Modules/Internal.hs view
@@ -18,7 +18,8 @@ import "MonadCatchIO-mtl" Control.Monad.CatchIO as IO (catch, MonadCatchIO, throw) import Control.Monad.State (MonadState(get, put), StateT(runStateT)) import Control.Monad.Trans (liftIO, MonadIO)-import Data.Set (empty, insert, Set, toList)+import Data.Maybe (fromMaybe)+import Data.Set as Set (delete, empty, insert, Set, toList) import qualified Language.Haskell.Exts.Annotated as A (Module, parseFileWithComments, parseFileWithMode) import Language.Haskell.Exts.Comments (Comment) import Language.Haskell.Exts.Extension (Extension)@@ -27,7 +28,7 @@ import qualified Language.Haskell.Exts.Syntax as S (ModuleName) import Language.Haskell.Modules.Common (modulePathBase) import Language.Haskell.Modules.Util.DryIO (createDirectoryIfMissing, MonadDryRun(..), removeFileIfPresent, replaceFile, tildeBackup)-import Language.Haskell.Modules.Util.QIO (MonadVerbosity(..), qPutStr, qLnPutStr, quietly)+import Language.Haskell.Modules.Util.QIO (MonadVerbosity(..), qLnPutStr, qPutStr, quietly) import Language.Haskell.Modules.Util.Temp (withTempDirectory) import Prelude hiding (writeFile) import System.Directory (doesFileExist, getCurrentDirectory, removeFile)@@ -171,6 +172,7 @@ do path <- modulePath name -- I think this event handler is redundant. removeFileIfPresent path `IO.catch` (\ (e :: IOError) -> if isDoesNotExistError e then return () else throw e)+ modifyModuVerse (Set.delete name) return x doResult x@(Modified name text) =@@ -186,4 +188,11 @@ (quietly . quietly . quietly . qPutStr $ " containing " ++ show text) createDirectoryIfMissing True (takeDirectory . dropExtension $ path) replaceFile tildeBackup path text+ modifyModuVerse (Set.insert name) return x++-- | Modify the set of modules whose imports will be updated when+-- modules are split or merged. No default, it is an error to run+-- splitModules or catModules without first setting this.+modifyModuVerse :: MonadClean m => (Set S.ModuleName -> Set S.ModuleName) -> m ()+modifyModuVerse f = modifyParams (\ p -> p {moduVerse = Just (f (fromMaybe empty (moduVerse p)))})
Language/Haskell/Modules/Merge.hs view
@@ -22,14 +22,9 @@ import Language.Haskell.Exts.Pretty (prettyPrint) import Language.Haskell.Exts.SrcLoc (SrcSpanInfo) import qualified Language.Haskell.Exts.Syntax as S (ExportSpec(EModuleContents), ImportDecl(..), ModuleName(..))-import Language.Haskell.Modules.Common (withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, echo, echo2, foldDecls, foldExports, foldHeader, foldImports, ignore, ignore2)+import Language.Haskell.Modules.Fold (echo, echo2, foldDecls, foldExports, foldHeader, foldImports, ignore, ignore2, ModuleInfo) import Language.Haskell.Modules.Imports (cleanImports)-import Language.Haskell.Modules.Internal (doResult, getParams, modifyParams, modulePath, ModuleResult(..), MonadClean, Params(sourceDirs, moduVerse, testMode), parseFileWithComments, runMonadClean)-import Language.Haskell.Modules.Util.Test (diff, repoModules)-import System.Cmd (system)-import System.Exit (ExitCode(ExitSuccess))-import Test.HUnit (assertEqual, Test(TestCase, TestList))+import Language.Haskell.Modules.Internal (doResult, modifyParams, modulePath, ModuleResult(Modified, Removed, Unchanged), MonadClean(getParams), Params(moduVerse, testMode), parseFileWithComments) -- | Merge the declarations from several modules into a single new -- one, updating the imports of the modules in the moduVerse to
Language/Haskell/Modules/Params.hs view
@@ -17,7 +17,7 @@ import Data.Set (empty, Set) import Language.Haskell.Exts.Extension (Extension) import qualified Language.Haskell.Exts.Syntax as S (ModuleName)-import Language.Haskell.Modules.Internal (MonadClean, modifyParams, Params(dryRun, extensions, hsFlags, moduVerse, removeEmptyImports, sourceDirs, testMode), runMonadClean)+import Language.Haskell.Modules.Internal (modifyParams, MonadClean, Params(dryRun, extensions, hsFlags, moduVerse, removeEmptyImports, sourceDirs, testMode), runMonadClean) import Prelude hiding (writeFile) -- | Modify the set of modules whose imports will be updated when
Language/Haskell/Modules/Split.hs view
@@ -1,7 +1,9 @@ {-# LANGUAGE ScopedTypeVariables, TupleSections #-} {-# OPTIONS_GHC -Wall #-} module Language.Haskell.Modules.Split- ( splitModule+ ( DeclName(..)+ , splitModule+ , splitModuleDecls ) where import Control.Exception (throw)@@ -11,10 +13,10 @@ import Data.Default (Default(def)) import Data.Foldable as Foldable (fold) import Data.List as List (filter, intercalate, map, nub)-import Data.Map as Map (delete, elems, empty, filter, insertWith, lookup, Map, mapWithKey)+import Data.Map as Map (delete, elems, empty, filter, insert, insertWith, lookup, Map, mapWithKey) import Data.Maybe (fromMaybe, mapMaybe) import Data.Monoid ((<>), mempty)-import Data.Sequence ((|>), (<|))+import Data.Sequence ((<|), (|>)) import Data.Set as Set (delete, difference, empty, filter, fold, insert, intersection, map, member, null, Set, singleton, toList, union, unions) import Data.Set.Extra as Set (gFind, mapM) import Language.Haskell.Exts (fromParseResult, ParseResult(ParseOk, ParseFailed))@@ -22,20 +24,14 @@ import Language.Haskell.Exts.Annotated.Simplify (sImportDecl, sImportSpec, sModuleName, sName) import Language.Haskell.Exts.Pretty (defaultMode, prettyPrint, prettyPrintWithMode) import Language.Haskell.Exts.SrcLoc (SrcSpanInfo(..))-import qualified Language.Haskell.Exts.Syntax as S (ImportDecl(..), ModuleName(..), Name(..))-import Language.Haskell.Modules.Common (withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, echo, echo2, foldDecls, foldExports, foldHeader, foldImports, foldModule, ignore, ignore2)+import qualified Language.Haskell.Exts.Syntax as S (ExportSpec, ImportDecl(..), ModuleName(..), Name(..))+import Language.Haskell.Modules.Fold (echo, echo2, foldDecls, foldExports, foldHeader, foldImports, foldModule, ignore, ignore2, ModuleInfo) import Language.Haskell.Modules.Imports (cleanImports)-import Language.Haskell.Modules.Internal (doResult, modifyParams, modulePath, ModuleResult(..), MonadClean(getParams), Params(moduVerse, sourceDirs, testMode), parseFileWithComments, runMonadClean)-import Language.Haskell.Modules.Params (modifyModuVerse)-import Language.Haskell.Modules.Util.QIO (quietly, qLnPutStr)+import Language.Haskell.Modules.Internal (doResult, modulePath, ModuleResult(..), MonadClean(getParams), Params(moduVerse, testMode), parseFileWithComments)+import Language.Haskell.Modules.Util.QIO (qLnPutStr, quietly) import Language.Haskell.Modules.Util.Symbols (exports, imports, symbols)-import Language.Haskell.Modules.Util.Test (diff, repoModules) import Prelude hiding (writeFile)-import System.Cmd (system)-import System.Exit (ExitCode(ExitSuccess, ExitFailure)) import System.FilePath ((<.>))-import Test.HUnit (assertEqual, Test(TestCase, TestList, TestLabel)) data DeclName = Exported S.Name -- Maybe because...?@@ -44,17 +40,25 @@ | Instance deriving (Eq, Ord, Show) -setAny :: Ord a => (a -> Bool) -> Set a -> Bool-setAny f s = not (Set.null (Set.filter f s))+isReExported :: DeclName -> Bool+isReExported (ReExported _) = True+isReExported _ = False -setMapMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b-setMapMaybe p s = Set.fold f Set.empty s- where f x s' = maybe s' (\ y -> Set.insert y s') (p x)+parseModule :: MonadClean m => S.ModuleName -> m ModuleInfo+parseModule name =+ do path <- modulePath name+ text <- liftIO $ readFile path+ (parsed, comments) <- parseFileWithComments path >>= return . fromParseResult+ return (parsed, text, comments) -setMapM_ :: (Monad m, Ord b) => (a -> m b) -> Set a -> m ()-setMapM_ f s = do _ <- Set.mapM f s- return ()+-- | Do splitModuleBy with a custom symbol to module mapping+splitModule :: MonadClean m => (DeclName -> S.ModuleName) -> S.ModuleName -> m ()+splitModule symbolToModule old = parseModule old >>= splitModuleBy symbolToModule old +-- | Do splitModuleBy with the default symbol to module mapping (was splitModule)+splitModuleDecls :: MonadClean m => S.ModuleName -> m ()+splitModuleDecls old = parseModule old >>= \ m -> splitModuleBy (defaultSymbolToModule old) old m+ -- | Split each of a module's declarations into a new module. Update -- the imports of all the modules in the moduVerse to reflect the split. -- For example, if you have a module like@@ -80,20 +84,15 @@ -- If we had imported and then re-exported a symbol in Start it would -- go into a module named @Start.ReExported@. Any instance declarations -- would go into @Start.Instances@.-splitModule :: MonadClean m => S.ModuleName -> m ()-splitModule old =- do univ <- getParams >>= return . fromMaybe (error "moduVerse not set, use modifyModuVerse") . moduVerse- path <- modulePath old- text <- liftIO $ readFile path- (parsed, comments) <- parseFileWithComments path >>= return . fromParseResult- newFiles <- doSplit univ (parsed, text, comments) >>= return . collisionCheck univ- -- Write the new modules- setMapM_ doResult newFiles- -- Clean the new modules- setMapM_ doClean newFiles- -- We have created some new modules, add them to the moduVerse- modifyParams (\ p -> p {moduVerse = Just (Set.delete old (union (created newFiles) univ))})+splitModuleBy :: MonadClean m => (DeclName -> S.ModuleName) -> S.ModuleName -> ModuleInfo -> m ()+splitModuleBy symbolToModule old m =+ do univ <- moduVerseCheck+ m <- parseModule old+ changes <- doSplit symbolToModule univ m >>= return . collisionCheck univ+ setMapM_ doResult changes -- Write the new modules+ setMapM_ doClean changes -- Clean the new modules after all edits are finished where+ moduVerseCheck = getParams >>= return . fromMaybe (error "moduVerse not set, use modifyModuVerse") . moduVerse collisionCheck univ s = if not (Set.null illegal) then error ("One or more module to be created by splitModule already exists: " ++ show (Set.toList illegal))@@ -112,50 +111,71 @@ do flag <- getParams >>= return . not . testMode when flag (modulePath m >>= cleanImports >> return ()) -justs :: Ord a => Set (Maybe a) -> Set a-justs = Set.fold (\ mx s -> maybe s (`Set.insert` s) mx) Set.empty+-- This returns a set of maybe because there may be instance+-- declarations, in which case we want an Instances module to+-- appear in newModuleNames below.+declared :: ModuleInfo -> Set (Maybe S.Name)+declared m = foldDecls (\ d _pref _s _suff r -> Set.union (symbols d) r) ignore2 m Set.empty +exported :: ModuleInfo -> Set (Maybe S.Name)+exported m =+ case hasExportList m of+ False -> declared m+ True -> union (foldExports ignore2 (\ e _pref _s _suff r -> Set.union (symbols e) r) ignore2 m Set.empty)+ -- Any instances declared are exported regardless of the export list+ (if member Nothing (declared m) then singleton Nothing else Set.empty)+ where+ hasExportList :: ModuleInfo -> Bool+ hasExportList m@(A.Module _ Nothing _ _ _, _, _) = False+ hasExportList m@(A.Module _ (Just (A.ModuleHead _ _ _ Nothing)) _ _ _, _, _) = False+ hasExportList _ = True++newModuleNames :: (DeclName -> S.ModuleName) -> S.ModuleName -> ModuleInfo -> Set S.ModuleName+newModuleNames symbolToModule old m =+ Set.map (symbolToModule . declName' m) (union (declared m) (exported m))++declName' :: ModuleInfo -> Maybe S.Name -> DeclName+declName' m =+ declName (reExported m) (internal m)+ where+ declName :: (S.Name -> Bool) -> (S.Name -> Bool) -> Maybe S.Name -> DeclName+ declName reExported internal name =+ case name of+ Nothing -> Instance+ Just name' ->+ if reExported name'+ then ReExported name'+ else if internal name'+ then Internal name'+ else Exported name'+ internal :: ModuleInfo -> S.Name -> Bool+ internal m name = member (Just name) (difference (declared m) (exported m))+ reExported :: ModuleInfo -> S.Name -> Bool+ reExported m name = member (Just name) (difference (exported m) (declared m))+ -- | Create the set of module results implied by the split - -- creations, removals, and modifications. This includes the changes -- to the imports in modules that imported the original module.-doSplit :: MonadClean m => Set S.ModuleName -> ModuleInfo -> m (Set ModuleResult)-doSplit _ (A.Module _ _ _ _ [], _, _) = return Set.empty -- No declarations - nothing to split-doSplit _ (A.Module _ _ _ _ [_], _, _) = return Set.empty -- One declaration - nothing to split (but maybe we should anyway?)-doSplit _ (A.Module _ Nothing _ _ _, _, _) = throw $ userError $ "splitModule: no explicit header"-doSplit univ m@(A.Module _ (Just (A.ModuleHead _ moduleName _ _)) _ _ _, _, _) =- qLnPutStr ("Splitting " ++ show moduleName) >>- Set.mapM (updateImports reExported internal (sModuleName moduleName) symbolToModule) univ' >>=- return . union splitModules+doSplit :: MonadClean m => (DeclName -> S.ModuleName) -> Set S.ModuleName -> ModuleInfo -> m (Set ModuleResult)+doSplit _ _ (A.Module _ _ _ _ [], _, _) = return Set.empty -- No declarations - nothing to split+doSplit _ _ (A.Module _ _ _ _ [_], _, _) = return Set.empty -- One declaration - nothing to split (but maybe we should anyway?)+doSplit _ _ (A.Module _ Nothing _ _ _, _, _) = throw $ userError $ "splitModule: no explicit header"+doSplit symbolToModule univ m@(A.Module _ (Just (A.ModuleHead _ moduleName _ _)) _ _ _, _, _) =+ do qLnPutStr ("Splitting " ++ show moduleName)+ updated <- Set.mapM (updateImports m (sModuleName moduleName) symbolToModule) (Set.delete old univ)+ let moduleNames = newModuleNames symbolToModule old m+ let split = union (Set.map newModule moduleNames)+ (if member old moduleNames then Set.empty else singleton (Removed old))+ return $ union split updated where- symbolToModule = defaultSymbolToModule m reExported internal old -- The name of the module to be split old = sModuleName moduleName - -- This returns a set of maybe because there may be instance- -- declarations, in which case we want an Instances module to- -- appear in newModuleNames below.- declared :: Set (Maybe S.Name)- declared = foldDecls (\ d _pref _s _suff r -> Set.union (symbols d) r) ignore2 m Set.empty-- exported :: Set S.Name- exported = foldExports ignore2 (\ e _pref _s _suff r -> Set.union (justs (symbols e)) r) ignore2 m Set.empty-- reExported :: Set S.Name- reExported = difference exported (justs declared)-- internal :: Set S.Name- internal = difference (justs declared) exported-- univ' = Set.delete old univ-- newModuleNames :: Set S.ModuleName- newModuleNames = Set.map (subModuleName reExported internal old) (union declared (Set.map Just exported))-- -- The modules created from 'old'- splitModules :: Set ModuleResult- splitModules =- union (Set.map newModule newModuleNames)- (if member old newModuleNames then Set.empty else singleton (Removed old))+ -- Build a map from module name to the list of declarations that+ -- will be in that module. All of these declarations used to be+ -- in moduleName.+ moduleDeclMap :: Map S.ModuleName [(A.Decl SrcSpanInfo, String)]+ moduleDeclMap = foldDecls (\ d pref s suff r -> Set.fold (\ sym mp -> insertWith (++) (symbolToModule (declName' m sym)) [(d, pref <> s <> suff)] mp) r (symbols d)) ignore2 m Map.empty -- Build a new module given its name and the list of -- declarations it should contain.@@ -168,7 +188,7 @@ Foldable.fold (foldHeader echo2 echo (\ _n pref _ suff r -> r |> pref <> modName <> suff) echo m mempty) <> Foldable.fold (foldExports echo2 ignore ignore2 m mempty) <> doSeps (Foldable.fold (foldExports ignore2- (\ e pref s suff r -> if setAny (`member` reExported) (justs (symbols e)) then r |> [(pref, s <> suff)] else r)+ (\ e pref s suff r -> if setAny isReExported (Set.map (declName' m) (symbols e)) then r |> [(pref, s <> suff)] else r) (\ s r -> r |> [("", s)]) m mempty)) <> Foldable.fold (foldImports (\ _i pref s suff r -> r |> pref <> s <> suff) m mempty) Just modDecls ->@@ -189,8 +209,10 @@ concatMap snd (reverse modDecls) where -- Build export specs of the symbols created by each declaration.+ newExports :: [(A.Decl SrcSpanInfo, String)] -> [S.ExportSpec] newExports modDecls = nub (concatMap (exports . fst) modDecls)- -- newImports :: Map ModuleName ImportDecl++ newImports :: [(A.Decl SrcSpanInfo, String)] -> Map S.ModuleName S.ImportDecl newImports modDecls = mapWithKey toImportDecl (Map.delete name' (Map.filter (\ pairs ->@@ -198,22 +220,17 @@ not (Set.null (Set.intersection declared (referenced modDecls)))) moduleDeclMap)) -- In this module, we need to import any module that declares a symbol -- referenced here.+ referenced :: [(A.Decl SrcSpanInfo, String)] -> Set S.Name referenced modDecls = Set.map sName (gFind modDecls :: Set (A.Name SrcSpanInfo)) - -- Build a map from module name to the list of declarations that- -- will be in that module. All of these declarations used to be- -- in moduleName.- moduleDeclMap :: Map S.ModuleName [(A.Decl SrcSpanInfo, String)]- moduleDeclMap = foldDecls (\ d pref s suff r -> Set.fold (\ sym mp -> insertWith (++) (subModuleName reExported internal old sym) [(d, pref <> s <> suff)] mp) r (symbols d)) ignore2 m Map.empty- -- Re-construct a separated list doSeps :: [(String, String)] -> String doSeps [] = "" doSeps ((_, hd) : tl) = hd <> concatMap (\ (a, b) -> a <> b) tl -- | Update the imports to reflect the changed module names in symbolToModule.-updateImports :: MonadClean m => Set S.Name -> Set S.Name -> S.ModuleName -> Map DeclName S.ModuleName -> S.ModuleName -> m ModuleResult-updateImports reExported internal old symbolToModule name =+updateImports :: MonadClean m => ModuleInfo -> S.ModuleName -> (DeclName -> S.ModuleName) -> S.ModuleName -> m ModuleResult+updateImports m old symbolToModule name = do path <- modulePath name quietly $ qLnPutStr $ "updateImports " ++ show name text' <- liftIO $ readFile path@@ -234,84 +251,41 @@ updateImportSpecs :: A.ImportDecl SrcSpanInfo -> Maybe (A.ImportSpecList SrcSpanInfo) -> [S.ImportDecl] -- No spec list, import all the split modules- updateImportSpecs i Nothing = List.map (\ x -> (sImportDecl i) {S.importModule = x}) (Map.elems symbolToModule)+ updateImportSpecs i Nothing = List.map (\ x -> (sImportDecl i) {S.importModule = x}) (Map.elems moduleMap) -- If flag is True this is a "hiding" import updateImportSpecs i (Just (A.ImportSpecList _ flag specs)) =- concatMap (\ spec -> let xs = mapMaybe (\ sym -> Map.lookup (declName reExported internal sym) symbolToModule) (toList (symbols spec)) in+ concatMap (\ spec -> let xs = mapMaybe (\ sym -> Map.lookup (declName' m sym) moduleMap) (toList (symbols spec)) in List.map (\ x -> (sImportDecl i) {S.importModule = x, S.importSpecs = Just (flag, [sImportSpec spec])}) xs) specs -{--splitModule' :: S.ModuleName -> ParseResult (A.Module SrcSpanInfo) -> String -> Map S.ModuleName String-splitModule' _ (ParseOk (A.Module _ _ _ _ [])) _ = empty -- No declarations - nothing to split-splitModule' _ (ParseOk (A.Module _ _ _ _ [_])) _ = empty -- One declaration - nothing to split-splitModule' (S.ModuleName s) (ParseFailed _ _) _ = throw $ userError $ "Parse of " ++ s ++ " failed"-splitModule' (S.ModuleName s) (ParseOk (A.Module _ Nothing _ _ _)) _ = throw $ userError $ "splitModule: " ++ s ++ " has no explicit header"-splitModule' (S.ModuleName s) (ParseOk (A.Module _ (Just (A.ModuleHead _ _ _ Nothing)) _ _ _)) _ = throw $ userError $ "splitModule: " ++ s ++ " has no explicit export list"-splitModule' _ (ParseOk (m@(A.Module _ (Just (A.ModuleHead _ moduleName _ (Just _))) _ _ _))) text =- {- Map.insert name newReExporter $ -} newModules- where- -- Build a map from module name to the list of declarations that will be in that module.- moduleToDecls :: Map S.ModuleName [(A.Decl SrcSpanInfo, String)]- moduleToDecls = foldDecls (\ d pref s suff r -> foldr (\ sym mp -> insertWith (++) (subModuleName old sym) [(d, pref <> s <> suff)] mp) r (symbols d))- ignore2 m text Map.empty-- -- Build the new modules- newModules :: Map S.ModuleName String- newModules = mapWithKey newModule moduleToDecls-{- newReExporter =- foldHeader echo2 echo echo echo m text "" <>- foldExports echo2 echo echo2 m text ""- fromMaybe "" (foldImports (\ _i pref s suff r -> maybe (Just (pref <> s <> suff)) (Just . (<> (pref <> s <> suff))) r) m text Nothing) <>- "\n" <>- unlines (List.map (prettyPrintWithMode defaultMode) (elems (mapWithKey toImportDecl moduleToDecls))) -}-splitModule' _ _ _ = error "splitModule'"--}+ moduleMap = symbolToModuleMap symbolToModule m --- | Map from symbol name to the module that symbol will move to-defaultSymbolToModule :: ModuleInfo -> Set S.Name -> Set S.Name -> S.ModuleName -> Map DeclName S.ModuleName-defaultSymbolToModule m reExported internal old =+symbolToModuleMap :: (DeclName -> S.ModuleName) -> ModuleInfo -> Map DeclName S.ModuleName+symbolToModuleMap symbolToModule m = mp' where mp' = foldExports ignore2 (\ e _ _ _ r -> Set.fold f r (symbols e)) ignore2 m mp mp = foldDecls (\ d _ _ _ r -> Set.fold f r (symbols d)) ignore2 m Map.empty f sym mp'' =- Map.insertWith- (\ a b -> if a /= b then error ("symbolToModule - two modules for " ++ show sym ++ ": " ++ show (a, b)) else a)- (declName reExported internal sym)- (subModuleName reExported internal old sym)+ Map.insert+ (declName' m sym)+ (symbolToModule (declName' m sym)) mp'' -- | What module should this symbol be moved to?-subModuleName :: Set S.Name -> Set S.Name -> S.ModuleName -> Maybe S.Name -> S.ModuleName-subModuleName reExported internal (S.ModuleName moduleName) name =- S.ModuleName (moduleName <.> f (case name of- Nothing -> "Instances"- Just (S.Symbol s) -> s- Just (S.Ident s) -> s))+defaultSymbolToModule :: S.ModuleName -> DeclName -> S.ModuleName+defaultSymbolToModule (S.ModuleName parentModuleName) name =+ S.ModuleName (parentModuleName <.> case name of+ Instance -> "Instances"+ ReExported _ -> "ReExported"+ Internal x -> "Internal" <.> f x+ Exported x -> f x) where- f x =- case name of- Nothing -> "Instances"- Just name' | member name' reExported -> "ReExported"- Just name' ->- (if member name' internal then "Internal." else "") <>- case x of- -- Any symbol that starts with a letter is converted to a module name- -- by capitalizing and keeping the remaining alphaNum characters.- (c : s) | isAlpha c -> toUpper c : List.filter isAlphaNum s- _ -> "OtherSymbols"--declName :: Set S.Name -> Set S.Name -> Maybe S.Name -> DeclName-declName reExported internal name =- case name of- Nothing -> Instance- Just name' ->- if member name' reExported- then ReExported name'- else if member name' internal- then Internal name'- else Exported name'-+ f (S.Symbol s) = g s+ f (S.Ident s) = g s+ -- Any symbol that starts with a letter is converted to a module name+ -- by capitalizing and keeping the remaining alphaNum characters.+ g (c : s) | isAlpha c = toUpper c : List.filter isAlphaNum s+ g _ = "OtherSymbols" -- | Build an import of the symbols created by a declaration. toImportDecl :: S.ModuleName -> [(A.Decl SrcSpanInfo, String)] -> S.ImportDecl@@ -323,3 +297,17 @@ S.importPkg = Nothing, S.importAs = Nothing, S.importSpecs = Just (False, nub (concatMap (imports . fst) decls))}++justs :: Ord a => Set (Maybe a) -> Set a+justs = Set.fold (\ mx s -> maybe s (`Set.insert` s) mx) Set.empty++setAny :: Ord a => (a -> Bool) -> Set a -> Bool+setAny f s = not (Set.null (Set.filter f s))++setMapMaybe :: Ord b => (a -> Maybe b) -> Set a -> Set b+setMapMaybe p s = Set.fold f Set.empty s+ where f x s' = maybe s' (\ y -> Set.insert y s') (p x)++setMapM_ :: (Monad m, Ord b) => (a -> m b) -> Set a -> m ()+setMapM_ f s = do _ <- Set.mapM f s+ return ()
Language/Haskell/Modules/Util/SrcLoc.hs view
@@ -13,7 +13,7 @@ , tests ) where -import Control.Monad.State (State, runState, get, put)+import Control.Monad.State (get, put, runState, State) import Data.Default (def, Default) import Data.List (groupBy, partition, sort) import Data.Set (Set, toList)
Tests.hs view
@@ -3,25 +3,25 @@ import Control.Exception (SomeException, try) import Data.List (isPrefixOf)-import Data.Set as Set (Set, fromList, union, delete)+import Data.Set as Set (delete, fromList, Set, union) import Language.Haskell.Exts.Annotated (defaultParseMode, exactPrint, parseFileWithComments, ParseResult(ParseOk)) import Language.Haskell.Exts.Annotated.Syntax as A (Module) import Language.Haskell.Exts.Comments (Comment) import Language.Haskell.Exts.Extension (Extension(..))-import Language.Haskell.Exts.Syntax (ModuleName(ModuleName)) import Language.Haskell.Exts.SrcLoc (SrcSpanInfo)-import Language.Haskell.Modules (splitModule, mergeModules)-import qualified Tests.Merge as Merge (tests)+import Language.Haskell.Exts.Syntax (ModuleName(ModuleName))+import Language.Haskell.Modules (mergeModules, splitModuleDecls) import Language.Haskell.Modules.Common (withCurrentDirectory)-import qualified Tests.Fold as Fold (tests)-import qualified Tests.Imports as Imports (tests)-import Language.Haskell.Modules.Internal (MonadClean, Params(extensions, moduVerse), runMonadClean, modifyParams)-import qualified Tests.Split as Split (tests)+import Language.Haskell.Modules.Internal (modifyParams, MonadClean, Params(extensions, moduVerse), runMonadClean) import Language.Haskell.Modules.Util.QIO (noisily, qLnPutStr)-import Language.Haskell.Modules.Util.Test (logicModules, diff', rsync)+import Language.Haskell.Modules.Util.Test (diff', logicModules, rsync) import System.Exit (ExitCode(ExitSuccess, ExitFailure), exitWith)-import System.Process (system, readProcess)+import System.Process (system) import Test.HUnit (assertEqual, Counts(..), runTestTT, Test(TestList, TestCase, TestLabel))+import qualified Tests.Fold as Fold (tests)+import qualified Tests.Imports as Imports (tests)+import qualified Tests.Merge as Merge (tests)+import qualified Tests.Split as Split (tests) main :: IO () main =@@ -80,7 +80,7 @@ do modifyParams (\ p -> p {extensions = extensions p ++ [MultiParamTypeClasses], moduVerse = Just u}) qLnPutStr "Splitting module Literal"- splitModule (ModuleName "Data.Logic.Classes.Literal")+ splitModuleDecls (ModuleName "Data.Logic.Classes.Literal") return () test2b :: MonadClean m => Set ModuleName -> m ()@@ -88,7 +88,7 @@ do modifyParams (\ p -> p {extensions = extensions p ++ [MultiParamTypeClasses], moduVerse = Just u}) qLnPutStr "Splitting module Literal"- splitModule (ModuleName "Data.Logic.Classes.Literal")+ splitModuleDecls (ModuleName "Data.Logic.Classes.Literal") qLnPutStr "Merging FirstOrder, fromFirstOrder, fromLiteral into FirstOrder" -- modifyParams (\ p -> p {testMode = True}) mergeModules@@ -114,7 +114,7 @@ do modifyParams (\ p -> p {extensions = extensions p ++ [MultiParamTypeClasses], moduVerse = Just u}) qLnPutStr "Splitting module Literal"- splitModule (ModuleName "Data.Logic.Classes.Literal")+ splitModuleDecls (ModuleName "Data.Logic.Classes.Literal") qLnPutStr "Merging FirstOrder, fromFirstOrder, fromLiteral into FirstOrder" mergeModules [ModuleName "Data.Logic.Classes.FirstOrder",
Tests/Fold.hs view
@@ -1,29 +1,17 @@ module Tests.Fold where -import Control.Applicative ((<$>))-import Control.Monad (when)-import Control.Monad.State (get, put, runState, State) import Control.Monad.Trans (liftIO)-import Data.Char (isSpace)-import Data.Default (Default(def)) import Data.Foldable (fold)-import Data.List (tails)-import Data.Map (Map)-import Data.Maybe (mapMaybe)-import Data.Monoid (Monoid, (<>), mempty)-import Data.Sequence as Seq (Seq, (|>), (<|), fromList, filter, zip)+import Data.Monoid (Monoid(mempty))+import Data.Sequence as Seq (filter, fromList, Seq, zip, (|>)) import Data.Set.Extra as Set (fromList) import Data.Tree (Tree(..)) import Language.Haskell.Exts.Annotated (ParseResult(..))-import qualified Language.Haskell.Exts.Annotated.Syntax as A (Decl, ExportSpec, ExportSpec(..), ExportSpecList(ExportSpecList), ImportDecl, Module(..), ModuleHead(..), ModuleName, ModulePragma, WarningText)-import Language.Haskell.Exts.Comments (Comment(..)) import Language.Haskell.Exts.SrcLoc (SrcLoc(..), SrcSpan(..), SrcSpanInfo(..))-import qualified Language.Haskell.Exts.Syntax as S (ModuleName) import Language.Haskell.Modules.Common (withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, ModuleMap, foldModule, foldDecls, echo, echo2, ignore2)+import Language.Haskell.Modules.Fold (echo, echo2, foldDecls, foldModule, ModuleInfo) import Language.Haskell.Modules.Internal (parseFileWithComments, runMonadClean)-import Language.Haskell.Modules.Util.SrcLoc (endLoc, HasSpanInfo(..), increaseSrcLoc, makeTree, srcLoc, srcPairText, srcPairText)-import Language.Haskell.Modules.Util.Test (rsync)+import Language.Haskell.Modules.Util.SrcLoc (HasSpanInfo(..), makeTree) import Test.HUnit (assertEqual, Test(TestList, TestCase, TestLabel)) tests :: Test
Tests/Imports.hs view
@@ -1,36 +1,16 @@ {-# LANGUAGE PackageImports #-} module Tests.Imports where -import Control.Applicative ((<$>))-import "MonadCatchIO-mtl" Control.Monad.CatchIO as IO (bracket, catch, throw)-import Control.Monad.Trans (liftIO)-import Data.Char (toLower)-import Data.Default (def, Default)-import Data.Function (on)-import Data.List (find, groupBy, intercalate, nub, nubBy, sortBy)-import Data.Maybe (catMaybes, fromMaybe)-import Data.Monoid ((<>))-import Data.Set as Set (empty, member, Set, singleton, toList, union, unions)-import Language.Haskell.Exts.Annotated (ParseResult(..))-import Language.Haskell.Exts.Annotated.Simplify as S (sImportDecl, sImportSpec, sModuleName, sName)-import qualified Language.Haskell.Exts.Annotated.Syntax as A (Decl(DerivDecl), ImportDecl(..), ImportSpec(..), ImportSpecList(ImportSpecList), InstHead(..), Module(..), ModuleHead(ModuleHead), ModuleName(ModuleName), QName(..), Type(..))-import Language.Haskell.Exts.Extension (Extension(PackageImports, StandaloneDeriving, TypeSynonymInstances, FlexibleInstances))-import Language.Haskell.Exts.Pretty (defaultMode, PPHsMode(layout), PPLayout(PPInLine), prettyPrintWithMode)-import Language.Haskell.Exts.SrcLoc (SrcSpanInfo)-import qualified Language.Haskell.Exts.Syntax as S (ImportDecl(importLoc, importModule, importSpecs), ModuleName(..), Name(..))+import Language.Haskell.Exts.Extension (Extension(FlexibleInstances, StandaloneDeriving, TypeSynonymInstances))+import qualified Language.Haskell.Exts.Syntax as S (ModuleName(ModuleName)) import Language.Haskell.Modules.Common (modulePathBase, withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, foldDecls, foldExports, foldHeader, foldImports) import Language.Haskell.Modules.Imports (cleanImports)-import Language.Haskell.Modules.Internal (getParams, markForDelete, modifyParams, ModuleResult(..), MonadClean, Params(..), parseFile, parseFileWithComments, runMonadClean, scratchDir)+import Language.Haskell.Modules.Internal (modifyParams, Params(extensions, sourceDirs), runMonadClean) import Language.Haskell.Modules.Params (modifyTestMode)-import Language.Haskell.Modules.Util.DryIO (replaceFile, tildeBackup)-import Language.Haskell.Modules.Util.Symbols (symbols) import Language.Haskell.Modules.Util.Test (diff, rsync)-import System.Cmd (system)-import System.Directory (createDirectoryIfMissing, getCurrentDirectory) import System.Exit (ExitCode(..))-import System.FilePath ((<.>), (</>))-import System.Process (readProcessWithExitCode, showCommandForUser)+import System.FilePath ((</>))+import System.Process (readProcessWithExitCode) import Test.HUnit (assertEqual, Test(..)) tests :: Test
Tests/Merge.hs view
@@ -1,28 +1,10 @@ module Tests.Merge where -import Control.Monad as List (mapM)-import Control.Monad.Trans (liftIO)-import Data.Generics (Data, everywhere, mkT, Typeable)-import Data.List as List (intercalate, map)-import Data.Map as Map (fromList, insert, lookup, Map, member, toAscList)-import Data.Maybe (fromMaybe)-import Data.Monoid ((<>))-import Data.Set as Set (difference, fromList, insert, Set, union)-import Data.Set.Extra as Set (mapM)-import Language.Haskell.Exts.Annotated.Simplify (sDecl, sExportSpec, sImportDecl, sModuleName)-import qualified Language.Haskell.Exts.Annotated.Syntax as A (ExportSpecList(ExportSpecList), ImportDecl(..), Module(Module), ModuleHead(ModuleHead))-import Language.Haskell.Exts.Comments (Comment)-import Language.Haskell.Exts.Parser (fromParseResult)-import Language.Haskell.Exts.Pretty (prettyPrint)-import Language.Haskell.Exts.SrcLoc (SrcSpanInfo)-import qualified Language.Haskell.Exts.Syntax as S (ExportSpec(EModuleContents), ImportDecl(..), ModuleName(..))+import qualified Language.Haskell.Exts.Syntax as S (ModuleName(ModuleName)) import Language.Haskell.Modules.Common (withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, echo, echo2, foldDecls, foldExports, foldHeader, foldImports, ignore, ignore2)-import Language.Haskell.Modules.Imports (cleanImports)-import Language.Haskell.Modules.Internal (doResult, getParams, modifyParams, modulePath, ModuleResult(..), MonadClean, Params(sourceDirs, moduVerse, testMode), parseFileWithComments, runMonadClean)+import Language.Haskell.Modules.Internal (modifyParams, Params(moduVerse, sourceDirs), runMonadClean) import Language.Haskell.Modules.Merge (mergeModules)-import Language.Haskell.Modules.Util.Test (diff, rsync, repoModules)-import System.Cmd (system)+import Language.Haskell.Modules.Util.Test (diff, repoModules, rsync) import System.Exit (ExitCode(ExitSuccess)) import Test.HUnit (assertEqual, Test(TestCase, TestList))
Tests/Split.hs view
@@ -1,39 +1,20 @@ module Tests.Split where -import Control.Exception (throw)-import Control.Monad (when)-import Control.Monad.Trans (liftIO)-import Data.Char (isAlpha, isAlphaNum, toUpper)-import Data.Default (Default(def))-import Data.List as List (filter, intercalate, map, nub)-import Data.Map as Map (delete, elems, empty, filter, insertWith, lookup, Map, mapWithKey)-import Data.Maybe (fromMaybe, mapMaybe)-import Data.Monoid ((<>))-import Data.Set as Set (delete, difference, empty, filter, fold, insert, intersection, map, member, null, Set, singleton, toList, union, unions)-import Data.Set.Extra as Set (gFind, mapM)-import Language.Haskell.Exts (fromParseResult, ParseResult(ParseOk, ParseFailed))-import qualified Language.Haskell.Exts.Annotated as A (Decl, ImportDecl(..), ImportSpecList(..), Module(Module), ModuleHead(ModuleHead), Name)-import Language.Haskell.Exts.Annotated.Simplify (sImportDecl, sImportSpec, sModuleName, sName)-import Language.Haskell.Exts.Pretty (defaultMode, prettyPrint, prettyPrintWithMode)-import Language.Haskell.Exts.SrcLoc (SrcSpanInfo(..))-import qualified Language.Haskell.Exts.Syntax as S (ImportDecl(..), ModuleName(..), Name(..))+import Data.Set as Set (empty, singleton)+import qualified Language.Haskell.Exts.Syntax as S (ModuleName(..), Name(Ident)) import Language.Haskell.Modules.Common (withCurrentDirectory)-import Language.Haskell.Modules.Fold (ModuleInfo, echo, echo2, foldDecls, foldExports, foldHeader, foldImports, foldModule, ignore, ignore2)-import Language.Haskell.Modules.Imports (cleanImports)-import Language.Haskell.Modules.Internal (doResult, modifyParams, modulePath, ModuleResult(..), MonadClean(getParams), Params(moduVerse, sourceDirs, testMode), parseFileWithComments, runMonadClean)+import Language.Haskell.Modules.Internal (modifyParams, Params(moduVerse, sourceDirs, testMode), runMonadClean) import Language.Haskell.Modules.Params (modifyModuVerse, modifyTestMode)-import Language.Haskell.Modules.Split (splitModule)+import Language.Haskell.Modules.Split (DeclName(..), splitModule, splitModuleDecls) import Language.Haskell.Modules.Util.QIO (noisily)-import Language.Haskell.Modules.Util.Symbols (exports, imports, symbols) import Language.Haskell.Modules.Util.Test (diff, repoModules) import Prelude hiding (writeFile) import System.Cmd (system) import System.Exit (ExitCode(ExitSuccess, ExitFailure))-import System.FilePath ((<.>)) import Test.HUnit (assertEqual, Test(TestCase, TestList, TestLabel)) tests :: Test-tests = TestList [split1, split2a, split2b, split4]+tests = TestList [split1, split2a, split2b, split4, split4b] split1 :: Test split1 =@@ -41,7 +22,7 @@ do _ <- system "rsync -aHxS --delete testdata/debian/ tmp" runMonadClean $ noisily $ noisily $ do modifyParams (\ p -> p {sourceDirs = ["tmp"], moduVerse = Just repoModules})- splitModule (S.ModuleName "Debian.Repo.Package")+ splitModuleDecls (S.ModuleName "Debian.Repo.Package") (code, out, err) <- diff "testdata/split1-expected" "tmp" assertEqual "splitModule" (ExitSuccess, "", "") {- (ExitFailure 1, "diff -ru '--exclude=*~' '--exclude=*.imports' testdata/split1-expected/Debian/Repo/Package/BinaryPackagesOfIndex.hs tmp/Debian/Repo/Package/BinaryPackagesOfIndex.hs\n--- testdata/split1-expected/Debian/Repo/Package/BinaryPackagesOfIndex.hs\n+++ tmp/Debian/Repo/Package/BinaryPackagesOfIndex.hs\n@@ -22,4 +22,4 @@\n binaryPackagesOfIndex repo release index =\n case packageIndexArch index of\n Source -> return (Right [])\n- _ -> liftIO $ getPackages repo release index -- >>= return . either Left (Right . List.map (toBinaryPackage index . packageInfo))\n\\ No newline at end of file\n+ _ -> liftIO $ getPackages repo release index \n\\ No newline at end of file\n", "") -} (code, out, err) @@ -54,7 +35,7 @@ sourceDirs = ["tmp"], -- extensions = NoImplicitPrelude : extensions p, moduVerse = Just (singleton (S.ModuleName "Split"))})- splitModule (S.ModuleName "Split")+ splitModuleDecls (S.ModuleName "Split") (code, out, err) <- diff "testdata/split2-expected" "tmp" assertEqual "split2" (ExitSuccess, "", "") (code, out, err) @@ -67,7 +48,7 @@ sourceDirs = ["tmp"], -- extensions = NoImplicitPrelude : extensions p, moduVerse = Just (singleton (S.ModuleName "Split"))})- splitModule (S.ModuleName "Split")+ splitModuleDecls (S.ModuleName "Split") (code, out, err) <- diff "testdata/split2-clean-expected" "tmp" -- The output of splitModule is "correct", but it will not be -- accepted by GHC until the fix for@@ -80,6 +61,20 @@ TestLabel "Split4" $ TestCase $ do system "rsync -aHxs --delete testdata/split4/ tmp" withCurrentDirectory "tmp" $- runMonadClean $ modifyTestMode (const True) >> modifyModuVerse (const Set.empty) >> splitModule (S.ModuleName "Split4")+ runMonadClean $ modifyTestMode (const True) >> modifyModuVerse (const Set.empty) >> splitModuleDecls (S.ModuleName "Split4") result <- diff "testdata/split4-expected" "tmp" assertEqual "Split4" (ExitSuccess, "", "") result++split4b :: Test+split4b =+ TestLabel "Split4b" $ TestCase $+ do system "rsync -aHxs --delete testdata/split4/ tmp"+ withCurrentDirectory "tmp" $+ runMonadClean $ modifyTestMode (const True) >> modifyModuVerse (const Set.empty) >> splitModule f (S.ModuleName "Split4")+ result <- diff "testdata/split4b-expected" "tmp"+ assertEqual "Split4" (ExitSuccess, "", "") result+ where+ f :: DeclName -> S.ModuleName+ f x@(Exported (S.Ident "getPackages")) = S.ModuleName "Split4.A"+ f x = S.ModuleName "Split4.B"+
debian/changelog view
@@ -1,3 +1,11 @@+haskell-module-management (0.11) unstable; urgency=low++ * Rename splitModule -> splitModuleDecls+ * Add new splitModule that takes a function describing the+ symbol to module mapping.++ -- David Fox <dsf@seereason.com> Tue, 02 Jul 2013 09:54:00 -0700+ haskell-module-management (0.10.1) unstable; urgency=low * Changes to compile under ghc-7.4.1
module-management.cabal view
@@ -1,5 +1,5 @@ Name: module-management-Version: 0.10.1+Version: 0.11 Synopsis: Clean up module imports, split and merge modules Description: Clean up module imports, split and merge modules. Homepage: http://src.seereason.com/module-management
scripts/CLI.hs view
@@ -6,7 +6,7 @@ import Data.Maybe (fromMaybe) import Data.Set (Set, union, toList, empty, size, unions, singleton) import Language.Haskell.Exts.Syntax (ModuleName(ModuleName))-import Language.Haskell.Modules (runMonadClean, cleanImports, splitModule, mergeModules,+import Language.Haskell.Modules (runMonadClean, cleanImports, splitModuleDecls, mergeModules, modifyModuVerse, modifySourceDirs) import Language.Haskell.Modules.Internal (getParams, Params(..)) import Language.Haskell.Modules.Params (MonadClean)@@ -82,7 +82,7 @@ clean args = mapM_ cleanImports args split :: MonadClean m => [String] -> m ()-split [arg] = splitModule (ModuleName arg)+split [arg] = splitModuleDecls (ModuleName arg) split _ = liftIO $ hPutStrLn stderr "Usage: split <modulename>" merge :: MonadClean m => [String] -> m ()
testdata.tar.gz view
binary file changed (634311 → 634443 bytes)