|
sourcecode:
|
module CPM.Diff.API
( compareModulesFromPackages
, compareModulesFromPackageAndDir
, compareModulesInDirs
, compareApiModule
, getBaseTemp
, Differences
, Difference (..)
, showDifferences
) where
import System.Directory ( getTemporaryDirectory )
import System.FilePath ( (</>) )
import Data.List ( nub )
import Data.Maybe ( listToMaybe, catMaybes )
import Prelude hiding ( empty )
import AbstractCurry.Types ( CurryProg (..), CFuncDecl (..), CTypeDecl (..)
, COpDecl (..), QName, CFixity (..)
, CVisibility (..))
import AbstractCurry.Pretty
import AbstractCurry.Select ( functions, funcName, types, typeName )
import Text.Pretty ( pPrint, text, (<+>), vcat, empty, red, ($$) )
import CPM.AbstractCurry ( readAbstractCurryFromPackagePath )
import CPM.Config ( Config )
import CPM.ErrorLogger
import CPM.FileUtil ( copyDirectory, recreateDirectory, tempDir )
import CPM.Package ( Package, Version, packageId, loadPackageSpec
, exportedModules)
import CPM.PackageCache.Global as GC
import CPM.PackageCopy ( resolveAndCopyDependencies )
import CPM.Repository ( Repository )
getBaseTemp :: IO String
getBaseTemp = do
tmpDir <- tempDir
let tmp = tmpDir </> "diff"
recreateDirectory tmp
return tmp
--- Compares two versions of a package from the global package cache.
---
--- @param cfg - the CPM configuration
--- @param repo - the central package index
--- @param gc - the global package cache
--- @param nameA - the name of package version A
--- @param verA - the version of package version A
--- @param nameB - the name of package version B
--- @param verB - the version of package version B
--- @param onlyMods - a list of modules to compare
compareModulesFromPackages :: Config -> Repository -> GC.GlobalCache -> String
-> Version -> String -> Version -> Maybe [String]
-> ErrorLogger [(String, Differences)]
compareModulesFromPackages cfg repo gc nameA verA nameB verB onlyMods = do
baseTmp <- liftIOEL getBaseTemp
pkgA <- GC.tryFindPackage gc nameA verA
pkgB <- GC.tryFindPackage gc nameB verB
GC.copyPackage cfg pkgA baseTmp
GC.copyPackage cfg pkgB baseTmp
compareModulesInDirs cfg repo gc (baseTmp </> packageId pkgA)
(baseTmp </> packageId pkgB) onlyMods
--- Compares a package version from a directory to a package version from the
--- global package cache.
---
--- @param cfg - the CPM configuration
--- @param repo - the central package index
--- @param gc - the global package cache
--- @param dirA - the directory containing package version A
--- @param nameB - the name of package version B
--- @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]
-> ErrorLogger [(String, Differences)]
compareModulesFromPackageAndDir cfg repo gc dirA nameB verB onlyMods = do
baseTmp <- liftIOEL getBaseTemp
pkgB <- GC.tryFindPackage gc nameB verB
pkgA <- loadPackageSpec dirA
GC.copyPackage cfg pkgB baseTmp
liftIOEL $ copyDirectory dirA (baseTmp </> packageId pkgA)
compareModulesInDirs cfg repo gc (baseTmp </> packageId pkgA)
(baseTmp </> packageId pkgB) onlyMods
--- Compares package versions from two directories.
---
--- @param cfg - the CPM configuration
--- @param repo - the central package index
--- @param gc - the global package cache
--- @param dirA - the directory containing package version A
--- @param dirB - the directory containing package version B
--- @param onlyMods - a list of modules to compare
compareModulesInDirs :: Config -> Repository -> GC.GlobalCache -> String
-> String -> Maybe [String]
-> ErrorLogger [(String, Differences)]
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 ->
let cmpmods = nub (exportedModules pkgA ++ exportedModules pkgB) in
if null cmpmods
then logInfo "No exported modules to compare" >> return []
else do diffs <- liftIOEL $ mapM (compareApiModule
pkgA dirA depsA pkgB dirB depsB) cmpmods
let modsWithDiffs = zip cmpmods diffs
return $ case onlyMods of
Nothing -> modsWithDiffs
Just ms -> filter ((`elem` ms) . fst) modsWithDiffs
--- Compares a single module from two package versions.
---
--- @param pkgA - version A of the package
--- @param dirA - the directory containing version A of the package
--- @param depsA - the resolved dependencies of version A of the package
--- @param pkgB - version B of the package
--- @param dirB - the directory containing version B of the package
--- @param depsB - the resolved dependencies of version B of the package
--- @param mod - the name of the module
compareApiModule :: Package -> String -> [Package] -> Package -> String
-> [Package] -> String -> IO Differences
compareApiModule pkgA dirA depsA pkgB dirB depsB mod =
if mod `elem` exportedModules pkgA
then
if mod `elem` exportedModules pkgB
then
readAbstractCurryFromPackagePath pkgA dirA depsA mod
>>= \prog1 ->
readAbstractCurryFromPackagePath pkgB dirB depsB mod
>>= \prog2 ->
let funcDiffs = diffFuncsFiltered funcIsPublic prog1 prog2
typeDiffs = diffTypesFiltered typeIsPublic prog1 prog2
opDiffs = diffOpsFiltered (\_ _ -> True) prog1 prog2
in return $ (Nothing, funcDiffs, typeDiffs, opDiffs)
else return $ (Just $ Addition mod, [], [], [])
else return $ (Just $ Removal mod, [], [], [])
--- Differences between two versions of a package. First component is present
--- if the module is missing in one of the package versions. The other
--- components list the differences if the module is present in both versions.
type Differences = ( Maybe (Difference String)
, [Difference CFuncDecl]
, [Difference CTypeDecl]
, [Difference COpDecl]
)
--- A single difference between two versions of a module.
data Difference a = Addition a
| Removal a
| Change a a
--- Prints a list of differences to the user.
---
--- @param diffs - the list of differences
--- @param verA - version A of the package
--- @param verB - version B of the package
showDifferences :: [Differences] -> Version -> Version -> String
showDifferences diffs verA verB = pPrint $
vcat (map showDifferences' diffs)
where
jump = versionJump verA verB
showDifferences' (modDiff, funcDiffs, typeDiffs, opDiffs) =
(modText modDiff)
$$ (vcat $ funcTexts funcDiffs)
$$ (vcat $ typeTexts typeDiffs)
$$ (vcat $ opTexts opDiffs)
showViolation (Addition _) = if jump == Patch
then red $ text "Adding features in a patch version is a violation of semantic versioning."
else empty
showViolation (Removal _) = if jump /= Major
then red $ text "Removing features in a patch or minor version is a violation of semantic versioning."
else empty
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
modText modDiff = case modDiff of
Nothing -> empty
Just d -> case d of
Addition m -> (text $ "Added module " ++ m) <+> (showViolation d)
Removal m -> (text $ "Removed module " ++ m) <+> (showViolation d)
Change _ _ -> text $ "This should not appear"
--- A jump between two versions.
data VersionJump = Major | Minor | Patch | None
deriving Eq
--- Calculate the jump between two versions.
versionJump :: Version -> Version -> VersionJump
versionJump (majA, minA, patA, _) (majB, minB, patB, _) =
if majA /= majB
then Major
else if minA /= minB
then Minor
else if patA /= patB
then Patch
else None
--- Renders a function difference to a string.
showFuncDifference :: Difference CFuncDecl -> String
showFuncDifference (Addition f) = "Added " ++ (showFuncDecl f)
showFuncDifference (Removal f) = "Removed " ++ (showFuncDecl f)
showFuncDifference (Change a b) = "Change " ++ (showFuncDecl a) ++ " to " ++ (showFuncDecl b)
--- Renders a function declaration to a string.
showFuncDecl :: CFuncDecl -> String
showFuncDecl (CFunc (_, n) _ _ t _) =
n ++ " :: " ++ (pPrint $ ppCQualTypeExpr defaultOptions t)
showFuncDecl (CmtFunc _ (_, n) _ _ t _) =
n ++ " :: " ++ (pPrint $ ppCQualTypeExpr defaultOptions t)
--- Renders a type difference to a string.
showTypeDifference :: Difference CTypeDecl -> String
showTypeDifference (Addition f) = "Added " ++ (showTypeDecl f)
showTypeDifference (Removal f) = "Removed " ++ (showTypeDecl f)
showTypeDifference (Change a b) = "Changed " ++ (showTypeDecl a) ++ " to " ++ (showTypeDecl b)
--- Renders a type declaration to a string.
showTypeDecl :: CTypeDecl -> String
showTypeDecl (CType (_, n) _ _ cs _) =
"data " ++ n ++ " (" ++ (show $ length cs) ++ " constructors)"
showTypeDecl (CTypeSyn (_, n) _ _ t) =
"type " ++ n ++ " = " ++ (pPrint $ ppCTypeExpr defaultOptions t)
showTypeDecl (CNewType (_, n) _ _ _ _) = "newtype " ++ n
--- Renders an operator difference to a string.
showOpDifference :: Difference COpDecl -> String
showOpDifference (Addition f) = "Added " ++ showOpDecl f
showOpDifference (Removal f) = "Removed " ++ showOpDecl f
showOpDifference (Change a b) = "Changed " ++ showOpDecl a ++ " to " ++
showOpDecl b
--- Renders an operator declaration to a string.
showOpDecl :: COpDecl -> String
showOpDecl (COp (_, n) CInfixOp a) = "infix " ++ (show a) ++ " " ++ n
showOpDecl (COp (_, n) CInfixlOp a) = "infixl " ++ (show a) ++ " " ++ n
showOpDecl (COp (_, n) CInfixrOp a) = "infixr " ++ (show a) ++ " " ++ n
--- Compares all functions in two modules that match the given predicate.
diffFuncsFiltered :: (CurryProg -> CFuncDecl -> Bool) -> CurryProg -> CurryProg
-> [Difference CFuncDecl]
diffFuncsFiltered = mkDiff funcEq functions funcName
--- Compares all type declarations in two modules that match the given
--- predicate.
diffTypesFiltered :: (CurryProg -> CTypeDecl -> Bool) -> CurryProg -> CurryProg
-> [Difference CTypeDecl]
diffTypesFiltered = mkDiff typeEq types typeName
--- Compares all operator declarations in two modules that match the given
--- predicate.
diffOpsFiltered :: (CurryProg -> COpDecl -> Bool) -> CurryProg -> CurryProg
-> [Difference COpDecl]
diffOpsFiltered = mkDiff opEq ops opName
--- Is a function public?
funcIsPublic :: CurryProg -> CFuncDecl -> Bool
funcIsPublic _ (CFunc _ _ Public _ _) = True
funcIsPublic _ (CFunc _ _ Private _ _) = False
funcIsPublic _ (CmtFunc _ _ _ Public _ _) = True
funcIsPublic _ (CmtFunc _ _ _ Private _ _) = False
--- Is a type public?
typeIsPublic :: CurryProg -> CTypeDecl -> Bool
typeIsPublic _ (CType _ Public _ _ _) = True
typeIsPublic _ (CType _ Private _ _ _) = False
typeIsPublic _ (CTypeSyn _ Public _ _) = True
typeIsPublic _ (CTypeSyn _ Private _ _) = False
typeIsPublic _ (CNewType _ Public _ _ _) = True
typeIsPublic _ (CNewType _ Private _ _ _) = False
--- Creates a function that can compare elements in two versions of a module.
---
--- @param eq - a function that checks if two elements are equal
--- @param selector - a function that selects the elements to be compared from
--- a CurryProg
--- @param name - a function that selects the name of an element
mkDiff :: (a -> a -> Bool)
-> (CurryProg -> [a])
-> (a -> QName)
-> ((CurryProg -> a -> Bool) -> CurryProg -> CurryProg -> [Difference a])
mkDiff eq selector name =
\p b a -> let
as = filter (p a) $ selector a
bs = filter (p b) $ selector b
findDifference f = case listToMaybe $ filter ((== (name f)) . name) bs of
Nothing -> Just $ Removal f
Just f' -> if f `eq` f'
then Nothing
else Just $ Change f f'
additions = filter (not . (flip elem) (map name as) . name) bs
in
catMaybes (map findDifference as) ++ (map Addition additions)
--- Are two functions equal?
funcEq :: CFuncDecl -> CFuncDecl -> Bool
funcEq (CFunc _ a1 v1 t1 _) (CFunc _ a2 v2 t2 _) = a1 == a2 && v1 == v2 && t1 == t2
funcEq (CmtFunc _ _ a1 v1 t1 _) (CmtFunc _ _ a2 v2 t2 _) = a1 == a2 && v1 == v2 && t1 == t2
funcEq (CFunc _ a1 v1 t1 _) (CmtFunc _ _ a2 v2 t2 _) = a1 == a2 && v1 == v2 && t1 == t2
funcEq (CmtFunc _ _ a1 v1 t1 _) (CFunc _ a2 v2 t2 _) = a1 == a2 && v1 == v2 && t1 == t2
--- Are two type declarations equal? (We ignore `deriving` clauses)
typeEq :: CTypeDecl -> CTypeDecl -> Bool
typeEq (CType _ v1 tvs1 cs1 _) (CType _ v2 tvs2 cs2 _) =
v1 == v2 && tvs1 == tvs2 && cs1 == cs2
typeEq (CTypeSyn _ v1 tvs1 e1) (CTypeSyn _ v2 tvs2 e2) =
v1 == v2 && tvs1 == tvs2 && e1 == e2
typeEq (CNewType _ v1 tvs1 c1 _) (CNewType _ v2 tvs2 c2 _) =
v1 == v2 && tvs1 == tvs2 && c1 == c2
typeEq (CType _ _ _ _ _) (CTypeSyn _ _ _ _) = False
typeEq (CType _ _ _ _ _) (CNewType _ _ _ _ _) = False
typeEq (CTypeSyn _ _ _ _) (CType _ _ _ _ _) = False
typeEq (CTypeSyn _ _ _ _) (CNewType _ _ _ _ _) = False
typeEq (CNewType _ _ _ _ _) (CType _ _ _ _ _) = False
typeEq (CNewType _ _ _ _ _) (CTypeSyn _ _ _ _) = False
--- Are two operator declarations equal?
opEq :: COpDecl -> COpDecl -> Bool
opEq (COp _ f1 a1) (COp _ f2 a2) = f1 == f2 && a1 == a2
--- Select all operator declarations from a CurryProg.
ops :: CurryProg -> [COpDecl]
ops (CurryProg _ _ _ _ _ _ _ os) = os
--- Get the name of an operator declaration.
opName :: COpDecl -> QName
opName (COp n _ _) = n
|