diff options
Diffstat (limited to 'app/Main.hs')
| -rw-r--r-- | app/Main.hs | 83 |
1 files changed, 75 insertions, 8 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 -> |