diff options
Diffstat (limited to 'app')
| -rw-r--r-- | app/Main.hs | 83 | ||||
| -rw-r--r-- | app/SlackBuilder/CommandLine.hs | 11 |
2 files changed, 79 insertions, 15 deletions
diff --git a/app/Main.hs b/app/Main.hs index 27ae118..1ee4550 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -7,7 +7,7 @@ import Control.Applicative (Applicative(liftA2)) import Data.List.NonEmpty (NonEmpty(..)) import qualified Data.List.NonEmpty as NonEmpty import Control.Monad.IO.Class (MonadIO(..)) -import Data.Maybe (fromJust, fromMaybe) +import Data.Maybe (fromJust) import Options.Applicative (execParser) import SlackBuilder.CommandLine import SlackBuilder.Config @@ -23,9 +23,9 @@ import SlackBuilder.Download import SlackBuilder.Package (Package(..)) import qualified SlackBuilder.Package as Package import Text.URI (mkURI) -import Data.Foldable (for_) +import Data.Foldable (for_, find) import qualified Text.URI as URI -import System.FilePath ((</>), (<.>), dropExtension, takeBaseName) +import System.FilePath ((</>), (<.>), dropExtension, takeBaseName, makeRelative, splitFileName) import SlackBuilder.Info import Text.Megaparsec (parse, errorBundlePretty) import GHC.Records (HasField(..)) @@ -37,6 +37,16 @@ import System.Process , withCreateProcess , waitForProcess ) +import System.Console.ANSI + ( setSGR + , SGR(..) + , ColorIntensity(..) + , Color(..) + , ConsoleLayer(..) + ) +import System.Directory (listDirectory, doesDirectoryExist) +import Control.Monad (filterM) +import Data.List (isPrefixOf, isSuffixOf) autoUpdatable :: [Package] autoUpdatable = @@ -168,12 +178,51 @@ autoUpdatable = , name = "webex" , reupload = Nothing } + , Package + { latest = + let ghArguments = GhArguments + { owner = "librsync" + , name = "librsync" + , transform = Nothing + } + latest' = latestGitHub ghArguments $ Text.stripPrefix "v" + template = Package.DownloadTemplate + $ Package.StaticPlaceholder "https://github.com/librsync/librsync/archive/v" + :| Package.VersionPlaceholder + : Package.StaticPlaceholder "/librsync-" + : Package.VersionPlaceholder + : [Package.StaticPlaceholder ".tar.gz"] + in Package.Updater latest' template + , category = "libraries" + , name = "librsync" + , reupload = Just mempty + } + , Package + { latest = + let textArguments = TextArguments + { textURL = "https://downloads.dlang.org/releases/LATEST" + , versionPicker = Text.strip + } + latest' = latestText textArguments + template = Package.DownloadTemplate + $ Package.StaticPlaceholder "https://downloads.dlang.org/releases/2.x/" + :| Package.VersionPlaceholder + : Package.StaticPlaceholder "/dmd." + : Package.VersionPlaceholder + : [Package.StaticPlaceholder ".linux.tar.xz"] + in Package.Updater latest' template + , category = "development" + , name = "dmd" + , reupload = Nothing + } ] up2Date :: SlackBuilderT () up2Date = for_ autoUpdatable go where - go package = getAndLogLatest package >>= mapM_ (updatePackageIfRequired package) + go package = getAndLogLatest package + >>= mapM_ (updatePackageIfRequired package) + >> liftIO (putStrLn "") getAndLogLatest Package{ latest = Package.Updater getLatest _, name } = liftIO (putStrLn $ Text.unpack name <> ": Retreiving the latest version.") >> getLatest @@ -187,8 +236,11 @@ updatePackageIfRequired package@Package{..} version = do case parse parseInfoFile packagePath infoContents of Right parsedInfoFile | version == getField @"version" parsedInfoFile -> - liftIO $ Text.IO.putStrLn - $ name <> " is up to date (Version " <> version <> ")." + liftIO $ do + setSGR [SetColor Foreground Dull Green] + Text.IO.putStrLn + $ name <> " is up to date (Version " <> version <> ")." + setSGR [Reset] | otherwise -> updatePackage package parsedInfoFile version Left errorBundle -> liftIO $ putStr $ errorBundlePretty errorBundle @@ -256,6 +308,17 @@ updatePackage Package{..} info version = do , child_group = Nothing } +findCategory :: FilePath -> IO [FilePath] +findCategory currentDirectory = do + contents <- liftIO $ listDirectory currentDirectory + case find (isSuffixOf ".info") contents of + Just _ -> pure [currentDirectory] + Nothing -> do + let contents' = (currentDirectory </>) <$> filter (not . isPrefixOf ".") contents + directories <- filterM doesDirectoryExist contents' + subCategories <- traverse findCategory directories + pure $ concat subCategories + main :: IO () main = do programCommand <- execParser slackBuilderParser @@ -264,10 +327,14 @@ main = do $ runSlackBuilderT $ executeCommand programCommand - Text.IO.putStrLn $ fromMaybe "" latestVersion + maybe (pure ()) Text.IO.putStrLn latestVersion where executeCommand = \case - TextCommand textArguments -> latestText textArguments + CategoryCommand _packageName -> do + repository' <- SlackBuilderT $ asks repository + categories <- liftIO $ findCategory repository' + liftIO $ print $ splitFileName . makeRelative repository' <$> categories + pure Nothing SlackBuildCommand packagePath version -> updateSlackBuildVersion packagePath version >> pure Nothing CommitCommand packagePath version -> diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs index 53a6bfb..4890567 100644 --- a/app/SlackBuilder/CommandLine.hs +++ b/app/SlackBuilder/CommandLine.hs @@ -7,7 +7,6 @@ module SlackBuilder.CommandLine ) where import Data.Text (Text) -import qualified Data.Text as Text import Options.Applicative ( Parser , ParserInfo(..) @@ -21,7 +20,7 @@ import Options.Applicative ) data SlackBuilderCommand - = TextCommand TextArguments + = CategoryCommand Text | SlackBuildCommand Text Text | CommitCommand Text Text | ExistsCommand Text @@ -47,16 +46,12 @@ data TextArguments = TextArguments , textURL :: Text } -textArguments :: Parser TextArguments -textArguments = TextArguments Text.strip - <$> argument str (metavar "URL") - slackBuilderParser :: ParserInfo SlackBuilderCommand slackBuilderParser = info slackBuilderCommand fullDesc slackBuilderCommand :: Parser SlackBuilderCommand slackBuilderCommand = subparser - $ command "text" (info (TextCommand <$> textArguments) mempty) + $ command "category" (info categoryCommand mempty) <> command "slackbuild" (info slackBuildCommand mempty) <> command "commit" (info commitCommand mempty) <> command "exists" (info existsCommand mempty) @@ -66,6 +61,8 @@ slackBuilderCommand = subparser <> command "deploy" (info deployCommand mempty) <> command "up2date" (info up2DateCommand mempty) where + categoryCommand = CategoryCommand + <$> argument str (metavar "PKGNAM") slackBuildCommand = SlackBuildCommand <$> argument str (metavar "PATH") <*> argument str (metavar "VERSION") |