packages feed

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