Commit 59162a3c authored by Michael Hanus 's avatar Michael Hanus

Code refactoring and small fixes

parent ccaea8fd
......@@ -73,14 +73,16 @@ compareModulesFromPackages cfg repo gc nameA verA nameB verB onlyMods = getBaseT
--- @param verB - the version of package version B
--- @param onlyMods - a list of modules to compare
compareModulesFromPackageAndDir :: Config -> Repository -> GC.GlobalCache
-> String -> String -> Version -> Maybe [String]
-> IO (ErrorLogger [(String, Differences)])
compareModulesFromPackageAndDir cfg repo gc dirA nameB verB onlyMods = getBaseTemp |>=
-> String -> String -> Version -> Maybe [String]
-> IO (ErrorLogger [(String, Differences)])
compareModulesFromPackageAndDir cfg repo gc dirA nameB verB onlyMods =
getBaseTemp |>=
\baseTmp -> GC.tryFindPackage gc nameB verB |>=
\pkgB -> loadPackageSpec dirA |>=
\pkgA -> GC.copyPackage cfg pkgB baseTmp |>
copyDirectory dirA (baseTmp </> packageId pkgA) >> succeedIO () |>
compareModulesInDirs cfg repo gc (baseTmp </> packageId pkgA) (baseTmp </> packageId pkgB) onlyMods
compareModulesInDirs cfg repo gc (baseTmp </> packageId pkgA)
(baseTmp </> packageId pkgB) onlyMods
--- Compares package versions from two directories.
---
......@@ -97,7 +99,8 @@ compareModulesInDirs cfg repo gc dirA dirB onlyMods = loadPackageSpec dirA |>=
\pkgA -> loadPackageSpec dirB |>=
\pkgB -> resolveAndCopyDependencies cfg repo gc dirA |>=
\depsA -> resolveAndCopyDependencies cfg repo gc dirB |>=
\depsB -> mapEL (compareApiModule pkgA dirA depsA pkgB dirB depsB) (allMods pkgA pkgB) |>=
\depsB -> mapEL (compareApiModule pkgA dirA depsA pkgB dirB depsB)
(allMods pkgA pkgB) |>=
\diffs -> let modsWithDiffs = zip (allMods pkgA pkgB) diffs in
succeedIO $ case onlyMods of
Nothing -> modsWithDiffs
......@@ -167,9 +170,12 @@ showDifferences diffs verA verB = pPrint $
showViolation (Change _ _) = if jump /= Major
then red $ text "Changing APIs in a patch or minor version is a violation of semantic versioning."
else empty
funcTexts funcDiffs = map (\f -> (text $ showFuncDifference f) <+> (showViolation f)) funcDiffs
typeTexts typeDiffs = map (\f -> (text $ showTypeDifference f) <+> (showViolation f)) typeDiffs
opTexts opDiffs = map (\f -> (text $ showOpDifference f) <+> (showViolation f)) opDiffs
funcTexts funcDiffs =
map (\f -> (text $ showFuncDifference f) <+> (showViolation f)) funcDiffs
typeTexts typeDiffs =
map (\f -> (text $ showTypeDifference f) <+> (showViolation f)) typeDiffs
opTexts opDiffs =
map (\f -> (text $ showOpDifference f) <+> (showViolation f)) opDiffs
modText modDiff = case modDiff of
Nothing -> empty
Just d -> case d of
......
......@@ -190,9 +190,11 @@ callCurryCheck info baseTmp funcs = do
(intercalate ", " $ map ((flip combineTuple) "." . funcName) funcs)
putStrLn ""
oldPath <- getEnviron "CURRYPATH"
setEnviron "CURRYPATH" $ infDirA info ++ ":" ++ infDirB info
putStrLn $ "CURRYPATH=" ++ infDirA info ++ ":" ++ infDirB info
let currybin = installDir </> "bin" </> "curry"
let currybin = installDir </> "bin" </> "curry"
currypath = infDirA info ++ ":" ++ infDirB info
setEnviron "CURRYPATH" currypath
log Debug "Run `curry check Compare' with" |>
log Debug ("CURRYPATH=" ++ currypath) |> succeedIO ()
inDirectory baseTmp $ system (currybin ++ " check Compare")
setEnviron "CURRYPATH" oldPath
succeedIO ()
......
......@@ -23,7 +23,7 @@ import List (splitOn)
--- Recursively copies a directory structure.
copyDirectory :: String -> String -> IO ()
copyDirectory src dst = do
retCode <- system $ "cp -R \"" ++ src ++ "\" \"" ++ dst ++ "\""
retCode <- system $ "cp -pR \"" ++ src ++ "\" \"" ++ dst ++ "\""
if retCode /= 0
then error $ "Copy failed with " ++ (show retCode)
else return ()
......@@ -32,7 +32,7 @@ copyDirectory src dst = do
--- get replaced by copies in the destination.
copyDirectoryFollowingSymlinks :: String -> String -> IO ()
copyDirectoryFollowingSymlinks src dst = do
retCode <- system $ "cp -LR \"" ++ src ++ "\" \"" ++ dst ++ "\""
retCode <- system $ "cp -pLR \"" ++ src ++ "\" \"" ++ dst ++ "\""
if retCode /= 0
then error $ "Copy failed with " ++ (show retCode)
else return ()
......
......@@ -463,16 +463,20 @@ upgrade :: UpgradeOptions -> Config -> Repository -> GlobalCache
upgrade (UpgradeOptions Nothing) cfg repo gc = tryFindLocalPackageSpec "." |>=
\specDir -> log Info "Upgrading all packages" |>
upgradeAllPackages cfg repo gc specDir
upgrade (UpgradeOptions (Just pkg)) cfg repo gc = tryFindLocalPackageSpec "." |>=
upgrade (UpgradeOptions (Just pkg)) cfg repo gc =
tryFindLocalPackageSpec "." |>=
\specDir -> log Info ("Upgrade " ++ pkg) |>
upgradeSinglePackage cfg repo gc specDir pkg
link :: LinkOptions -> Config -> Repository -> GlobalCache -> IO (ErrorLogger ())
link :: LinkOptions -> Config -> Repository -> GlobalCache
-> IO (ErrorLogger ())
link (LinkOptions src) _ _ _ = tryFindLocalPackageSpec "." |>=
\specDir -> log Info ("Linking '" ++ src ++ "' into local package cache") |>
linkToLocalCache src specDir
diff :: DiffOptions -> Config -> Repository -> GlobalCache -> IO (ErrorLogger ())
diff :: DiffOptions -> Config -> Repository -> GlobalCache
-> IO (ErrorLogger ())
diff o cfg repo gc = tryFindLocalPackageSpec "." |>=
\specDir -> loadPackageSpec specDir |>=
\localSpec -> diffAPIIfEnabled specDir localSpec |>
......@@ -481,23 +485,35 @@ diff o cfg repo gc = tryFindLocalPackageSpec "." |>=
modules spec = case diffModules o of
Nothing -> exportedModules spec
Just ms -> ms
diffAPIIfEnabled specDir localSpec = if diffAPI o
then (putStrLn "Now running API diff" >> putStrLn "" >> succeedIO ()) |>
APIDiff.compareModulesFromPackageAndDir cfg repo gc specDir (name localSpec) (diffVersion o) (diffModules o) |>=
\diffResults -> (putStrLn (APIDiff.showDifferences (map snd diffResults) (version localSpec) (diffVersion o))
>> putStrLn "" >> succeedIO ())
diffAPIIfEnabled specDir localSpec =
if diffAPI o
then (putStrLn "Now running API diff..." >> putStrLn "" >> succeedIO ()) |>
APIDiff.compareModulesFromPackageAndDir cfg repo gc specDir
(name localSpec) (diffVersion o) (diffModules o) |>=
\diffResults ->
let diffOut = APIDiff.showDifferences (map snd diffResults)
(version localSpec) (diffVersion o)
in unless (null diffOut) (putStrLn diffOut >> putStrLn "") >>
succeedIO ()
else succeedIO ()
diffBehaviorIfEnabled specDir localSpec = if diffBehavior o
then BDiff.preparePackageAndDir cfg repo gc specDir (name localSpec) (diffVersion o) |>=
\i -> BDiff.diffBehavior cfg repo gc i (modules localSpec)
else succeedIO ()
exec :: ExecOptions -> Config -> Repository -> GlobalCache -> IO (ErrorLogger ())
diffBehaviorIfEnabled specDir localSpec =
if diffBehavior o
then BDiff.preparePackageAndDir cfg repo gc specDir (name localSpec)
(diffVersion o) |>=
\i -> BDiff.diffBehavior cfg repo gc i (modules localSpec)
else succeedIO ()
exec :: ExecOptions -> Config -> Repository -> GlobalCache
-> IO (ErrorLogger ())
exec o cfg repo gc = tryFindLocalPackageSpec "." |>=
\specPath -> resolveAndCopyDependencies cfg repo gc specPath |>=
\pkgs -> getAbsolutePath specPath >>= \abs -> succeedIO () |>
succeedIO (abs </> "src") |>=
\srcDir -> log Debug ("Setting CURRYPATH to " ++ (dependencyPaths pkgs abs) ++ ":" ++ srcDir) |>
\srcDir -> log Debug
("Setting CURRYPATH to " ++ (dependencyPaths pkgs abs) ++ ":" ++ srcDir) |>
do
setEnviron "CURRYPATH" $ (dependencyPaths pkgs abs) ++ ":" ++ srcDir
system (exeCommand o)
......
Markdown is supported
0% or
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment