diff --git a/lib/SlackBuilder/Info.hs b/lib/SlackBuilder/Info.hs index e2f5018..59342cc 100644 --- a/lib/SlackBuilder/Info.hs +++ b/lib/SlackBuilder/Info.hs @@ -7,6 +7,7 @@ module SlackBuilder.Info ( PackageInfo(..) , generate , parseInfoFile + , readInfoFile ) where import Control.Applicative (Alternative(..)) @@ -26,7 +27,7 @@ import Crypto.Hash (Digest, MD5, digestFromByteString) import Data.Void (Void) import Data.Word (Word8) import Numeric (readHex, showHex) -import Text.Megaparsec (Parsec, count, eof, takeWhile1P) +import Text.Megaparsec (Parsec, count, eof, parse, takeWhile1P) import Text.Megaparsec.Byte (space, string, hexDigitChar) import Text.URI ( URI(..) @@ -34,6 +35,14 @@ import Text.URI , render ) import qualified Data.Word8 as Word8 +import SlackBuilder.Trans + ( SlackBuilderT(..) + , SlackBuilderException(..) + , relativeToRepository + ) +import System.FilePath ((), (<.>)) +import Control.Monad.IO.Class (MonadIO(..)) +import Conduit (MonadThrow(throwM)) type GenParser = Parsec Void ByteString @@ -110,6 +119,17 @@ parseInfoFile = PackageInfo . Char8.unpack *> packageName <* "\"\n" +readInfoFile :: Text -> Text -> SlackBuilderT PackageInfo +readInfoFile category packageName' = do + let packageName'' = Text.unpack packageName' + + infoPath <- relativeToRepository + $ Text.unpack category packageName'' packageName'' <.> "info" + infoContents <- liftIO $ ByteString.readFile infoPath + + either (throwM . MalformedInfoFile) pure + $ parse parseInfoFile infoPath infoContents + generate :: PackageInfo -> Text generate pkg = Lazy.Text.toStrict $ Text.Builder.toLazyText builder where 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/lib/SlackBuilder/Trans.hs b/lib/SlackBuilder/Trans.hs index dea0d4b..f5697e1 100644 --- a/lib/SlackBuilder/Trans.hs +++ b/lib/SlackBuilder/Trans.hs @@ -10,6 +10,7 @@ module SlackBuilder.Trans ) where import Control.Monad.Trans.Reader (ReaderT(..), asks) +import Data.ByteString (ByteString) import Data.Text (Text) import qualified Data.Text as Text import SlackBuilder.Config @@ -20,11 +21,14 @@ import System.FilePath (()) import Text.URI (URI) import qualified Text.URI as URI import qualified Codec.Compression.Lzma as Lzma +import Text.Megaparsec (ParseErrorBundle(..), errorBundlePretty) +import Conduit (Void) data SlackBuilderException = UpdaterNotFound Text | UnsupportedUrlType URI | LzmaDecompressionFailed Lzma.LzmaRet + | MalformedInfoFile (ParseErrorBundle ByteString Void) deriving Show instance Exception SlackBuilderException @@ -55,6 +59,8 @@ instance Exception SlackBuilderException "No progress is possible" displayException (LzmaDecompressionFailed Lzma.LzmaRetProgError) = "Programming error" + displayException (MalformedInfoFile errorBundle) = + errorBundlePretty errorBundle newtype SlackBuilderT a = SlackBuilderT { runSlackBuilderT :: ReaderT Settings IO a 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..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