Add librsync and dmd
This commit is contained in:
83
app/Main.hs
83
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 ->
|
||||
|
||||
@ -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")
|
||||
|
||||
Reference in New Issue
Block a user