Added the parsing of lts list from stackage.org

REPL/app/Main.hs

@@ -3,18 +3,8 @@
 
 module Main where
 
-import qualified Data.ByteString.Lazy as BL
-import Data.Int(Int64)
-import qualified Control.Exception as X
-import qualified Data.Char as DC
-import qualified Data.List as DL
-import Control.Monad(forever)
-import System.Directory(copyFile)
-import System.IO (stdout, hFlush)
-import qualified Data.Map.Strict as Map
 import Data.Default
-
 import IndexProject
 
 main :: IO ()
-main = processCycle def
+main = processREPLCycle def

REPL/index-project.cabal

@@ -15,7 +15,9 @@ cabal-version:       >=1.10
 
 library
   hs-source-dirs:      src
-  other-modules:     Common, FileUtils, HttpDownload, HackageUpdate, REPL, Storage
+  other-modules:     Common, FileUtils, HttpDownload, HackageUpdate, REPL
+                     , HackageCommands, StackageUpdate, StackageCommands
+                     
   exposed-modules:   IndexProject, HackageArchive, Stackage
   build-depends:       base >= 4.7 && < 5
                      , directory
@@ -42,6 +44,7 @@ library
                      , transformers
                      , zlib
                      , acid-state
+                     , unordered-containers
 
   default-language:    Haskell2010
 

REPL/src/Common.hs

@@ -1,15 +1,27 @@
 module Common(URL,
               PackageName,
+              PackageVersion(..),
               PackageData,
               SnapshotData(..),
               UpdateArchiveException(..),
+              UpdateInfo(..),
               HackageUpdateInfo(..),
               getArchive,
               getArchiveClone,
               getTar,
               getTarClone,
               parseIntEnd,
-              parseValEnd) where
+              parseValEnd,
+              
+              ShortSnapshotName,
+              LongSnapshotName,
+              shortName,
+              longName,
+              getSnapshotURL,
+              StackageSnapshot,
+              StackageSnapshots(..), 
+              StackageLTS, 
+              StackageUpdateInfo(..)) where
 
 import qualified Control.Exception as X
 import qualified Data.ByteString.Lazy as BL
@@ -23,7 +35,22 @@ import System.FilePath((</>))
 
 type URL = String 
 type PackageName = String
