List installed packages from a repository

2 files changed, 31 insertions, 35 deletions

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