Commit b47fb834 authored by Michael Hanus's avatar Michael Hanus
Browse files

CPM updated

parent 05d3f0d0
...@@ -633,7 +633,12 @@ CPM can be configured via the \code{\$HOME/.cpmrc} configuration file. The ...@@ -633,7 +633,12 @@ CPM can be configured via the \code{\$HOME/.cpmrc} configuration file. The
following list shows all configuration options and their default values. following list shows all configuration options and their default values.
\begin{description} \begin{description}
\item[\fbox{\code{REPOSITORY_PATH}}] The path to the index repository. \item[\fbox{\code{PACKAGE_INDEX_URL}}]
The URL of the central package index
which is used by the \code{update} command to download the
index of all repositories.
\item[\fbox{\code{REPOSITORY_PATH}}] The path to the index of all packages.
Default value: \code{\$HOME/.cpm/index}. Default value: \code{\$HOME/.cpm/index}.
\item[\fbox{\code{PACKAGE_INSTALL_PATH}}] The path to the global package cache. \item[\fbox{\code{PACKAGE_INSTALL_PATH}}] The path to the global package cache.
...@@ -700,8 +705,11 @@ one can execute the command ...@@ -700,8 +705,11 @@ one can execute the command
\section{Some CPM Internals} \section{Some CPM Internals}
\label{sec:internals} \label{sec:internals}
CPM's central package index is a Git repository containing package CPM's central package index is contains all package specification files.
specification files. A copy of this Git repository is stored on your It is stored at a central server where the actual location is defined
by CPM's configuration variable \code{PACKAGE_INDEX_URL},
see Section~\ref{sec:config}.
A copy of this index is stored on your
local system in the \code{\$HOME/.cpm/index} directory, unless you local system in the \code{\$HOME/.cpm/index} directory, unless you
changed the location using the \code{REPOSITORY_PATH} setting. CPM changed the location using the \code{REPOSITORY_PATH} setting. CPM
uses the package index when searching for and installing packages and uses the package index when searching for and installing packages and
...@@ -818,6 +826,8 @@ This command also cleans the global package cache in order to support ...@@ -818,6 +826,8 @@ This command also cleans the global package cache in order to support
the download of fresh package versions. the download of fresh package versions.
Note that this also removes local copies of packages Note that this also removes local copies of packages
installed by the command \ccode{add --package}. installed by the command \ccode{add --package}.
The option \code{--url} allows to specify a different URL
for the central package index (might be useful for experimental purposes).
\item[\fbox{\code{install}}] \item[\fbox{\code{install}}]
Installs all dependencies of the current package. Installs all dependencies of the current package.
......
...@@ -6,7 +6,7 @@ ...@@ -6,7 +6,7 @@
module CPM.Config module CPM.Config
( Config ( Config, packageInstallDir, binInstallDir, repositoryDir ( Config ( Config, packageInstallDir, binInstallDir, repositoryDir
, appPackageDir, packageIndexRepository, homePackageDir, curryExec , appPackageDir, packageIndexURL, homePackageDir, curryExec
, compilerVersion, compilerBaseVersion, baseVersion ) , compilerVersion, compilerBaseVersion, baseVersion )
, readConfigurationWith, defaultConfig , readConfigurationWith, defaultConfig
, showConfiguration, showCompilerVersion ) where , showConfiguration, showCompilerVersion ) where
...@@ -27,12 +27,12 @@ import CPM.ErrorLogger ...@@ -27,12 +27,12 @@ import CPM.ErrorLogger
import CPM.FileUtil ( ifFileExists, getFileInPath ) import CPM.FileUtil ( ifFileExists, getFileInPath )
import CPM.Helpers ( strip ) import CPM.Helpers ( strip )
--- The location of the central package index. --- The default location of the central package index.
packageIndexURI :: String packageIndexDefaultURL :: String
packageIndexURI = packageIndexDefaultURL =
"https://git.ps.informatik.uni-kiel.de/curry-packages/cpm-index.git" "https://git.ps.informatik.uni-kiel.de/curry-packages/cpm-index.git"
-- if you have an ssh access to git.ps.informatik.uni-kiel.de: -- If you have an ssh access to git.ps.informatik.uni-kiel.de:
-- "ssh://git@git.ps.informatik.uni-kiel.de:55055/curry-packages/cpm-index.git" -- "ssh://git@git.ps.informatik.uni-kiel.de:55055/curry-packages/cpm-index.git"
--- Data type containing the main configuration of CPM. --- Data type containing the main configuration of CPM.
data Config = Config { data Config = Config {
...@@ -42,10 +42,10 @@ data Config = Config { ...@@ -42,10 +42,10 @@ data Config = Config {
, binInstallDir :: String , binInstallDir :: String
--- Directory where the package repository is stored --- Directory where the package repository is stored
, repositoryDir :: String , repositoryDir :: String
--- Directory where the application packages are stored (cmd 'installapp') --- Directory where the application packages are stored (cmd 'install')
, appPackageDir :: String , appPackageDir :: String
--- URL to the package index repository --- URL to the package index repository
, packageIndexRepository :: String , packageIndexURL :: String
--- The directory where the default home package is stored --- The directory where the default home package is stored
, homePackageDir :: String , homePackageDir :: String
--- The executable of the Curry system used to compile and check packages --- The executable of the Curry system used to compile and check packages
...@@ -71,7 +71,7 @@ defaultConfig = Config ...@@ -71,7 +71,7 @@ defaultConfig = Config
, binInstallDir = "$HOME/.cpm/bin" , binInstallDir = "$HOME/.cpm/bin"
, repositoryDir = "$HOME/.cpm/index" , repositoryDir = "$HOME/.cpm/index"
, appPackageDir = "$HOME/.cpm/app_packages" , appPackageDir = "$HOME/.cpm/app_packages"
, packageIndexRepository = packageIndexURI , packageIndexURL = packageIndexDefaultURL
, homePackageDir = "" , homePackageDir = ""
, curryExec = Dist.installDir </> "bin" </> Dist.curryCompiler , curryExec = Dist.installDir </> "bin" </> Dist.curryCompiler
, compilerVersion = ( Dist.curryCompiler , compilerVersion = ( Dist.curryCompiler
...@@ -93,6 +93,7 @@ showConfiguration cfg = unlines ...@@ -93,6 +93,7 @@ showConfiguration cfg = unlines
, "BIN_INSTALL_PATH : " ++ binInstallDir cfg , "BIN_INSTALL_PATH : " ++ binInstallDir cfg
, "APP_PACKAGE_PATH : " ++ appPackageDir cfg , "APP_PACKAGE_PATH : " ++ appPackageDir cfg
, "HOME_PACKAGE_PATH : " ++ homePackageDir cfg , "HOME_PACKAGE_PATH : " ++ homePackageDir cfg
, "PACKAGE_INDEX_URL : " ++ packageIndexURL cfg
] ]
--- Shows the compiler version in the configuration. --- Shows the compiler version in the configuration.
...@@ -244,13 +245,14 @@ stripProps = map ((map toUpper . filter (/='_') . strip) *** strip) ...@@ -244,13 +245,14 @@ stripProps = map ((map toUpper . filter (/='_') . strip) *** strip)
--- record with a value for that option. --- record with a value for that option.
keySetters :: [(String, String -> Config -> Config)] keySetters :: [(String, String -> Config -> Config)]
keySetters = keySetters =
[ ("REPOSITORYPATH" , \v c -> c { repositoryDir = v }) [ ("APPPACKAGEPATH" , \v c -> c { appPackageDir = v })
, ("PACKAGEINSTALLPATH" , \v c -> c { packageInstallDir = v }) , ("BASEVERSION" , \v c -> c { baseVersion = v })
, ("BININSTALLPATH" , \v c -> c { binInstallDir = v }) , ("BININSTALLPATH" , \v c -> c { binInstallDir = v })
, ("APPPACKAGEPATH" , \v c -> c { appPackageDir = v })
, ("HOMEPACKAGEPATH" , \v c -> c { homePackageDir = v })
, ("CURRYBIN" , \v c -> c { curryExec = v }) , ("CURRYBIN" , \v c -> c { curryExec = v })
, ("BASEVERSION" , \v c -> c { baseVersion = v }) , ("HOMEPACKAGEPATH" , \v c -> c { homePackageDir = v })
, ("PACKAGEINDEXURL" , \v c -> c { packageIndexURL = v })
, ("PACKAGEINSTALLPATH" , \v c -> c { packageInstallDir = v })
, ("REPOSITORYPATH" , \v c -> c { repositoryDir = v })
] ]
--- Sequentially applies a list of functions that transform a value to a value --- Sequentially applies a list of functions that transform a value to a value
......
...@@ -56,7 +56,7 @@ cpmBanner :: String ...@@ -56,7 +56,7 @@ cpmBanner :: String
cpmBanner = unlines [bannerLine,bannerText,bannerLine] cpmBanner = unlines [bannerLine,bannerText,bannerLine]
where where
bannerText = bannerText =
"Curry Package Manager <curry-language.org/tools/cpm> (version of 13/05/2018)" "Curry Package Manager <curry-language.org/tools/cpm> (version of 19/06/2018)"
bannerLine = take (length bannerText) (repeat '-') bannerLine = take (length bannerText) (repeat '-')
main :: IO () main :: IO ()
...@@ -89,7 +89,7 @@ runWithArgs opts = do ...@@ -89,7 +89,7 @@ runWithArgs opts = do
(msgs, result) <- case optCommand opts of (msgs, result) <- case optCommand opts of
NoCommand -> failIO "NoCommand" NoCommand -> failIO "NoCommand"
Config o -> configCmd o config Config o -> configCmd o config
Update -> updateCmd config Update o -> updateCmd o config
Compiler o -> compiler o config Compiler o -> compiler o config
Exec o -> execCmd o config Exec o -> execCmd o config
Doc o -> docCmd o config Doc o -> docCmd o config
...@@ -129,7 +129,7 @@ data Command ...@@ -129,7 +129,7 @@ data Command
| Uninstall UninstallOptions | Uninstall UninstallOptions
| PkgInfo InfoOptions | PkgInfo InfoOptions
| Compiler ExecOptions | Compiler ExecOptions
| Update | Update UpdateOptions
| List ListOptions | List ListOptions
| Search SearchOptions | Search SearchOptions
| Upgrade UpgradeOptions | Upgrade UpgradeOptions
...@@ -201,6 +201,10 @@ data AddOptions = AddOptions ...@@ -201,6 +201,10 @@ data AddOptions = AddOptions
data NewOptions = NewOptions data NewOptions = NewOptions
{ projectName :: String } { projectName :: String }
data UpdateOptions = UpdateOptions
{ indexURLs :: [String] -- the URLs of additional index repositories
}
data ExecOptions = ExecOptions data ExecOptions = ExecOptions
{ exeCommand :: String -- the command to be executed { exeCommand :: String -- the command to be executed
} }
...@@ -286,6 +290,11 @@ newOpts s = case optCommand s of ...@@ -286,6 +290,11 @@ newOpts s = case optCommand s of
New opts -> opts New opts -> opts
_ -> NewOptions "" _ -> NewOptions ""
updateOpts :: Options -> UpdateOptions
updateOpts s = case optCommand s of
Update opts -> opts
_ -> UpdateOptions []
execOpts :: Options -> ExecOptions execOpts :: Options -> ExecOptions
execOpts s = case optCommand s of execOpts s = case optCommand s of
Exec opts -> opts Exec opts -> opts
...@@ -383,8 +392,10 @@ optionParser allargs = optParser ...@@ -383,8 +392,10 @@ optionParser allargs = optParser
<|> command "clean" (help "Clean the current package") <|> command "clean" (help "Clean the current package")
(\a -> Right $ a { optCommand = Clean }) [] (\a -> Right $ a { optCommand = Clean }) []
<|> command "new" (help "Create a new package") Right newArgs <|> command "new" (help "Create a new package") Right newArgs
<|> command "update" (help "Update the package index") <|> command "update"
(\a -> Right $ a { optCommand = Update }) [] (help "Update the package index")
(\a -> Right $ a { optCommand = Update (updateOpts a) })
updateArgs
<|> command "curry" <|> command "curry"
(help "Load package spec and start Curry with correct dependencies.") (help "Load package spec and start Curry with correct dependencies.")
(\a -> Right $ a { optCommand = Compiler (execOpts a) }) (\a -> Right $ a { optCommand = Compiler (execOpts a) })
...@@ -510,6 +521,15 @@ optionParser allargs = optParser ...@@ -510,6 +521,15 @@ optionParser allargs = optParser
where where
remargs = tail (snd (break (=="curry") allargs)) remargs = tail (snd (break (=="curry") allargs))
updateArgs =
option (\s a -> let opts = updateOpts a
in Right $ a { optCommand = Update opts
{ indexURLs = s : indexURLs opts } })
( short "u"
<> long "url"
<> metavar "URL"
<> help "URL of the central package index" )
execArgs = execArgs =
rest (\_ a -> Right $ a { optCommand = Exec (execOpts a) rest (\_ a -> Right $ a { optCommand = Exec (execOpts a)
{ exeCommand = unwords remargs } }) { exeCommand = unwords remargs } })
...@@ -736,8 +756,13 @@ configCmd opts cfg = do ...@@ -736,8 +756,13 @@ configCmd opts cfg = do
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- `update` command: -- `update` command:
updateCmd :: Config -> IO (ErrorLogger ()) updateCmd :: UpdateOptions -> Config -> IO (ErrorLogger ())
updateCmd cfg = checkRequiredExecutables >> updateRepository cfg updateCmd opts cfg = do
let cfg' = if null (indexURLs opts)
then cfg
else cfg { packageIndexURL = head (indexURLs opts) }
-- TODO: allow merging from several package indices
checkRequiredExecutables >> updateRepository cfg'
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
-- `deps` command: -- `deps` command:
......
...@@ -29,8 +29,7 @@ import ReadShowTerm ( showQTerm, readQTerm, showTerm, readUnqualifiedTerm ) ...@@ -29,8 +29,7 @@ import ReadShowTerm ( showQTerm, readQTerm, showTerm, readUnqualifiedTerm )
import System ( exitWith, system ) import System ( exitWith, system )
import Time import Time
import CPM.Config ( Config, repositoryDir, packageIndexRepository import CPM.Config ( Config, repositoryDir )
, packageInstallDir )
import CPM.ConfigPackage ( packageVersion ) import CPM.ConfigPackage ( packageVersion )
import CPM.ErrorLogger import CPM.ErrorLogger
import CPM.Package import CPM.Package
......
...@@ -11,14 +11,16 @@ module CPM.Repository.Update ...@@ -11,14 +11,16 @@ module CPM.Repository.Update
import Directory import Directory
import FilePath import FilePath
import List ( isSuffixOf )
import System ( system ) import System ( system )
import CPM.Config ( Config, packageInstallDir, packageIndexRepository import CPM.Config ( Config, packageInstallDir, packageIndexURL
, repositoryDir ) , repositoryDir )
import CPM.ErrorLogger import CPM.ErrorLogger
import CPM.Package import CPM.Package
import CPM.Package.Helpers ( cleanPackage ) import CPM.Package.Helpers ( cleanPackage )
import CPM.FileUtil ( copyDirectory, inDirectory, removeDirectoryComplete ) import CPM.FileUtil ( copyDirectory, inDirectory, quote
, recreateDirectory, removeDirectoryComplete )
import CPM.Repository import CPM.Repository
import CPM.Repository.CacheDB ( tryWriteRepositoryDB ) import CPM.Repository.CacheDB ( tryWriteRepositoryDB )
import CPM.Repository.Select ( addPackageToRepositoryCache import CPM.Repository.Select ( addPackageToRepositoryCache
...@@ -34,23 +36,32 @@ updateRepository cfg = do ...@@ -34,23 +36,32 @@ updateRepository cfg = do
debugMessage $ "Deleting global package cache: '" ++ debugMessage $ "Deleting global package cache: '" ++
packageInstallDir cfg ++ "'" packageInstallDir cfg ++ "'"
removeDirectoryComplete (packageInstallDir cfg) removeDirectoryComplete (packageInstallDir cfg)
gitExists <- doesDirectoryExist $ (repositoryDir cfg) </> ".git" debugMessage $ "Recreating package index: '" ++ repositoryDir cfg ++ "'"
if gitExists recreateDirectory (repositoryDir cfg)
then do c <- inDirectory (repositoryDir cfg) downloadCommand
c <- inDirectory (repositoryDir cfg) $ execQuietCmd $ cleanPullCmd if c == 0
if c == 0 then finishUpdate
then finishUpdate else failIO $ "Failed to update package index, return code " ++ show c
else failIO $ "Failed to update git repository, return code " ++ show c
else do
c <- inDirectory (repositoryDir cfg) $ execQuietCmd cloneCommand
if c == 0
then finishUpdate
else failIO $ "Failed to update git repository, return code " ++ show c
where where
cleanPullCmd q = "git clean -d -f && git reset " ++ q ++ " --hard && " ++ downloadCommand
"git pull " ++ q ++ " origin master" | ".git" `isSuffixOf` piurl
= execQuietCmd $ \q -> unwords ["git clone", q, quote piurl, "."]
cloneCommand q = unwords ["git clone", q, packageIndexRepository cfg, "."] | ".tar" `isSuffixOf` piurl
= do let tarfile = "XXX.tar"
c1 <- showExecCmd $ unwords ["curl", "-s", "-o", tarfile, quote piurl]
c2 <- showExecCmd $ unwords ["tar", "-xf", tarfile]
removeFile tarfile
return (c1+c2)
| ".tar.gz" `isSuffixOf` piurl
= do let tarfile = "XXX.tar.gz"
c1 <- showExecCmd $ unwords ["curl", "-s", "-o", tarfile, quote piurl]
c2 <- showExecCmd $ unwords ["tar", "-xzf", tarfile]
removeFile tarfile
return (c1+c2)
| otherwise
= do errorMessage $ "Unknown kind of package index URL: " ++ piurl
return 1
where piurl = packageIndexURL cfg
finishUpdate = do finishUpdate = do
setLastUpdate cfg setLastUpdate cfg
......
...@@ -67,7 +67,7 @@ getInterfaceInfos anaName (mod:mods) = ...@@ -67,7 +67,7 @@ getInterfaceInfos anaName (mod:mods) =
loadDefaultAnalysisValues :: String -> String -> IO [(QName,a)] loadDefaultAnalysisValues :: String -> String -> IO [(QName,a)]
loadDefaultAnalysisValues anaName moduleName = do loadDefaultAnalysisValues anaName moduleName = do
(_,fileName) <- findModuleSourceInLoadPath moduleName (_,fileName) <- findModuleSourceInLoadPath moduleName
let defaultFileName = stripCurrySuffix fileName ++ ".defaults."++anaName let defaultFileName = stripCurrySuffix fileName ++ ".defaults." ++ anaName
fileExists <- doesFileExist defaultFileName fileExists <- doesFileExist defaultFileName
if fileExists if fileExists
then do debugMessage 3 ("Load default values from " ++ defaultFileName) then do debugMessage 3 ("Load default values from " ++ defaultFileName)
......
...@@ -10,7 +10,7 @@ ...@@ -10,7 +10,7 @@
--- (instead of the data constructors). --- (instead of the data constructors).
--- ---
--- @author Heiko Hoffmann, Michael Hanus --- @author Heiko Hoffmann, Michael Hanus
--- @version March 2017 --- @version June 2018
------------------------------------------------------------------------- -------------------------------------------------------------------------
module Analysis.Types module Analysis.Types
...@@ -20,12 +20,13 @@ module Analysis.Types ...@@ -20,12 +20,13 @@ module Analysis.Types
, combinedSimpleFuncAnalysis, combined2SimpleFuncAnalysis , combinedSimpleFuncAnalysis, combined2SimpleFuncAnalysis
, combinedSimpleTypeAnalysis , combinedSimpleTypeAnalysis
, combinedDependencyFuncAnalysis, combinedDependencyTypeAnalysis , combinedDependencyFuncAnalysis, combinedDependencyTypeAnalysis
, simpleModuleAnalysis, dependencyModuleAnalysis
, isSimpleAnalysis, isCombinedAnalysis, isFunctionAnalysis , isSimpleAnalysis, isCombinedAnalysis, isFunctionAnalysis
, analysisName, baseAnalysisNames, startValue , analysisName, baseAnalysisNames, startValue
, AOutFormat(..) , AOutFormat(..)
) where ) where
import FlatCurry.Types ( ConsDecl, FuncDecl, TypeDecl, QName ) import FlatCurry.Types ( Prog, ConsDecl, FuncDecl, TypeDecl, QName )
import FlatCurry.Goodies ( progImports ) import FlatCurry.Goodies ( progImports )
import Analysis.ProgInfo ( ProgInfo, combineProgInfo, lookupProgInfo ) import Analysis.ProgInfo ( ProgInfo, combineProgInfo, lookupProgInfo )
...@@ -49,6 +50,8 @@ data Analysis a = ...@@ -49,6 +50,8 @@ data Analysis a =
(String -> IO (FuncDecl -> [(QName,a)] -> a)) (String -> IO (FuncDecl -> [(QName,a)] -> a))
| CombinedDependencyTypeAnalysis [String] String Bool a | CombinedDependencyTypeAnalysis [String] String Bool a
(String -> IO (TypeDecl -> [(QName,a)] -> a)) (String -> IO (TypeDecl -> [(QName,a)] -> a))
| SimpleModuleAnalysis String (Prog -> a)
| DependencyModuleAnalysis String (Prog -> [(String,a)] -> a)
--- A simple analysis for functions takes an operation that computes --- A simple analysis for functions takes an operation that computes
...@@ -160,18 +163,38 @@ combinedDependencyTypeAnalysis ananame baseAnalysis startval anaType = ...@@ -160,18 +163,38 @@ combinedDependencyTypeAnalysis ananame baseAnalysis startval anaType =
[analysisName baseAnalysis] ananame True startval [analysisName baseAnalysis] ananame True startval
(runWithBaseAnalysis baseAnalysis anaType) (runWithBaseAnalysis baseAnalysis anaType)
--- Construct a simple analysis for entire modules.
--- The analysis has a name and takes an operation that computes
--- some information from a given module.
simpleModuleAnalysis :: String -> (Prog -> a) -> Analysis a
simpleModuleAnalysis anaName anaFunc =
SimpleModuleAnalysis anaName anaFunc
--- Construct a module analysis which uses analysis information on
--- imported modules.
--- The analysis has a name and an operation to analyze a module.
--- The analysis operation could use already computed information
--- of imported modules, represented as a list of module name/information pairs.
--- Note that a fixpoint iteration is not necessary
--- since module dependencies must be acyclic.
dependencyModuleAnalysis :: String -> (Prog -> [(String,a)] -> a) -> Analysis a
dependencyModuleAnalysis anaName anaFunc =
DependencyModuleAnalysis anaName anaFunc
-------------------------------------------------------------------------
--- Is the analysis a simple analysis? --- Is the analysis a simple analysis?
--- Otherwise, it is a dependency analysis which requires a fixpoint --- Otherwise, it is a dependency analysis which requires a fixpoint
--- computation to compute the results. --- computation to compute the results.
isSimpleAnalysis :: Analysis a -> Bool isSimpleAnalysis :: Analysis a -> Bool
isSimpleAnalysis analysis = case analysis of isSimpleAnalysis analysis = case analysis of
SimpleFuncAnalysis _ _ -> True SimpleFuncAnalysis _ _ -> True
SimpleTypeAnalysis _ _ -> True SimpleTypeAnalysis _ _ -> True
SimpleConstructorAnalysis _ _ -> True SimpleConstructorAnalysis _ _ -> True
CombinedSimpleFuncAnalysis _ _ _ _ -> True CombinedSimpleFuncAnalysis _ _ _ _ -> True
CombinedSimpleTypeAnalysis _ _ _ _ -> True CombinedSimpleTypeAnalysis _ _ _ _ -> True
_ -> False _ -> False
--- Is the analysis a combined analysis? --- Is the analysis a combined analysis?
isCombinedAnalysis :: Analysis a -> Bool isCombinedAnalysis :: Analysis a -> Bool
...@@ -180,30 +203,32 @@ isCombinedAnalysis analysis = case analysis of ...@@ -180,30 +203,32 @@ isCombinedAnalysis analysis = case analysis of
CombinedSimpleTypeAnalysis _ _ _ _ -> True CombinedSimpleTypeAnalysis _ _ _ _ -> True
CombinedDependencyFuncAnalysis _ _ _ _ _ -> True CombinedDependencyFuncAnalysis _ _ _ _ _ -> True
CombinedDependencyTypeAnalysis _ _ _ _ _ -> True CombinedDependencyTypeAnalysis _ _ _ _ _ -> True
_ -> False _ -> False
--- Is the analysis a function analysis? --- Is the analysis a function analysis?
--- Otherwise, it is a type or constructor analysis. --- Otherwise, it is a type or constructor analysis.
isFunctionAnalysis :: Analysis a -> Bool isFunctionAnalysis :: Analysis a -> Bool
isFunctionAnalysis analysis = case analysis of isFunctionAnalysis analysis = case analysis of
SimpleFuncAnalysis _ _ -> True SimpleFuncAnalysis _ _ -> True
DependencyFuncAnalysis _ _ _ -> True DependencyFuncAnalysis _ _ _ -> True
CombinedSimpleFuncAnalysis _ _ _ _ -> True CombinedSimpleFuncAnalysis _ _ _ _ -> True
CombinedDependencyFuncAnalysis _ _ _ _ _ -> True CombinedDependencyFuncAnalysis _ _ _ _ _ -> True
_ -> False _ -> False
--- Name of the analysis to be used in server communication and --- Name of the analysis to be used in server communication and
--- analysis files. --- analysis files.
analysisName :: Analysis a -> String analysisName :: Analysis a -> String
analysisName (SimpleFuncAnalysis name _) = name analysisName (SimpleFuncAnalysis name _ ) = name
analysisName (SimpleTypeAnalysis name _) = name analysisName (SimpleTypeAnalysis name _ ) = name
analysisName (SimpleConstructorAnalysis name _) = name analysisName (SimpleConstructorAnalysis name _ ) = name
analysisName (DependencyFuncAnalysis name _ _) = name analysisName (DependencyFuncAnalysis name _ _) = name
analysisName (DependencyTypeAnalysis name _ _) = name analysisName (DependencyTypeAnalysis name _ _) = name
analysisName (CombinedSimpleFuncAnalysis _ nameB _ _) = nameB analysisName (CombinedSimpleFuncAnalysis _ nameB _ _) = nameB
analysisName (CombinedSimpleTypeAnalysis _ nameB _ _) = nameB analysisName (CombinedSimpleTypeAnalysis _ nameB _ _) = nameB
analysisName (CombinedDependencyFuncAnalysis _ nameB _ _ _) = nameB analysisName (CombinedDependencyFuncAnalysis _ nameB _ _ _) = nameB
analysisName (CombinedDependencyTypeAnalysis _ nameB _ _ _) = nameB analysisName (CombinedDependencyTypeAnalysis _ nameB _ _ _) = nameB
analysisName (SimpleModuleAnalysis name _) = name
analysisName (DependencyModuleAnalysis name _) = name
--- Names of the base analyses of a combined analysis. --- Names of the base analyses of a combined analysis.
baseAnalysisNames :: Analysis a -> [String] baseAnalysisNames :: Analysis a -> [String]
......
------------------------------------------------------------------------
--- An analysis which returns information whether a module is unsafe, i.e.,
--- it imports directly or indirectly the module `Unsafe`.
---
--- @author Michael Hanus
--- @version June 2018
------------------------------------------------------------------------
module Analysis.UnsafeModule ( showUnsafe, unsafeModuleAnalysis )
where
import List ( nub )
import Analysis.Types
import FlatCurry.Goodies ( progImports, progName )
import FlatCurry.Types
------------------------------------------------------------------------
--- This analysis associates to a module the of all module names
--- which directly imports the module `Unsafe`.
--- Such modules might hide dangerous operations in
--- purely functional operations.
--- Thus, a module is safe if the analysis result is the empty list.
unsafeModuleAnalysis :: Analysis [String]
unsafeModuleAnalysis = dependencyModuleAnalysis "UnsafeModule" importsUnsafe
-- Show a list of type constructor names as a string.
showUnsafe :: AOutFormat -> [String] -> String
showUnsafe _ [] = "safe"
showUnsafe ANote (_:_) = "unsafe"
showUnsafe AText [mod] = "unsafe (due to module " ++ mod ++ ")"
showUnsafe AText ms@(_:_:_) = "unsafe (due to modules " ++ unwords ms ++ ")"
-- Does the module import the module `Unsafe` or any other unsafe module?
-- TODO: to be real safe, one also has to check external operations!
importsUnsafe :: Prog -> [(String,[String])] -> [String]
importsUnsafe prog impinfos =
let unsafemods = (if "Unsafe" `elem` progImports prog then [progName prog]
else []) ++
concatMap snd impinfos
in nub unsafemods
-----------------------------------------------------------------------
Analyzing module for importing `Unsafe` module
----------------------------------------------
The `UnsafeModule` analysis returns information whether a module is unsafe,
i.e., it imports directly or indirectly the module `Unsafe`.
Such modules might hide dangerous operations in
purely functional operations.
The result of this analysis is the list of the names of all modules
which directly imports the module `Unsafe`.
Thus, a module is safe if the analysis result is the empty list.
...@@ -34,7 +34,8 @@ import CASS.PackageConfig (packagePath, packageExecutable, packageVersion) ...@@ -34,7 +34,8 @@ import CASS.PackageConfig (packagePath, packageExecutable, packageVersion)
systemBanner :: String systemBanner :: String
systemBanner = systemBanner =
let bannerText = "CASS: Curry Analysis Server System (Version " ++ let bannerText = "CASS: Curry Analysis Server System (Version " ++
packageVersion ++ " of 23/01/2017 for "++curryCompiler++")" packageVersion ++ " of 05/06/2018 for " ++
curryCompiler ++ ")"
bannerLine = take (length bannerText) (repeat '=') bannerLine = take (length bannerText) (repeat '=')
in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine in bannerLine ++ "\n" ++ bannerText ++ "\n" ++ bannerLine
......
...@@ -46,6 +46,7 @@ import Analysis.SolutionCompleteness ...@@ -46,6 +46,7 @@ import Analysis.SolutionCompleteness
import Analysis.Termination import Analysis.Termination
import Analysis.TotallyDefined import Analysis.TotallyDefined
import Analysis.TypeUsage import Analysis.TypeUsage
import Analysis.UnsafeModule