-type PackageData = (PackageName, DV.Version)
+data PackageVersion = Installed | Specified DV.Version deriving (Eq, Ord, Show)
+type PackageData = (PackageName, PackageVersion)
+
+data UpdateInfo = UI {
+  iuh :: HackageUpdateInfo,
+  sui :: StackageUpdateInfo
+} deriving (Eq, Show)
+
+instance Default UpdateInfo where
+  def = defaultUI
+
+defaultUI :: UpdateInfo
+defaultUI = UI { 
+  iuh = defaultIUH, 
+  sui = defaultSUI 
+} 
 
 data SnapshotData = SnapshotData { 
   md5Hash :: String,
@@ -42,6 +69,7 @@ data HackageUpdateInfo = IUH {
   iuhArchiveURL :: URL
 } deriving (Eq, Show)
 
+
 instance Default HackageUpdateInfo where
   def = defaultIUH
 
@@ -86,3 +114,35 @@ parseValEnd :: String -> String
 parseValEnd val | DL.length l > 1 = DL.last l
                 | otherwise = ""
                 where l = words val
+
+
+-- Stackage stuff
+type ShortSnapshotName = String
+type LongSnapshotName = String
+type StackageSnapshot = (ShortSnapshotName, LongSnapshotName)
+newtype StackageSnapshots = SSS [StackageSnapshot] deriving (Eq, Show)
+
+shortName :: StackageSnapshot -> String
+shortName = fst
+
+longName :: StackageSnapshot -> String
+longName = snd
+
+type StackageLTS = (LongSnapshotName, [PackageData])
+
+getLTSURL :: StackageUpdateInfo -> LongSnapshotName -> URL
+getLTSURL sui name = suiStackageURL sui </> name </> "cabal.config"
+
+getSnapshotURL :: StackageUpdateInfo -> URL
+getSnapshotURL sui = suiStackageURL sui </> "download/lts-snapshots.json"
+
+data StackageUpdateInfo = SUI { 
+  suiUpdateDir :: FilePath, 
+  suiStackageURL :: URL
+} deriving (Eq, Show)
+
+defaultSUI :: StackageUpdateInfo
+defaultSUI = SUI {
+  suiUpdateDir = "stackagefiles", 
+  suiStackageURL = "https://www.stackage.org/"
+}

REPL/src/HackageArchive.hs

@@ -1,9 +1,17 @@
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE TypeFamilies       #-}
+{-# LANGUAGE DeriveDataTypeable #-}
+{-# LANGUAGE TemplateHaskell    #-}
 
 module HackageArchive (
                 buildDifferenceMap,
                 buildHackageMap,
                 buildPreHackageMap,
+                
+                updatePersistentMap,
+                printPersistentDiffMap,
+                queryPersistentMap,
+
                 HackagePackage (..),
                 HackageName,
                 HackageMap,
@@ -26,11 +34,18 @@ import qualified Distribution.PackageDescription.Parse as DPDP
 import qualified Data.Map.Strict as M
 import qualified Control.Exception as X
 
+import Data.Typeable
+import Data.Acid
+import Data.Acid.Advanced
+import Data.SafeCopy
+import Control.Monad.Reader
+
 import Data.Maybe
 import Debug.Trace
 import Control.Monad(guard)
 
 import qualified Data.ByteString.Lazy.UTF8 as UTFC
+import qualified Control.Monad.State  as State
 
 import System.FilePath.Posix(hasTrailingPathSeparator)
 import Common
@@ -40,9 +55,8 @@ type HackageName = String
 -- The record for each of the package from hackage
 -- TODO - add another information about the packages
 data HackagePackage = HP {
---  packageData :: HHPathData
   name :: HackageName,
-  version :: DV.Version,
+  pVersion :: DV.Version,
   author :: String
 } deriving (Eq, Show)
 
@@ -52,8 +66,7 @@ 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 PreHackageMap = M.Map HackageName PackageVersion
-type PreHackageMap = M.Map HackageName DV.Version
 
 -- The map, that shows, which packages have change since the last update
 type HackageUpdateMap = M.Map HackageName (HackageUpdate, HackagePackage)
@@ -69,7 +82,7 @@ parseCabalFilePath = do
   guard (name == package)
   suff <- RP.string ".cabal"
   RP.eof
-  pure (package, version)
+  pure (package, Specified version)
   where phi l = DC.isLetter l || l == '-'
 
 updateMapCompare :: (Ord a) => String -> a -> M.Map String a -> M.Map String a
@@ -90,7 +103,7 @@ buildDifferenceMap oldMap newMap = foldr M.union M.empty [deletedMap, addedMap,
     diff newpack oldpack = if newpack /= oldpack then Just newpack else Nothing
 
 createPackage :: DPD.PackageDescription -> HackagePackage
-createPackage pd = HP { name = nm, version = ver, author = auth }
+createPackage pd = HP { name = nm, pVersion = ver, author = auth }
   where
     pkg = DPD.package pd
     nm = DP.unPackageName (DP.pkgName pkg)
@@ -143,3 +156,56 @@ buildHackageMap Tar.Done _ = M.empty
 buildHackageMap (Tar.Fail e) _ = X.throw e
 
 
+-- The stuff needed for acid serialization
+newtype KeyValue = KeyValue HackageMap deriving (Typeable)
+
+$(deriveSafeCopy 0 'base ''DV.Version)
+$(deriveSafeCopy 0 'base ''HackagePackage)
+$(deriveSafeCopy 0 'base ''KeyValue)
+$(deriveSafeCopy 0 'base ''HackageUpdate)
+
+insertKey :: HackageName -> HackagePackage -> Update KeyValue ()
+insertKey key value = do 
+  KeyValue hackageMap <- State.get
+  State.put (KeyValue (M.insert key value hackageMap))
+
+updateMap :: HackageMap -> Update KeyValue ()
+updateMap newMap = State.put (KeyValue newMap)
+
+lookupKey :: HackageName -> Query KeyValue (Maybe HackagePackage)
+lookupKey key = do
+  KeyValue m <- ask
+  return (M.lookup key m)
+
+compareMap :: HackageMap -> Query KeyValue HackageUpdateMap
+compareMap newMap = do
+  KeyValue oldMap <- ask
+  return (buildDifferenceMap oldMap newMap)
+
+$(makeAcidic ''KeyValue ['insertKey, 'lookupKey, 'compareMap, 'updateMap])
+
+
+updatePersistentMap :: FilePath -> HackageMap -> IO ()
+updatePersistentMap path newMap = do
+  acid <- openLocalStateFrom path (KeyValue M.empty)
+  do
+    putStrLn "Updating the persistent map"
+    update acid (UpdateMap newMap) 
+  closeAcidState acid
+
+printPersistentDiffMap :: FilePath -> HackageMap -> IO ()
+printPersistentDiffMap path newMap = do
+  acid <- openLocalStateFrom path (KeyValue M.empty)
+  do
+    diffMap <- query acid (CompareMap newMap)
+    putStrLn "Printing difference map with persistent map"
+    mapM_ (print.snd) $ M.toList diffMap
+  closeAcidState acid
+
+queryPersistentMap :: FilePath -> HackageName -> IO (Maybe HackagePackage)
+queryPersistentMap path name = do
+  acid <- openLocalStateFrom path (KeyValue M.empty)
+  val <- query acid (LookupKey name)
+  closeAcidState acid
+  return val
+  

REPL/src/HackageCommands.hs

@@ -0,0 +1,151 @@
+module HackageCommands(
+                        showTarElements,
+                        showTarPreElements,
+                        showFileSnapshot,
+                        showFileSubstring,
+                        showUpdateData,
+                        copyArchive,
+                        showDiffMap,
+                        cutFile,
+                        unzipArchive,
+                        removeArchiveFiles,
+                        showArchiveCompare,
+                        updateArchive,
+                        updateArchiveVoid,
+                        updateTotalArchive,
+
+                        updatePersistentFromTar,
+                        showPersistentQuery,
+                        showPersistentTarCompare
+                        ) where
+
+import qualified Data.Map.Strict as M
+import Data.Int(Int64)
+import System.Directory(copyFile)
+import Control.Monad(void)
+
+import FileUtils
+import Common
+import HackageArchive
+import HackageUpdate
+
+-- shows the first count elements, parsed from the tar archive
+showTarElements :: FilePath -> Int -> IO ()
+showTarElements path count = do
+  putStrLn $ "Displaying " ++ show count ++ " entries for " ++ path
+  tar <- loadTar path
+  mapM_ (print.snd) $ take count $ M.toList $ buildHackageMap tar (buildPreHackageMap tar)
+
+-- shows the first count pre elements (only path is parsed) form the tar archive
+showTarPreElements :: FilePath -> Int -> IO ()
+showTarPreElements path count = do
+  putStrLn $ "Pre displaying " ++ show count ++ " entries for " ++ path
+  tar <- loadTar path
+  mapM_ print $ take count $ M.toList $ buildPreHackageMap tar
+
+-- Displays the snapshot of the file
+showFileSnapshot :: FilePath -> IO()
+showFileSnapshot file = do
+  filesnapshot <- calcFileData file
+  putStrLn $ "File result for " ++ file
+  putStrLn $ "\tFile snapshot: " ++ show filesnapshot
+
+
+-- Shows the update data for the archive on disk
+showUpdateData :: FilePath -> URL -> IO()
+showUpdateData file json = do
+  (range, snapshot, filesnapshot) <- calcUpdateResultIO file json
+  putStrLn $ "Update result for file " ++ file
+  putStrLn $ "\tHackage snapshot: " ++ show snapshot
+  putStrLn $ "\tFile snapshot: " ++ show filesnapshot
+  putStrLn $ "\tRange to update: " ++ show range
+
+-- shows the substring of specified length from file from offset 
+showFileSubstring :: FilePath -> Int64 -> Int64 -> IO ()
+showFileSubstring file from length = do
+  putStrLn $ "Showing " ++ file ++ " substr"
+  putStr "\t"
+  substr <- getFileSubstring file from length
+  print substr
+
+-- Copies the archive from first filename to the second
+copyArchive :: FilePath -> FilePath -> IO ()
+copyArchive archive1 archive2 = do
+  copyFile archive1 archive2
+  putStrLn $ "Copied the " ++ archive1 ++ " to " ++ archive2
+
+-- Shows the difference between two tar archives, by building the pre maps of 
+-- each of them, and then comparing
+showDiffMap :: FilePath -> FilePath -> IO ()
+showDiffMap newTarFile oldTarFile = do
+  putStrLn $ "Displaying difference between " ++ newTarFile ++ " and " ++ oldTarFile
+  newTar <- loadTar newTarFile
+  oldTar <- loadTar oldTarFile
+  let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
+  let oldMap = buildHackageMap oldTar (buildPreHackageMap oldTar)
+  let diffMap = buildDifferenceMap oldMap newMap
+  mapM_ (print.snd) $ M.toList diffMap
+
+
+-- this method cuts the data from the end of the archive,
+-- because hackage 01-index.tar.gz is not strictly incremental
+cutFile :: FilePath -> Int64 -> IO()
+cutFile path size = do
+  truncateIfExists path size
+  putStrLn $ "Cut " ++ show size ++ " bytes from " ++ path
+
+-- Unzips the gz archive to tar
+unzipArchive :: FilePath -> FilePath -> IO()
+unzipArchive archive tar = do
+  putStrLn $ "Unzipping " ++ archive ++ " to " ++ tar
+  unzipFile archive tar
+
+-- Removes gz and tar files
+removeArchiveFiles :: FilePath -> FilePath -> IO()
+removeArchiveFiles archive tar = do
+  putStrLn $ "Removing archive files " ++ archive ++ " " ++ tar
+  removeIfExists archive
+  removeIfExists tar
+
+-- Compares the two gz archives. Needed to find that the archive was not incremental
+showArchiveCompare :: FilePath -> FilePath -> IO()
+showArchiveCompare archive1 archive2= do
+  val <- compareFiles archive1 archive2
+  putStrLn $ "Compare result " ++ archive1 ++ " " ++ archive2 ++ " " ++ show val
+
+updateArchive :: URL -> URL -> FilePath -> IO UpdateResult
+updateArchive = performArchiveFileUpdate
+
+updateArchiveVoid :: URL -> URL -> FilePath -> IO ()
+updateArchiveVoid snapshotURL archiveURL archive = 
+    void (performArchiveFileUpdate snapshotURL archiveURL archive)
+
+updateTotalArchive :: IO UpdateResult -> IO() -> IO() -> IO ()
+updateTotalArchive update unzip persist = do
+    putStrLn "Performing total update" 
+    result <- update
+    if result == ArchiveIsOk then putStrLn "Nothing to update"
+                             else unzip >> persist
+
+updatePersistentFromTar :: FilePath -> FilePath -> IO()
+updatePersistentFromTar updateDir tarFile = do
+  newTar <- loadTar tarFile
+  let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
+  updatePersistentMap updateDir newMap 
+
+
+showPersistentQuery :: FilePath -> HackageName -> IO()
+showPersistentQuery updateDir name = do
+  putStrLn $ "Querying storage hackage map with " ++ name
+  value <- queryPersistentMap updateDir name
+  case value of 
+    Just package -> do
+      putStrLn "Found"
+      print package
+    Nothing -> putStrLn "Not found"
+
+showPersistentTarCompare :: FilePath -> FilePath -> IO()
+showPersistentTarCompare updateDir tarFile = do
+  newTar <- loadTar tarFile
+  let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
+  printPersistentDiffMap updateDir newMap

REPL/src/HackageUpdate.hs

@@ -2,7 +2,8 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 module HackageUpdate (
                       performArchiveFileUpdate, 
-                      calcUpdateResultIO) where
+                      calcUpdateResultIO, 
+                      UpdateResult(..)) where
 
 import Data.Aeson.Types
 import qualified Data.Aeson as A
@@ -67,7 +68,7 @@ calcUpdateResultIO file json = do
 parseSnapshotJSONThrow :: BL.ByteString -> IO HackageSnapshotData
 parseSnapshotJSONThrow body = case A.decode body of 
   (Just snapshot) -> return snapshot
-  Nothing -> X.throwIO $ UAE "Could not decode JSON"
+  Nothing -> X.throwIO $ UAE "Could not decode hackage JSON"
 
 -- Returns the snapshot of archive from the hackage
 fetchSnapshot :: URL -> IO HackageSnapshotData

REPL/src/IndexProject.hs

@@ -1,12 +1,12 @@
-module IndexProject(HackageUpdateInfo(..), 
+module IndexProject(
-                    HackageName(..),
+                    processREPLCycle
-                    processCycle,
-                    updateHackageMap,
-                    queryHackageMap
                     ) where
 
-import REPL (HackageUpdateInfo(..), processCycle, updateArchive, updateMapFromTar, queryHackageMap)
+import REPL (processREPLCycle)
-import HackageArchive (HackageName (..), HackagePackage(..))
+--import HackageArchive (HackageName (..), HackagePackage(..))
 
-updateHackageMap :: HackageUpdateInfo -> IO ()
+
-updateHackageMap iuh = updateArchive iuh >> updateMapFromTar iuh
+--HackageUpdateInfo(..), 
+--                    HackageName(..),
+--updateHackageMap :: HackageUpdateInfo -> IO ()
+--updateHackageMap iuh = updateArchive iuh >> updateMapFromTar iuh

REPL/src/REPL.hs

@@ -1,253 +1,153 @@
 {-# LANGUAGE OverloadedStrings #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 
-module REPL ( processCycle,
+module REPL ( processREPLCycle ) where 
-              updateArchive,
-              updateMapFromTar,
-              queryHackageMap,
-              HackageUpdateInfo (..)
-              ) where 
 
-import qualified Data.Map.Strict as M
 import qualified Data.Char as DC
 import qualified Control.Exception as X
+
+import Data.List(isPrefixOf)
 import Control.Monad(forever, void)
 import System.IO (stdout, hFlush)
-
-import Data.Int(Int64)
 import System.Exit(exitSuccess)
-import System.Directory(copyFile)
-import System.FilePath((</>))
-import Data.List(isPrefixOf)
 
 import Common
-import HackageArchive
+import qualified HackageCommands as HC
-import HackageUpdate
+import qualified StackageCommands as SC
-import FileUtils
-import HttpDownload
-import Storage
 
-processCycle :: HackageUpdateInfo -> IO ()
+processREPLCycle :: UpdateInfo -> IO ()
-processCycle iuh = forever $ do
+processREPLCycle ui = forever $ do
   putStr "Input command: "
   hFlush stdout
   command <- getLine
   hFlush stdout
   processCommand command `X.catch` eh `X.catch` eh2 `X.catch` eh3
   where 
-    processCommand = buildCommand iuh
+    processCommand = buildCommand ui
     eh (e :: X.IOException) = putStrLn $ "IO Error: " ++ show e
     eh2 (e :: UpdateArchiveException) = putStrLn $ "Parsing error: " ++ show e 
     eh3 (e :: X.ErrorCall) = putStrLn $ "Error call: " ++ show e
 
-buildCommand :: HackageUpdateInfo -> (String -> IO())
+buildCommand :: UpdateInfo -> (String -> IO())
-buildCommand iuh = processCommand
+buildCommand ui = processCommand
   where 
     processCommand command
-      -- checks the current gzip archive and understands what to download
+      -- checks the current hackage gzip archive and understands what to download
-      | chk "checkclone" = showUpdateData archC snapURL
+      | chk "check" = HC.showUpdateData arch snapURL     
-      -- checks the current gzip archive and understands what to download
+      -- updates the gzip archive file, unpacks it to tar and loads in the permanent storage
-      | chk "check" = showUpdateData arch snapURL     
+      | chk "totalupdate" = HC.updateTotalArchive updateCommand unzipCommand persistCommand
+      -- updates the gzip archive file from hackage
+      | chk "update" = HC.updateArchiveVoid snapURL archURL arch 
+      -- shows the snapshot of hackage gzip archive file (md5 and length)
+      | chk "file" = HC.showFileSnapshot arch  
+      -- cuts the end of the hackage gzip archive file for checking purposes
+      | chk "cut" = HC.cutFile arch (parseIntEnd command) 
+      -- unzips the downloaded gzip archive to tar file
+      | chk "unzip" = HC.unzipArchive arch trFile  
+      -- removes the gzip and tar files
+      | chk "clean" = HC.removeArchiveFiles arch trFile
+      -- shows the first 50 pre elements from tar archive
+      | chk "tarshowpre" = HC.showTarPreElements trFile 50  
+      -- shows the first 50 elements from tar archive
+      | chk "tarshow" = HC.showTarElements trFile 50 
+      -- Updates the persistent map from tar archive
+      | chk "tarpersist" = persistCommand
+      -- compares the map from tar archive and the persistent map
+      | chk "cmppersist" = HC.showPersistentTarCompare ud trFile
+      -- shows the package from the persistent map 
+      | chk "querypersist" =  HC.showPersistentQuery ud (parseValEnd command)
 
-      | chk "fileclone" = showFileSnapshot archC
+      -- shows the snapshots from stackage
-      | chk "file" = showFileSnapshot arch  -- shows the snapshot of hackage file
+      | chk "snapshots" = SC.showSnapshots snapshotsURL
-      
+      -- exits the REPL
-      | chk "copyorig" = copyArchive arch archC -- copies the current archive to the orig place
-
-      | chk "cutclone" = cutFile archC (parseIntEnd command) 
-      | chk "cut" = cutFile arch (parseIntEnd command) -- cuts the end of the gzip file for checking purposes
-
-      | chk "unzipclone" = unzipArchive archC trFileC -- unzips the downloaded gzip archive
-      | chk "unzip" = unzipArchive arch trFile  -- unzips the downloaded gzip archive
-
-      | chk "cleanclone" = removeArchiveFiles archC trFileC
-      | chk "clean" = removeArchiveFiles arch trFile
-
-      | chk "tarparsepreclone" = showPreMap trFileC 50 -- loads the tar clone information in the memory
-      | chk "tarparsepre" = showPreMap trFile 50  -- loads the tar information in the memory
-
-      | chk "tarparseclone" = showMap trFileC 50 -- loads the tar clone information in the memory
-      | chk "tarparse" = showMap trFile 50  -- loads the tar information in the memory
-
-      | chk "compare" = showArchiveCompare arch archC 
-      | chk "update" = void $ performArchiveFileUpdate snapURL archURL arch 
-
-      | chk "acidcompare" = printAcidCompare ud trFile
-      | chk "acidupdate" = acidUpdate ud trFile
-      | chk "acidquery" =  showAcidQuery ud (parseValEnd command)
-
-      | chk "tarcmp" = showDiffMap trFile trFileC
       | chk "exit" = exitREPL
+      | chk "quit" = exitREPL
 
-      | chk "help" = showHelp iuh
+      -- shows the help for REPL commands
-      | otherwise = showHelp iuh
+      | chk "help" = showHelp ui
+
+      -- these are the clones of the commands above for the orig files
+      -- You'll probably won't need them, unless you are me (borboss366)
+      -- copies the current hackage archive to other file. Needed for checking properties
+      | chk "system-copyorig" = HC.copyArchive arch archC 
+      | chk "system-checkclone" =  HC.showUpdateData archC snapURL
+      | chk "system-fileclone" = HC.showFileSnapshot archC
+      | chk "system-cutclone" = HC.cutFile archC (parseIntEnd command) 
+      | chk "system-unzipclone" = HC.unzipArchive archC trFileC 
+      | chk "system-cleanclone" = HC.removeArchiveFiles archC trFileC
+      | chk "system-tarshowpreclone" = HC.showTarPreElements trFileC 50 
+      | chk "system-tarshowclone" = HC.showTarElements trFileC 50
+      -- compares the gzip archive with orig archive, that was copied some time before
+      | chk "system-compare" = HC.showArchiveCompare arch archC 
+      -- shows diff map between tar and tar.orig archives
+      | chk "system-tarcmp" = HC.showDiffMap trFile trFileC
+
+      | otherwise = showHelp ui
 
       where pc = map DC.toLower command
             chk val = val `isPrefixOf` pc
 
-            arch = getArchive iuh
+            arch = (getArchive.iuh) ui
-            archC = getArchiveClone iuh 
+            archC = (getArchiveClone.iuh) ui
-            archURL = iuhArchiveURL iuh
+            archURL = (iuhArchiveURL.iuh) ui
-            snapURL = iuhSnapshotURL iuh
+            snapURL = (iuhSnapshotURL.iuh) ui
-            trFile = getTar iuh
+            trFile = (getTar.iuh) ui
-            trFileC = getTarClone iuh
+            trFileC = (getTarClone.iuh) ui
-            ud = iuhUpdateDir iuh
+            ud = (iuhUpdateDir.iuh) ui
 
-showHelp :: HackageUpdateInfo -> IO()
+            snapshotsURL = (getSnapshotURL.sui) ui
-showHelp iuh = do
+
+            updateCommand = HC.updateArchive snapURL archURL arch 
+            unzipCommand = HC.unzipArchive arch trFile 
+            persistCommand = HC.updatePersistentFromTar ud trFile
+
+
+showHelp :: UpdateInfo -> IO()
+showHelp ui = do
   putStrLn "Available commands: "
 
   putStrLn $ "check - downloads the json length and md5 hash from " ++ snapURL ++ 
              ", and compares it with local " ++ arch
-  putStrLn $ "checkclone - same for " ++ archC
   putStrLn $ "file - displays the current " ++ arch ++ " length and md5 hash"
-  putStrLn $ "fileclone - same for " ++ archC ++ " file"
-  putStrLn $ "copyorig - copy the " ++ arch ++ " to " ++ archC
   putStrLn $ "cut size - cuts the size bytes from the end of the " ++ arch ++ " , for update command"
-  putStrLn "cutclone size - cuts the size bytes from the end of the 01-index.tar.gz, for update command"
   putStrLn $ "unzip - unzips the " ++ arch ++ " in the " ++ trFile ++ " file"
-  putStrLn $ "unzipclone - unzips the " ++ archC ++ " in the " ++ trFileC ++ " file"
   putStrLn $ "clean - deletes the " ++ arch ++ " and " ++ trFile
-  putStrLn $ "cleanclone - deletes the " ++ archC ++ " and " ++ trFileC
-  putStrLn $ "compare - compares the " ++ arch ++ " with " ++ archC
-  putStrLn $ "tarparse - loads the map of entries from " ++ trFile ++ " and displays it" 
-  putStrLn $ "tarparseclone - same for " ++ trFileC
-  putStrLn $ "tarparsepre - loads the  premap of entries from " ++ trFile ++ " and displays it" 
-  putStrLn $ "tarparsepreclone - same for " ++ trFileC
-  putStrLn $ "tarcmp - compares the entries of " ++ trFile ++ " and " ++ trFileC
   putStrLn $ "update - updates the current " ++ arch ++ " from " ++ archURL
-  putStrLn $ "acidcompare - compares the state of " ++ trFile ++ " with map from acid state"
+  putStrLn $ "totalupdate - updates the current " ++ arch ++ " from " ++ archURL
+  putStrLn $ "tarshow - loads the map of entries from " ++ trFile ++ " and displays it" 
+  putStrLn $ "tarshowpre - loads the  premap of entries from " ++ trFile ++ " and displays it" 
+  putStrLn $ "cmppersist - compares the state of " ++ trFile ++ " with map from persistent storage"
+  putStrLn $ "tarpersist - updates the persistent storage with " ++ trFile
+  putStrLn "querypersist name - queries the persistent storage with package"
+
+  putStrLn $ "snapshots - show the stackage snapshots from " ++ snapshotsURL
+
+  putStrLn "exit - exits this repl"
+  putStrLn "help - shows this help"
+
+{-
+  putStrLn $ "compare - compares the " ++ arch ++ " with " ++ archC
+  putStrLn $ "tarcmp - compares the entries of " ++ trFile ++ " and " ++ trFileC
+
+  putStrLn $ "acidcmp - compares the state of " ++ trFile ++ " with map from acid state"
   putStrLn $ "acidupdate - updates the acid state with " ++ trFile
   putStrLn "acidquery name - queries the acid with package"
-  putStrLn "exit - exits this repl"
+  putStrLn $ "checkclone - same for " ++ archC
-
+    putStrLn $ "fileclone - same for " ++ archC ++ " file"
+  putStrLn $ "copyorig - copy the " ++ arch ++ " to " ++ archC
+  putStrLn "cutclone size - cuts the size bytes from the end of the 01-index.tar.gz, for update command"
+  putStrLn $ "unzipclone - unzips the " ++ archC ++ " in the " ++ trFileC ++ " file"
+  putStrLn $ "cleanclone - deletes the " ++ archC ++ " and " ++ trFileC
+-}
   where 
-    arch = getArchive iuh
+    arch = (getArchive.iuh) ui
-    archC = getArchiveClone iuh 
+    archC = (getArchiveClone.iuh) ui
-    archURL = iuhArchiveURL iuh
+    archURL = (iuhArchiveURL.iuh) ui
-    snapURL = iuhSnapshotURL iuh
+    snapURL = (iuhSnapshotURL.iuh) ui
-    trFile = getTar iuh
+    trFile = (getTar.iuh) ui
-    trFileC = getTarClone iuh
+    trFileC = (getTarClone.iuh) ui
-
+    snapshotsURL = (getSnapshotURL.sui) ui
-
--- Displays the snapshot of the file
-showFileSnapshot :: FilePath -> IO()
-showFileSnapshot file = do
-  filesnapshot <- calcFileData file
-  putStrLn $ "File result for " ++ file
-  putStrLn $ "\tFile snapshot: " ++ show filesnapshot
-
--- Shows the update data for the archive on disk
-showUpdateData :: FilePath -> URL -> IO()
-showUpdateData file json = do
-  (range, snapshot, filesnapshot) <- calcUpdateResultIO file json
-  putStrLn $ "Update result for file " ++ file
-  putStrLn $ "\tHackage snapshot: " ++ show snapshot
-  putStrLn $ "\tFile snapshot: " ++ show filesnapshot
-  putStrLn $ "\tRange to update: " ++ show range
-
--- shows the substring of specified length from file from offset 
-showFileSubstring :: FilePath -> Int64 -> Int64 -> IO ()
-showFileSubstring file from length = do
-  putStrLn $ "Showing " ++ file ++ " substr"
-  putStr "\t"
-  substr <- getFileSubstring file from length
-  print substr
-
--- Copies the archive from first filename to the second
-copyArchive :: FilePath -> FilePath -> IO ()
-copyArchive archive1 archive2 = do
-  copyFile archive1 archive2
-  putStrLn $ "Copied the " ++ archive1 ++ " to " ++ archive2
-
-showMap :: FilePath -> Int -> IO ()
-showMap path count = do
-  putStrLn $ "Displaying " ++ show count ++ " entries for " ++ path
-  tar <- loadTar path
-  mapM_ (print.snd) $ take count $ M.toList $ buildHackageMap tar (buildPreHackageMap tar)
-
-showPreMap :: FilePath -> Int -> IO ()
-showPreMap path count = do
-  putStrLn $ "Pre displaying " ++ show count ++ " entries for " ++ path
-  tar <- loadTar path
-  mapM_ print $ take count $ {-filter ((elem '-').fst) $-} M.toList $ buildPreHackageMap tar
-
-
-showDiffMap :: FilePath -> FilePath -> IO ()
-showDiffMap newTarFile oldTarFile = do
-  putStrLn $ "Displaying difference between " ++ newTarFile ++ " and " ++ oldTarFile
-  newTar <- loadTar newTarFile
-  oldTar <- loadTar oldTarFile
-  let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
-  let oldMap = buildHackageMap oldTar (buildPreHackageMap oldTar)
-  let diffMap = buildDifferenceMap oldMap newMap
-  mapM_ (print.snd) $ M.toList diffMap
-
-showArchiveCompare :: FilePath -> FilePath -> IO()
-showArchiveCompare archive1 archive2= do
-  val <- compareFiles archive1 archive2
-  putStrLn $ "Compare result " ++ archive1 ++ " " ++ archive2 ++ " " ++ show val
-
-showAcidQuery :: FilePath -> HackageName -> IO()
-showAcidQuery updateDir name = do
-  putStrLn $ "Querying acid with " ++ name
-  value <- queryAcidMap updateDir name
-  case value of 
-    Just package -> do
-      putStrLn "Found"
-      print package
-    Nothing -> putStrLn "Not found"
 
 
 exitREPL :: IO()
-exitREPL = putStrLn "Finished working with hackage REPL" >> exitSuccess
+exitREPL = putStrLn "Finished working with hackage REPL" >> exitSuccess
-
--- this method cuts the data from the end of the archive
--- needed mostly for testing purposes
-cutFile :: FilePath -> Int64 -> IO()
-cutFile path size = do
-  truncateIfExists path size
-  putStrLn $ "Cut " ++ show size ++ " bytes from " ++ path
-
-unzipArchive :: FilePath -> FilePath -> IO()
-unzipArchive archive tar = do
-  putStrLn $ "Unzipping " ++ archive ++ " to " ++ tar
-  unzipFile archive tar
-
-removeArchiveFiles :: FilePath -> FilePath -> IO()
-removeArchiveFiles archive tar = do
-  putStrLn $ "Removing archive files " ++ archive ++ " " ++ tar
-  removeIfExists archive
-  removeIfExists tar
-
-printAcidCompare :: FilePath -> FilePath -> IO()
-printAcidCompare updateDir tarFile = do
-  newTar <- loadTar tarFile
-  let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
-  printAcidDiffMap updateDir newMap
-
-acidUpdate :: FilePath -> FilePath -> IO()
-acidUpdate updateDir tarFile = do
-  newTar <- loadTar tarFile
-  let newMap = buildHackageMap newTar (buildPreHackageMap newTar)
-  updateAcidMap updateDir newMap 
-
-updateArchive :: HackageUpdateInfo -> IO()
-updateArchive iuh = void (performArchiveFileUpdate snapURL archURL arch)
-  where 
-    arch = getArchive iuh
-    archURL = iuhArchiveURL iuh
-    snapURL = iuhSnapshotURL iuh
-
-updateMapFromTar :: HackageUpdateInfo -> IO()
-updateMapFromTar iuh = acidUpdate (iuhUpdateDir iuh) (getTar iuh)
-
-queryHackageMap :: HackageUpdateInfo -> HackageName -> IO (Maybe HackagePackage)
-queryHackageMap iuh = queryAcidMap (iuhUpdateDir iuh) 
-
-
-
-
-
-
-

REPL/src/Stackage.hs

@@ -19,21 +19,11 @@ import Control.Applicative(empty)
 import Common
 
 type ConstraintMap = M.Map PackageName PackageData
-type ShortSnapshotName = String
-type LongSnapshotName = String
-type StackageSnapshot = (ShortSnapshotName, LongSnapshotName)
-
-shortName :: StackageSnapshot -> String
-shortName = fst
-
-longName :: StackageSnapshot -> String
-longName = snd
-
-type StackageLTS = (LongSnapshotName, [PackageData])
 
 parseStackageLTS :: Parser StackageLTS
 parseStackageLTS = do
   ltsName <- parseLTS
+  eol
   manyTill anyChar (string "constraints:")
   packages <- many parsePackageLine
   pure (ltsName, packages)
@@ -52,7 +42,7 @@ parsePackageLine = do
   version <- parseVersionVer
   many (char ',') 
   space
-  pure (name, version)
+  pure (name, Specified version)
 
 -- unfortunately the cabal.config does not provide versions for several packages
 -- And writes tehn in form 'binary installed'

REPL/src/StackageCommands.hs

@@ -0,0 +1,11 @@
+module StackageCommands(
+                        showSnapshots) where
+
+import Common              
+import StackageUpdate
+
+showSnapshots :: URL -> IO()
+showSnapshots url = do
+    SSS snapshots <- fetchStackageSnapshots url
+    putStrLn $ "Showing snapshots from " ++ url
+    mapM_ (putStrLn.(\s -> "\tSnapshot: " ++ s).show) snapshots

REPL/src/StackageUpdate.hs

@@ -0,0 +1,49 @@
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE ScopedTypeVariables #-}
+
+module StackageUpdate(fetchStackageSnapshots) where
+
+import Data.Traversable
+import Data.Aeson.Types
+import qualified Data.Aeson as A
+import qualified Data.Aeson.Parser as AP
+import qualified Data.Text as T
+import qualified Control.Exception as X
+import qualified Data.ByteString.Lazy as BL
+import qualified Data.HashMap.Strict as HM
+import Network.HTTP.Client(parseUrlThrow)
+
+import Common
+import HttpDownload
+
+instance FromJSON StackageSnapshots where
+  parseJSON = withObject "snapshots" $ \o ->
+    -- I have 'o', which is a HashMap. 
+    SSS <$> (for (HM.toList o) $ \(shortName, longNameVal) -> do 
+        longName <- parseJSON longNameVal
+        return (T.unpack shortName, longName))
+
+-- The method, that raises an exception, if it was not able to parse the
+-- snapshot from JSON
+parseSnapshotJSONThrow :: BL.ByteString -> IO StackageSnapshots
+parseSnapshotJSONThrow body = case A.decode body of 
+  (Just snapshots) -> return snapshots
+  Nothing -> X.throwIO $ UAE "Could not decode stackage JSON"
+
+fetchStackageSnapshots :: URL -> IO StackageSnapshots
+fetchStackageSnapshots url = parseUrlThrow url >>= fetchResponseData >>= parseSnapshotJSONThrow
+
+{-
+parseReferers :: Value -> Parser StackageSnapshots
+parseReferers = withObject "referers" $ \o ->
+    -- Now we have 'o', which is a HashMap. We can use HM.toList to turn it
+    -- into a list of pairs (domain, referer) and then parse each referer:
+    for (HM.toList o) $ \(domain, referer) -> do
+      -- accesses :: [(Text, Int)]
+      accesses <- HM.toList <$> parseJSON referer
+      -- accesses' :: [(String, Int)]
+      let accesses' = map (\(page, n) -> (T.unpack page, n)) accesses
+      return $ Referer {
+        domain       = T.unpack domain,
+        pathAccesses = accesses' }
+-}

REPL/src/Storage.hs

@@ -1,73 +0,0 @@
-{-# LANGUAGE TypeFamilies       #-}
-{-# LANGUAGE DeriveDataTypeable #-}
-{-# LANGUAGE TemplateHaskell    #-}
-
--- This is modified example from AcidState
-module Storage (
-                printAcidDiffMap,
-                updateAcidMap,
-                queryAcidMap) where
-
-import Data.Typeable
-import Data.Acid
-import Data.Acid.Advanced
-import Data.SafeCopy
-import Control.Monad.Reader
-
-import qualified Data.Map as M
-import qualified Control.Monad.State  as State
-
-import HackageArchive
-import qualified Data.Version as DV
-
-newtype KeyValue = KeyValue HackageMap deriving (Typeable)
-
-$(deriveSafeCopy 0 'base ''DV.Version)
-$(deriveSafeCopy 0 'base ''HackagePackage)
-$(deriveSafeCopy 0 'base ''KeyValue)
-$(deriveSafeCopy 0 'base ''HackageUpdate)
-
-insertKey :: HackageName -> HackagePackage -> Update KeyValue ()
-insertKey key value = do 
-  KeyValue hackageMap <- State.get
-  State.put (KeyValue (M.insert key value hackageMap))
-
-updateMap :: HackageMap -> Update KeyValue ()
-updateMap newMap = State.put (KeyValue newMap)
-
-lookupKey :: HackageName -> Query KeyValue (Maybe HackagePackage)
-lookupKey key = do
-  KeyValue m <- ask
-  return (M.lookup key m)
-
-compareMap :: HackageMap -> Query KeyValue HackageUpdateMap
-compareMap newMap = do
-  KeyValue oldMap <- ask
-  return (buildDifferenceMap oldMap newMap)
-
-$(makeAcidic ''KeyValue ['insertKey, 'lookupKey, 'compareMap, 'updateMap])
-
-printAcidDiffMap :: FilePath -> HackageMap -> IO ()
-printAcidDiffMap path newMap = do
-  acid <- openLocalStateFrom path (KeyValue M.empty)
-  do
-    diffMap <- query acid (CompareMap newMap)
-    putStrLn "Printing difference map with acid-state"
-    mapM_ (print.snd) $ M.toList diffMap
-  closeAcidState acid
-
-updateAcidMap :: FilePath -> HackageMap -> IO ()
-updateAcidMap path newMap = do
-  acid <- openLocalStateFrom path (KeyValue M.empty)
-  do
-    putStrLn "Updating the acid map"
-    update acid (UpdateMap newMap) 
-  closeAcidState acid
-
-queryAcidMap :: FilePath -> HackageName -> IO (Maybe HackagePackage)
-queryAcidMap path name = do
-  acid <- openLocalStateFrom path (KeyValue M.empty)
-  val <- query acid (LookupKey name)
-  closeAcidState acid
-  return val
-    

REPL/test/Spec.hs

@@ -31,14 +31,6 @@ testPath text val match = testCase (T.unpack ("Parsing " <> expect match <> " \'
 
 parseStackageTests = testGroup "Stackage parsing tests"
   [
-{-
-    testParse parsePackageLine "constraints: abstract-deque ==0.3," True
-    , testParse parsePackageLine "constraints: abstract-deque ==0.3" True
-    , testParse parsePackageLine "constraints: abstract-deque ==0." False
-    , testParse parsePackageLine "constraints: abstract-deque ==" False
-    , testParse parsePackageLine "constraints: abst3453#$%#ract-deque ==0.3" False
-    , testParse parsePackageLine "constraints: abstract-deque ==0.3," True
--}
     testParse parsePackageLine "              ztail ==1.2" True
     , testParse parsePackageLine "             adjunctions ==4.3," True
     , testParse parsePackageLine "ztail ==1.2" True
@@ -57,18 +49,27 @@ parseStackageTests = testGroup "Stackage parsing tests"
 
 parseCabalConfig = testGroup "Cabal config parsing tests"
   [
-    testStackagePackageLines "sometestfile.cnf"
+    testStackagePackageLines parseStackageLTS "sometestfile.cnf"
+    , testStackagePackageLines parseStackageLTS "sometestfile2.cnf"
+    , testFileJustParse parseStackageLTS "sometestfile3.cnf" True
   ]
 
-testStackagePackageLines file = testFileParse (testWorkingDir </> file) 
+-- Well this is code duplication. Somehow need to use testParse function here
-  parseStackageLTS countPackageLines matchWithStackageLTS
 
+testFileJustParse :: Parser a -> FilePath -> Bool -> TestTree
+testFileJustParse p file match = testCase ("Testing file: " ++ file) $ do 
+  fileText <- TIO.readFile (testWorkingDir </> file)
+  assertBool "Failed" (isRight (runParser p "" fileText) == match)
+
+testStackagePackageLines :: Parser StackageLTS -> FilePath -> TestTree
+testStackagePackageLines p file = testFileParse (testWorkingDir </> file) 
+  p countPackageLines matchWithStackageLTS
 
--- refactor isComment
 countPackageLines :: T.Text -> Int
-countPackageLines text = length $ filter isComment lns
+countPackageLines text = length $ filter isPackageLine lns
   where lns = T.lines text
-        isComment ln = not ("--" `T.isInfixOf` ln)
+        isPackageLine ln = not ("--" `T.isInfixOf` ln) 
+          && (("installed" `T.isInfixOf` ln) || ("==" `T.isInfixOf` ln))
 
 matchWithStackageLTS :: Int -> StackageLTS -> Bool
 matchWithStackageLTS count1 stackage = count1 == (length.snd) stackage

REPL/testworkdir/sometestfile2.cnf

@@ -0,0 +1,12 @@
+-- Stackage snapshot from: http://www.stackage.org/snapshot/lts-2.10
+-- Please place this file next to your .cabal file as cabal.config
+-- To only use tested packages, uncomment the following line:
+-- remote-repo: stackage-lts-2.10:http://www.stackage.org/lts-2.10
+constraints: abstract-deque ==0.3,
+
+
+
+
+
+
+   

REPL/testworkdir/sometestfile3.cnf

@@ -0,0 +1,12 @@
+-- Stackage snapshot from: http://www.stackage.org/snapshot/lts-2.10ZZZ
+-- Please place this file next to your .cabal file as cabal.config
+-- To only use tested packages, uncomment the following line:
+-- remote-repo: stackage-lts-2.10:http://www.stackage.org/lts-2.10
+constraints: abstract-deque ==0.3,
+
+
+
+
+
+
+