diff --git a/lib/SlackBuilder/Package.hs b/lib/SlackBuilder/Package.hs index 5179c4c..c87bf4b 100644 --- a/lib/SlackBuilder/Package.hs +++ b/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] diff --git a/slackbuilder.cabal b/slackbuilder.cabal index f6cd1cb..9edf43a 100644 --- a/slackbuilder.cabal +++ b/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 diff --git a/src/Main.hs b/src/Main.hs index 2f328f7..8e6b296 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,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 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..07dba02 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 @@ -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