1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83

--------------------------------------------------------------------------------
--- Contains a function that prefixes all modules in a package and all modules
--- in all of its transitive dependencies with a given string.
--------------------------------------------------------------------------------

module CPM.Diff.Rename (prefixPackageAndDeps) where

import System.Directory (doesDirectoryExist, getDirectoryContents, createDirectory)
import System.FilePath ((</>), joinPath, takeDirectory, takeBaseName, takeExtension)
import Data.List (splitOn)

import CPM.AbstractCurry (transformAbstractCurryInDeps, applyModuleRenames)
import CPM.Config (Config)
import CPM.ErrorLogger
import CPM.Package (Package, loadPackageSpec)
import CPM.PackageCache.Runtime as RuntimeCache
import CPM.PackageCache.Global as GC
import CPM.PackageCopy (resolveAndCopyDependencies)
import CPM.Repository (Repository)

-- 1. Find all transitive package dependencies.
-- 2. Collect all Curry modules in all dependencies in a list with module name
--    and actual path on disk.
-- 3. Build a map from old module names to prefixed module names.
-- 4. Copy each Curry module in the list to its new, prefixed location. If the
--    module name contains a dot, then the top-level folder gets the prefix. If
--    it contains no dot, then the Curry file itself gets the prefix. Transform
--    the Curry module while copying it.

--- Prefix all modules in a package and all modules in all of its transitive
--- dependencies with a string.
---
--- @param cfg - the CPM configuration
--- @param repo - the central package index
--- @param gc - the global package cache
--- @param dir - the directory of the package
--- @param prefix - the prefix for all module names
--- @param destDir - the destination directory for the modified modules
prefixPackageAndDeps :: Config -> Repository -> GC.GlobalCache -> String
                     -> String -> String -> ErrorLogger [(String, String)]
prefixPackageAndDeps cfg repo gc dir prefix destDir = do
  deps <- resolveAndCopyDependencies cfg repo gc dir
  depMods <- liftIOEL $ (mapM
               (findAllModulesInPackage . RuntimeCache.cacheDirectory dir) deps)
  ownMods <- liftIOEL $ findAllModulesInPackage dir
  let allMods = ownMods ++ concat depMods
  let modMap = zip (map fst allMods) (map ((prefix ++) . fst) allMods)
  mapM (copyMod dir deps destDir modMap) allMods
  return modMap

--- Finds all modules in a package.
findAllModulesInPackage :: String -> IO [(String, String)]
findAllModulesInPackage dir = findMods "" (dir </> "src")
 where
  findMods p d = do
    entries <- getDirectoryContents d
    filteredEntries <- return $ filter (\r -> length r >= 1 && head r /= '.') entries
    curryFiles <- return $ filter ((== ".curry") . takeExtension) filteredEntries
    directoryFlags <- mapM doesDirectoryExist (map (d </>) filteredEntries)
    directories <- return $ map fst $ filter snd $ zip filteredEntries directoryFlags
    depMods <- mapM (\d' -> findMods d' (d </> d')) directories
    return $ (map (modWithPath p d) curryFiles) ++ concat depMods
  modWithPath p d m = if p == "" then (takeBaseName m, d </> m)
                                 else (p ++ "." ++ takeBaseName m, d </> m)

--- Copies a module from one directory to another while renaming both the module
--- itself as well as any references to other modules inside that module.
copyMod :: String -> [Package] -> String -> [(String, String)]
        -> (String, String) -> ErrorLogger ()
copyMod origDir deps dest nameMap (name, _) = do
  liftIOEL $ do
    dirExists <- doesDirectoryExist (takeDirectory destPath)
    if dirExists
      then return ()
      else createDirectory (takeDirectory destPath)
  transformAbstractCurryInDeps origDir deps (applyModuleRenames nameMap)
                               name destPath
 where
  newName = case lookup name nameMap of
    Nothing -> name
    Just n' -> n'
  pathParts = splitOn "." newName
  destPath = (joinPath (dest:pathParts)) ++ ".curry"