List installed packages from a repository

3 files changed, 61 insertions, 35 deletions

diff --git a/src/Main.hs b/src/Main.hs
index 2f328f7..3ac5745 100644
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -17,6 +17,7 @@ import SlackBuilder.LatestVersionCheck
 import SlackBuilder.Update
 import qualified Toml
 import Data.Text (Text)
+import qualified Data.Text as Text
 import qualified Data.Text.IO as Text
 import Control.Monad.Trans.Reader (ReaderT(..), asks)
 import SlackBuilder.Package (PackageDescription(..), renderTextWithVersion)
@@ -32,6 +33,9 @@ import System.Console.ANSI
     )
 import Data.Maybe (mapMaybe)
 import qualified Text.URI as URI
+import System.Directory (listDirectory)
+import qualified Data.HashMap.Strict as HashMap
+import SlackBuilder.Info (readInfoFile)
 
 autoUpdatable :: [PackageSettings] -> [PackageDescription]
 autoUpdatable = mapMaybe go
@@ -97,6 +101,31 @@ check = SlackBuilderT (asks (getField @"packages"))
         >>= mapM_ checkUpdateAvailability
         >> liftIO (putStrLn "")
 
+installed :: SlackBuilderT ()
+installed = do
+    listing <- listRepository
+    database <- foldr createDataBase HashMap.empty . mapMaybe createEntry
+        <$> liftIO (listDirectory "/var/lib/pkgtools/packages")
+    traverse_ findInfo $ HashMap.intersectionWith (,) database listing
+  where
+    findInfo (installed'@Package.DataBaseEntry{ name }, fromRepository) = do
+        _ <- readInfoFile fromRepository name
+        liftIO $ print installed'
+    createDataBase entry@Package.DataBaseEntry{ name } =
+        HashMap.insert name entry
+    createEntry filename = createEntryFromChunks
+        $ Text.split (== '-')
+        $ Text.reverse
+        $ Text.pack filename
+    createEntryFromChunks (build : arch : version : name) = Just
+        Package.DataBaseEntry
+            { arch = Text.reverse arch
+            , build = Text.reverse build
+            , version = Text.reverse version
+            , name =  Text.reverse (Text.intercalate "-" name)
+            }
+    createEntryFromChunks _ = Nothing
+
 main :: IO ()
 main = execParser slackBuilderParser
     >>= handle handleException . withCommandLine
@@ -116,3 +145,4 @@ main = execParser slackBuilderParser
     executeCommand = \case
         CheckCommand -> check
         Up2DateCommand packageName -> up2Date packageName
+        InstalledCommand -> installed
diff --git a/src/SlackBuilder/CommandLine.hs b/src/SlackBuilder/CommandLine.hs
index e06a40e..3163fb9 100644
--- a/src/SlackBuilder/CommandLine.hs
+++ b/src/SlackBuilder/CommandLine.hs
@@ -25,6 +25,7 @@ import Options.Applicative
 data SlackBuilderCommand
     = CheckCommand
     | Up2DateCommand (Maybe Text)
+    | InstalledCommand
 
 slackBuilderParser :: ParserInfo SlackBuilderCommand
 slackBuilderParser = info slackBuilderCommand fullDesc
@@ -33,7 +34,9 @@ slackBuilderCommand :: Parser SlackBuilderCommand
 slackBuilderCommand = subparser
     $ command "check" (info checkCommand mempty)
     <> command "up2date" (info up2DateCommand mempty)
+    <> command "installed" (info installedCommand mempty)
   where
     checkCommand = pure CheckCommand
     up2DateCommand = Up2DateCommand
         <$> optional (argument str (metavar "PKGNAM"))
+    installedCommand = pure InstalledCommand
diff --git a/src/SlackBuilder/Update.hs b/src/SlackBuilder/Update.hs
index 773903d..79964b8 100644
--- a/src/SlackBuilder/Update.hs
+++ b/src/SlackBuilder/Update.hs
@@ -8,6 +8,7 @@ module SlackBuilder.Update
     , downloadWithTemplate
     , getAndLogLatest
     , handleException
+    , listRepository
     , repackageWithTemplate
     , reuploadWithTemplate
     , updatePackageIfRequired
@@ -17,8 +18,9 @@ import Control.Exception (Exception(..), SomeException(..))
 import Control.Monad.Catch (MonadCatch(..))
 import Control.Monad.IO.Class (MonadIO(..))
 import Control.Monad.Trans.Reader (asks)
-import qualified Data.ByteString as ByteString
 import Data.Foldable (Foldable(..), find)
+import Data.HashMap.Strict (HashMap)
+import qualified Data.HashMap.Strict as HashMap
 import qualified Data.List.NonEmpty as NonEmpty
 import Data.Maybe (fromJust, fromMaybe)
 import Data.Text (Text)
@@ -48,7 +50,6 @@ import SlackBuilder.Info
 import SlackBuilder.Package (PackageDescription(..), PackageUpdateData(..))
 import qualified SlackBuilder.Package as Package
 import SlackBuilder.Trans
-import Text.Megaparsec (parse, errorBundlePretty)
 import Text.URI (URI(..))
 import qualified Text.URI as URI
 import System.Directory
@@ -74,41 +75,32 @@ getAndLogLatest description = do
     let PackageDescription{ latest = Package.Updater{ detectLatest }, name } = description
     liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.")
     detectedVersion <- detectLatest
-    category <- fmap Text.pack
-        <$> findCategory (Text.unpack name)
+    category <- HashMap.lookup name <$> listRepository
     pure $ PackageUpdateData description
         <$> category
         <*> detectedVersion
 
 checkUpdateAvailability :: PackageUpdateData -> SlackBuilderT (Maybe PackageInfo)
 checkUpdateAvailability PackageUpdateData{..} = do
-    let name' = Text.unpack $ getField @"name" description
-        packagePath = Text.unpack category </> name' </> (name' <.> "info")
-    repository' <- SlackBuilderT $ asks repository
-    infoContents <- liftIO $ ByteString.readFile $ repository' </> packagePath
+    parsedInfoFile <- readInfoFile category $ getField @"name" description
 
