List installed packages from a repository

lib/SlackBuilder/Package.hs

@@ -5,7 +5,8 @@
 -- | Contains data describing packages, methods to update them and to request
 -- information about them.
 module SlackBuilder.Package
-    ( Download(..)
+    ( DataBaseEntry(..)
+    , Download(..)
     , DownloadTemplate(..)
     , PackageDescription(..)
     , PackageUpdateData(..)
@@ -66,3 +67,15 @@ data Updater = Updater
     , is64 :: Bool
     , getVersion :: Text -> Text -> SlackBuilderT Download
     }
+
+data DataBaseEntry = DataBaseEntry
+    { name :: Text
+    , version :: Text
+    , arch :: Text
+    , build :: Text
+    } deriving Eq
+
+instance Show DataBaseEntry
+  where
+    show DataBaseEntry{..} = Text.unpack
+        $ Text.intercalate "-" [name, version, arch, build]

slackbuilder.cabal

@@ -76,7 +76,7 @@ library
   hs-source-dirs: lib
   ghc-options: -Wall
   build-depends:
-  	mono-traversable ^>= 1.0.17
+    mono-traversable ^>= 1.0.17
 
 executable slackbuilder
   import: dependencies

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,8 @@ 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
 
 autoUpdatable :: [PackageSettings] -> [PackageDescription]
 autoUpdatable = mapMaybe go
@@ -97,6 +100,28 @@ 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")
+    liftIO $ traverse_ print $ HashMap.intersection database listing
+  where
+    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 +141,4 @@ main = execParser slackBuilderParser
     executeCommand = \case
         CheckCommand -> check
         Up2DateCommand packageName -> up2Date packageName
+        InstalledCommand -> installed

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

src/SlackBuilder/Update.hs

@@ -8,6 +8,7 @@ module SlackBuilder.Update
     , downloadWithTemplate
     , getAndLogLatest
     , handleException
+    , listRepository
     , repackageWithTemplate
     , reuploadWithTemplate
     , updatePackageIfRequired
@@ -19,6 +20,8 @@ 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)
@@ -74,8 +77,7 @@ 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
@@ -252,19 +254,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