Added ltsupdatepersist and ltsquerypersist commands, that update the persistent archive of stackage files and allow to query it

REPL/.gitignore

@@ -1,2 +1,3 @@
 arch/
 hackagefiles/
+stackagefiles/

REPL/src/Common.hs

@@ -23,6 +23,7 @@ module Common(URL,
               getLTSFilesDir,
               getLTSStackageURL,
               getLTSFile,
+              getLTSPersistDir,
               StackageSnapshot,
               StackageSnapshots(..), 
               getNormalSnapshots,
@@ -101,6 +102,7 @@ tarClone = "01-index.orig.tar"
 getArchivePersistDir :: HackageUpdateInfo -> FilePath
 getArchivePersistDir iuh = iuhUpdateDir iuh </> "persist"
 
+
 getArchive :: HackageUpdateInfo -> FilePath
 getArchive iuh = iuhUpdateDir iuh </> archive
 
@@ -171,6 +173,9 @@ data StackageUpdateInfo = SUI {
   suiLTSURL :: URL
 } deriving (Eq, Show)
 
+getLTSPersistDir :: StackageUpdateInfo -> FilePath
+getLTSPersistDir sui = suiUpdateDir sui </> "persist"
+
 defaultSUI :: StackageUpdateInfo
 defaultSUI = SUI {
   suiUpdateDir = "stackagefiles", 

REPL/src/HackageArchive.hs

@@ -13,7 +13,6 @@ module HackageArchive (
                 queryPersistentMap,
 
                 HackagePackage (..),
-                HackageName,
                 HackageMap,
                 HackageUpdateMap,
                 HackageUpdate,
@@ -50,12 +49,10 @@ import qualified Control.Monad.State  as State
 import System.FilePath.Posix(hasTrailingPathSeparator)
 import Common
 
-type HackageName = String
-
 -- The record for each of the package from hackage
 -- TODO - add another information about the packages
 data HackagePackage = HP {
-  name :: HackageName,
+  name :: PackageName,
   pVersion :: DV.Version,
   author :: String
 } deriving (Eq, Show)
@@ -65,11 +62,11 @@ data HackageUpdate = Added | Removed | Updated deriving (Eq, Show)
 
 -- The map of all the hackage packages with name as the key and HackagePackage
 -- as the value
-type HackageMap = M.Map HackageName HackagePackage
+type HackageMap = M.Map PackageName HackagePackage
-type PreHackageMap = M.Map HackageName DV.Version
+type PreHackageMap = M.Map PackageName DV.Version
 
 -- The map, that shows, which packages have change since the last update
-type HackageUpdateMap = M.Map HackageName (HackageUpdate, HackagePackage)
+type HackageUpdateMap = M.Map PackageName (HackageUpdate, HackagePackage)
 
 -- Parses the file path of the cabal file to get version and package name
 parseCabalFilePath :: RP.ReadP PackageData
@@ -164,7 +161,7 @@ $(deriveSafeCopy 0 'base ''HackagePackage)
 $(deriveSafeCopy 0 'base ''KeyValue)
 $(deriveSafeCopy 0 'base ''HackageUpdate)
 
-insertKey :: HackageName -> HackagePackage -> Update KeyValue ()
+insertKey :: PackageName -> HackagePackage -> Update KeyValue ()
 insertKey key value = do 
   KeyValue hackageMap <- State.get
   State.put (KeyValue (M.insert key value hackageMap))
@@ -172,7 +169,7 @@ insertKey key value = do
 updateMap :: HackageMap -> Update KeyValue ()
 updateMap newMap = State.put (KeyValue newMap)
 
-lookupKey :: HackageName -> Query KeyValue (Maybe HackagePackage)
+lookupKey :: PackageName -> Query KeyValue (Maybe HackagePackage)
 lookupKey key = do
   KeyValue m <- ask
   return (M.lookup key m)
@@ -202,7 +199,7 @@ printPersistentDiffMap path newMap = do
     mapM_ (print.snd) $ M.toList diffMap
   closeAcidState acid
 
-queryPersistentMap :: FilePath -> HackageName -> IO (Maybe HackagePackage)
+queryPersistentMap :: FilePath -> PackageName -> IO (Maybe HackagePackage)
 queryPersistentMap path name = do
   acid <- openLocalStateFrom path (KeyValue M.empty)
   val <- query acid (LookupKey name)

REPL/src/HackageCommands.hs

@@ -133,8 +133,7 @@ updatePersistentFromTar updateDir tarFile = do
   let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
   updatePersistentMap updateDir newMap 
 
-
+showPersistentQuery :: FilePath -> PackageName -> IO()
-showPersistentQuery :: FilePath -> HackageName -> IO()
 showPersistentQuery updateDir name = do
   putStrLn $ "Querying storage hackage map with " ++ name
   value <- queryPersistentMap updateDir name

REPL/src/REPL.hs

@@ -15,7 +15,6 @@ import Network.HTTP.Client(HttpException)
 import Common
 import qualified HackageCommands as HC
 import qualified StackageCommands as SC
---import qualified HttpDownload as HD
 
 processREPLCycle :: UpdateInfo -> IO ()
 processREPLCycle ui = forever $ do
@@ -61,22 +60,23 @@ buildCommand ui = processCommand
       | chk "querypersist" =  HC.showPersistentQuery ud (parseValEnd command)
 
       -- shows the snapshots from stackage
-      | chk "snapshots" = SC.showSnapshots snapshotsURL
+      | chk "ltssnapshots" = SC.showSnapshots snapshotsURL
-
+      -- gets all the lts snapshots from the stackage, updates the lts files according to them
+      | chk "ltsallupdate" = 
+        SC.updateAllLTSFiles ltsFileDir ltsURL snapshotsURL
+      -- shows contents of the lts file
+      | chk "ltsshowcont" = let lts = parseValEnd command in
+        SC.showLTSContents  (getLTSFile (sui ui) lts)      
+      | chk "ltsshowmap" = SC.showStackageMapContents ltsFileDir ltsURL snapshotsURL 20
+      -- gets all the lts snapshots from the stackage, updates the lts files according to them
+      -- and then updates the persistent storage
+      | chk "ltsupdatepersist" = SC.updatePersistentMapFromLTS sud ltsFileDir ltsURL snapshotsURL
+      -- queries the persistent map of the stackage packages
+      | chk "ltsquerypersist" =  SC.showPersistentQuery sud (parseValEnd command)
+      -- updates the specified lts package from github
       | chk "ltsupdate" = let lts = parseValEnd command in 
         SC.updateLTSFile (getLTSFile (sui ui) lts) (getLTSGithubURL (sui ui) lts) 
 
-      | chk "ltsallupdate" = 
-        SC.updateAllLTSFiles ltsFileDir ltsURL snapshotsURL
-
-      | chk "ltsshowcont" = let lts = parseValEnd command in
-        SC.showLTSContents  (getLTSFile (sui ui) lts)
-      
-      | chk "ltsshowmap" = SC.showStackageMapContents ltsFileDir ltsURL snapshotsURL 20
-
-      -- | chk "ltspersist" = 
-      --    SC.updateLT
-        
       -- exits the REPL
       | chk "exit" = exitREPL
       | chk "quit" = exitREPL
@@ -121,6 +121,8 @@ buildCommand ui = processCommand
             persistCommand = HC.updatePersistentFromTar ud trFile
             ltsFileDir = getLTSFilesDir (sui ui)
             ltsURL = suiLTSURL (sui ui)
+            sud = (getLTSPersistDir.sui) ui
+
 
 
 showHelp :: UpdateInfo -> IO()

REPL/src/StackageArchive.hs

@@ -3,8 +3,12 @@
 {-# LANGUAGE DeriveDataTypeable #-}
 {-# LANGUAGE TemplateHaskell    #-}
 
-module StackageArchive(
+module StackageArchive(    
-    generateStackageMap
+    generateStackageMap,
+    updatePersistentMap,
+    queryPersistentMap,
+    StackagePackage(..),
+    StackageMap
 ) where
 
 import qualified Data.Map.Strict as M
@@ -12,12 +16,17 @@ import qualified Data.Version as DV
 import qualified Data.ByteString as BS
 import System.FilePath((</>))
 
+import Data.Typeable
+import Data.Acid
+import Data.Acid.Advanced
+import Data.SafeCopy
+import qualified Control.Monad.State  as State
+import Control.Monad.Reader
+
+
 import Common
 import StackageUpdate
 
--- The name of the package, that is present somewhere in the stackage
-type StackageName = String
-
 -- This is a mapping of version of the package, that is present in the lts
 -- snapshot with the specified name. So 
 newtype StackageVersionLTS = SVL (M.Map LongSnapshotName DV.Version) deriving (Eq)
@@ -29,7 +38,7 @@ makeSVL :: LongSnapshotName -> DV.Version -> StackageVersionLTS
 makeSVL ss v = SVL $ M.singleton ss v
 
 data StackagePackage = SP {
-  name :: StackageName,
+  name :: PackageName,
   ltsVersions :: StackageVersionLTS
 } deriving (Eq)
 
@@ -39,7 +48,7 @@ instance Show StackagePackage where
 addSVL :: StackagePackage -> LongSnapshotName -> DV.Version -> StackagePackage
 addSVL (SP n (SVL m)) name version = SP n $ SVL $ M.insert name version m
 
-type StackageMap = M.Map StackageName StackagePackage
+type StackageMap = M.Map PackageName StackagePackage
 
 updateStackageMap :: StackageMap -> LongSnapshotName -> PackageDatum -> StackageMap
 updateStackageMap map snapshotName (PD packages) = 
@@ -57,7 +66,48 @@ generateStackageMap :: FilePath -> StackageSnapshots -> IO StackageMap
 -- make the empty map here
 generateStackageMap _ (SSS []) = return M.empty 
 generateStackageMap filePath (SSS (s: xs)) = do
+    -- get the yaml file
     body <- BS.readFile (filePath </> longName s ++ ".yaml")
     newMap <- generateStackageMap filePath $ SSS xs
+    -- build the map from this yaml file
     pkgDatum <- parseYamlFileThrow body
-    return $ updateStackageMap newMap (longName s) pkgDatum
+    return $ updateStackageMap newMap (longName s) pkgDatum
+
+-- this is needed for acid serialization
+newtype KeyValue = KeyValue StackageMap deriving (Typeable)
+
+$(deriveSafeCopy 0 'base ''StackageVersionLTS)
+$(deriveSafeCopy 0 'base ''StackagePackage)
+$(deriveSafeCopy 0 'base ''DV.Version)
+$(deriveSafeCopy 0 'base ''KeyValue)
+
+
+insertKey :: PackageName -> StackagePackage -> Update KeyValue ()
+insertKey key value = do 
+  KeyValue stackageMap <- State.get
+  State.put (KeyValue (M.insert key value stackageMap))
+
+updateMap :: StackageMap -> Update KeyValue ()
+updateMap newMap = State.put (KeyValue newMap)
+
+lookupKey :: PackageName -> Query KeyValue (Maybe StackagePackage)
+lookupKey key = do
+  KeyValue m <- ask
+  return (M.lookup key m)
+
+$(makeAcidic ''KeyValue ['insertKey, 'lookupKey, 'updateMap])
+
+updatePersistentMap :: FilePath -> StackageMap -> IO ()
+updatePersistentMap path newMap = do
+  acid <- openLocalStateFrom path (KeyValue M.empty)
+  do
+    putStrLn "Updating the persistent map"
+    update acid (UpdateMap newMap) 
+  closeAcidState acid
+
+queryPersistentMap :: FilePath -> PackageName -> IO (Maybe StackagePackage)
+queryPersistentMap path name = do
+  acid <- openLocalStateFrom path (KeyValue M.empty)
+  val <- query acid (LookupKey name)
+  closeAcidState acid
+  return val

REPL/src/StackageCommands.hs

@@ -2,9 +2,10 @@ module StackageCommands(
                         showSnapshots,
                         showLTSContents,
                         showStackageMapContents,
+                        showPersistentQuery,
                         updateLTSFile, 
                         updateAllLTSFiles,
-                        updatePersistentFromLTS) where
+                        updatePersistentMapFromLTS) where
 
 import qualified Data.ByteString as BS
 import qualified Data.Map.Strict as M
@@ -31,15 +32,11 @@ updateLTSFile :: FilePath -> URL -> IO ()
 updateLTSFile = fetchLTS 
 
 -- updates all of the lts files from the snapshot file at stackage
-
 updateAllLTSFiles :: FilePath -> URL -> URL -> IO ()
 updateAllLTSFiles ltsDir ltsURL snapshotsURL = do
     snapshots <- fetchStackageSnapshots snapshotsURL
     fetchAllLTSFiles ltsDir ltsURL (filterNormal snapshots)
 
-updatePersistentFromLTS :: FilePath -> FilePath -> IO()
-updatePersistentFromLTS updateDir ltsDir = undefined
-
 showStackageMapContents :: FilePath -> URL -> URL -> Int -> IO()
 showStackageMapContents ltsDir ltsURL snapshotsURL count = do
     putStrLn "Fetching snapshot lists"
@@ -50,3 +47,23 @@ showStackageMapContents ltsDir ltsURL snapshotsURL count = do
     map <- generateStackageMap ltsDir (filterNormal snapshots)
     putStrLn $ "Printing " ++ show count ++ " packages"
     mapM_ print $ take count $ M.toList map
+
+updatePersistentMapFromLTS :: FilePath -> FilePath -> URL -> URL -> IO()
+updatePersistentMapFromLTS updateDir ltsDir ltsURL snapshotsURL  = do
+    putStrLn "Fetching snapshot lists"
+    snapshots <- fetchStackageSnapshots snapshotsURL
+    putStrLn "Downloading YAML files"
+    fetchAllLTSFiles ltsDir ltsURL (filterNormal snapshots)
+    putStrLn "Generating stackage map"
+    map <- generateStackageMap ltsDir (filterNormal snapshots)
+    updatePersistentMap updateDir map 
+
+showPersistentQuery :: FilePath -> PackageName -> IO()
+showPersistentQuery updateDir name = do
+  putStrLn $ "Querying storage stackage map with " ++ name
+  value <- queryPersistentMap updateDir name
+  case value of 
+    Just package -> do
+      putStrLn "Found"
+      print package
+    Nothing -> putStrLn "Not found"