-    case parse parseInfoFile packagePath infoContents of
-        Right parsedInfoFile
-            | version == getField @"version" parsedInfoFile ->
-                liftIO $ do
-                    setSGR [SetColor Foreground Dull Green]
-                    Text.IO.putStrLn
-                        $ getField @"name" description <> " is up to date (Version " <> version <> ")."
-                    setSGR [Reset]
-                    pure Nothing
-            | otherwise ->
-                liftIO $ do
-                    setSGR [SetColor Foreground Dull Yellow]
-                    Text.IO.putStr
-                        $ "A new version of "
-                        <> getField @"name" description
-                        <> " " <> getField @"version" parsedInfoFile
-                        <> " is available (" <> version <> ")."
-                    setSGR [Reset]
-                    putStrLn ""
-                    pure $ Just parsedInfoFile
-        Left errorBundle -> liftIO (putStr $ errorBundlePretty errorBundle)
-            >> pure Nothing
+    if version == getField @"version" parsedInfoFile
+    then liftIO $ do
+        setSGR [SetColor Foreground Dull Green]
+        Text.IO.putStrLn
+            $ getField @"name" description <> " is up to date (Version " <> version <> ")."
+        setSGR [Reset]
+        pure Nothing
+    else liftIO $ do
+        setSGR [SetColor Foreground Dull Yellow]
+        Text.IO.putStr
+            $ "A new version of "
+            <> getField @"name" description
+            <> " " <> getField @"version" parsedInfoFile
+            <> " is available (" <> version <> ")."
+        setSGR [Reset]
+        putStrLn ""
+        pure $ Just parsedInfoFile
 
 updatePackageIfRequired :: PackageUpdateData -> SlackBuilderT ()
 updatePackageIfRequired updateData
@@ -252,19 +244,20 @@ updatePackage PackageUpdateData{..} info = do
 
     commit packagePath version
 
-findCategory :: FilePath -> SlackBuilderT (Maybe FilePath)
-findCategory packageName = do
+listRepository :: SlackBuilderT (HashMap Text Text)
+listRepository = do
     repository' <- SlackBuilderT $ asks repository
-    go repository' [] "" <&> fmap fst . find ((packageName ==) . snd)
+    listing <- go repository' [] ""
+    pure $ HashMap.fromList $ bimap Text.pack Text.pack <$> listing
   where
     go currentDirectory found accumulatedDirectory = do
         let fullDirectory = currentDirectory </> accumulatedDirectory
         contents <- liftIO $ listDirectory fullDirectory
         case find (isSuffixOf ".info") contents of
             Just _ ->
-                let result = first dropTrailingPathSeparator
+                let (category, packageName) = first dropTrailingPathSeparator
                         $ splitFileName accumulatedDirectory
-                 in pure $ result : found
+                 in pure $ (packageName, category) : found
             Nothing ->
                 let accumulatedDirectories = (accumulatedDirectory </>)
                         <$> filter (not . isPrefixOf ".") contents