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

cpm updated

parent 3805365b
...@@ -54,7 +54,7 @@ cpmBanner :: String ...@@ -54,7 +54,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 29/03/2018)" "Curry Package Manager <curry-language.org/tools/cpm> (version of 04/04/2018)"
bannerLine = take (length bannerText) (repeat '-') bannerLine = take (length bannerText) (repeat '-')
main :: IO () main :: IO ()
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
--- Some queries on the repository cache. --- Some queries on the repository cache.
--- ---
--- @author Michael Hanus --- @author Michael Hanus
--- @version March 2018 --- @version April 2018
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -271,12 +271,14 @@ addPackageToRepositoryCache cfg pkg = do ...@@ -271,12 +271,14 @@ addPackageToRepositoryCache cfg pkg = do
updatePackageInRepositoryCache :: Config -> Package -> IO (ErrorLogger ()) updatePackageInRepositoryCache :: Config -> Package -> IO (ErrorLogger ())
updatePackageInRepositoryCache cfg pkg = do updatePackageInRepositoryCache cfg pkg = do
dbexists <- doesFileExist (repositoryCacheDB cfg) dbexists <- doesFileExist (repositoryCacheDB cfg)
if dbexists then removePackageFromRepositoryDB pkg >> if dbexists then removePackageFromRepositoryDB cfg pkg >>
addPackagesToRepositoryDB cfg True [pkg] addPackagesToRepositoryDB cfg True [pkg]
else cleanRepositoryCache cfg >> succeedIO () else cleanRepositoryCache cfg >> succeedIO ()
where
removePackageFromRepositoryDB pkg = runQuery cfg --- Removes a package from the repository cache DB.
(Database.CDBI.ER.deleteEntries CPM.Repository.RepositoryDB.indexEntry_CDBI_Description (Just (Database.CDBI.ER.And [Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnName 0) (Database.CDBI.ER.string (name pkg)) ,Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnVersion 0) (Database.CDBI.ER.string (showTerm (version pkg)))]))) removePackageFromRepositoryDB :: Config -> Package -> IO ()
removePackageFromRepositoryDB cfg pkg = runQuery cfg
(Database.CDBI.ER.deleteEntries CPM.Repository.RepositoryDB.indexEntry_CDBI_Description (Just (Database.CDBI.ER.And [Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnName 0) (Database.CDBI.ER.string (name pkg)) ,Database.CDBI.ER.equal (Database.CDBI.ER.colNum CPM.Repository.RepositoryDB.indexEntryColumnVersion 0) (Database.CDBI.ER.string (showTerm (version pkg)))])))
......
...@@ -2,7 +2,7 @@ ...@@ -2,7 +2,7 @@
--- Some queries on the repository cache. --- Some queries on the repository cache.
--- ---
--- @author Michael Hanus --- @author Michael Hanus
--- @version March 2018 --- @version April 2018
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
{-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=foreigncode --optF=-o #-} {-# OPTIONS_CYMAKE -F --pgmF=currypp --optF=foreigncode --optF=-o #-}
...@@ -271,13 +271,15 @@ addPackageToRepositoryCache cfg pkg = do ...@@ -271,13 +271,15 @@ addPackageToRepositoryCache cfg pkg = do
updatePackageInRepositoryCache :: Config -> Package -> IO (ErrorLogger ()) updatePackageInRepositoryCache :: Config -> Package -> IO (ErrorLogger ())
updatePackageInRepositoryCache cfg pkg = do updatePackageInRepositoryCache cfg pkg = do
dbexists <- doesFileExist (repositoryCacheDB cfg) dbexists <- doesFileExist (repositoryCacheDB cfg)
if dbexists then removePackageFromRepositoryDB pkg >> if dbexists then removePackageFromRepositoryDB cfg pkg >>
addPackagesToRepositoryDB cfg True [pkg] addPackagesToRepositoryDB cfg True [pkg]
else cleanRepositoryCache cfg >> succeedIO () else cleanRepositoryCache cfg >> succeedIO ()
where
removePackageFromRepositoryDB pkg = runQuery cfg --- Removes a package from the repository cache DB.
``sql* Delete removePackageFromRepositoryDB :: Config -> Package -> IO ()
From IndexEntry removePackageFromRepositoryDB cfg pkg = runQuery cfg
Where Name = {name pkg} And Version = {showTerm (version pkg)};'' ``sql* Delete
From IndexEntry
Where Name = {name pkg} And Version = {showTerm (version pkg)};''
------------------------------------------------------------------------------ ------------------------------------------------------------------------------
...@@ -279,7 +279,8 @@ parseXmlString s = fst (parseXmlTokens (scanXmlString s) Nothing) ...@@ -279,7 +279,8 @@ parseXmlString s = fst (parseXmlTokens (scanXmlString s) Nothing)
-- parse a list of XML tokens into list of XML expressions: -- parse a list of XML tokens into list of XML expressions:
-- parseXmlTokens tokens stoptoken = (xml_expressions, remaining_tokens) -- parseXmlTokens tokens stoptoken = (xml_expressions, remaining_tokens)
parseXmlTokens :: [XmlExp] -> Maybe String -> ([XmlExp],[XmlExp]) parseXmlTokens :: [XmlExp] -> Maybe String -> ([XmlExp],[XmlExp])
parseXmlTokens [] Nothing = ([],[]) parseXmlTokens [] Nothing = ([],[])
parseXmlTokens [] (Just _) = error "XML.parseXmlTokens: incomplete parse"
parseXmlTokens (XText s : xtokens) stop = parseXmlTokens (XText s : xtokens) stop =
let (xexps, rem_xtokens) = parseXmlTokens xtokens stop let (xexps, rem_xtokens) = parseXmlTokens xtokens stop
in (XText (xmlUnquoteSpecials s) : xexps, rem_xtokens) in (XText (xmlUnquoteSpecials s) : xexps, rem_xtokens)
...@@ -295,6 +296,8 @@ parseXmlTokens (XElem (t:ts) args cont : xtokens) stop ...@@ -295,6 +296,8 @@ parseXmlTokens (XElem (t:ts) args cont : xtokens) stop
in (XElem ts args cont : xexps, rem_xtokens) in (XElem ts args cont : xexps, rem_xtokens)
| otherwise = let (xexps, rem_xtokens) = parseXmlTokens xtokens stop | otherwise = let (xexps, rem_xtokens) = parseXmlTokens xtokens stop
in (XElem (t:ts) args cont : xexps, rem_xtokens) in (XElem (t:ts) args cont : xexps, rem_xtokens)
parseXmlTokens (XElem [] _ _ : _) _ =
error "XML.parseXmlTokens: incomplete parse"
-- scan an XML string into list of XML tokens: -- scan an XML string into list of XML tokens:
......
...@@ -279,7 +279,8 @@ parseXmlString s = fst (parseXmlTokens (scanXmlString s) Nothing) ...@@ -279,7 +279,8 @@ parseXmlString s = fst (parseXmlTokens (scanXmlString s) Nothing)
-- parse a list of XML tokens into list of XML expressions: -- parse a list of XML tokens into list of XML expressions:
-- parseXmlTokens tokens stoptoken = (xml_expressions, remaining_tokens) -- parseXmlTokens tokens stoptoken = (xml_expressions, remaining_tokens)
parseXmlTokens :: [XmlExp] -> Maybe String -> ([XmlExp],[XmlExp]) parseXmlTokens :: [XmlExp] -> Maybe String -> ([XmlExp],[XmlExp])
parseXmlTokens [] Nothing = ([],[]) parseXmlTokens [] Nothing = ([],[])
parseXmlTokens [] (Just _) = error "XML.parseXmlTokens: incomplete parse"
parseXmlTokens (XText s : xtokens) stop = parseXmlTokens (XText s : xtokens) stop =
let (xexps, rem_xtokens) = parseXmlTokens xtokens stop let (xexps, rem_xtokens) = parseXmlTokens xtokens stop
in (XText (xmlUnquoteSpecials s) : xexps, rem_xtokens) in (XText (xmlUnquoteSpecials s) : xexps, rem_xtokens)
...@@ -295,6 +296,8 @@ parseXmlTokens (XElem (t:ts) args cont : xtokens) stop ...@@ -295,6 +296,8 @@ parseXmlTokens (XElem (t:ts) args cont : xtokens) stop
in (XElem ts args cont : xexps, rem_xtokens) in (XElem ts args cont : xexps, rem_xtokens)
| otherwise = let (xexps, rem_xtokens) = parseXmlTokens xtokens stop | otherwise = let (xexps, rem_xtokens) = parseXmlTokens xtokens stop
in (XElem (t:ts) args cont : xexps, rem_xtokens) in (XElem (t:ts) args cont : xexps, rem_xtokens)
parseXmlTokens (XElem [] _ _ : _) _ =
error "XML.parseXmlTokens: incomplete parse"
-- scan an XML string into list of XML tokens: -- scan an XML string into list of XML tokens:
......
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