57 lines
2.3 KiB
Haskell
57 lines
2.3 KiB
Haskell
|
module SlackBuilder.Download
|
||
|
|
( commit
|
||
|
|
, updateSlackBuildVersion
|
||
|
|
) where
|
||
|
|
|
||
|
|
import Data.Text (Text)
|
||
|
|
import qualified Data.Text as Text
|
||
|
|
import qualified Data.Text.IO as Text.IO
|
||
|
|
import SlackBuilder.Config
|
||
|
|
import SlackBuilder.Trans
|
||
|
|
import Control.Monad.Trans.Reader (asks)
|
||
|
|
import Control.Monad.IO.Class (MonadIO(liftIO))
|
||
|
|
import System.IO (IOMode(..), withFile)
|
||
|
|
import System.FilePath ((</>), (<.>))
|
||
|
|
import System.Process (CreateProcess(..), StdStream(..), proc, readCreateProcessWithExitCode, callProcess)
|
||
|
|
import System.Exit (ExitCode(..))
|
||
|
|
import Control.Monad (unless)
|
||
|
|
|
||
|
|
updateSlackBuildVersion :: Text -> Text -> SlackBuilderT ()
|
||
|
|
updateSlackBuildVersion packagePath version = do
|
||
|
|
repository' <- SlackBuilderT $ asks repository
|
||
|
|
let name = Text.unpack $ snd $ Text.breakOnEnd "/" packagePath
|
||
|
|
slackbuildFilename = repository'
|
||
|
|
</> Text.unpack packagePath
|
||
|
|
</> (name <.> "SlackBuild")
|
||
|
|
slackbuildContents <- liftIO $ Text.IO.readFile slackbuildFilename
|
||
|
|
let (contentsHead, contentsTail) = Text.dropWhile (/= '\n')
|
||
|
|
<$> Text.breakOn "VERSION=${VERSION:-" slackbuildContents
|
||
|
|
|
||
|
|
liftIO $ Text.IO.writeFile slackbuildFilename
|
||
|
|
$ contentsHead <> "VERSION=${VERSION:-" <> version <> "}" <> contentsTail
|
||
|
|
|
||
|
|
commit :: Text -> Text -> SlackBuilderT ()
|
||
|
|
commit packagePath version = do
|
||
|
|
branch' <- SlackBuilderT $ Text.unpack <$> asks branch
|
||
|
|
repository' <- SlackBuilderT $ asks repository
|
||
|
|
let message = Text.unpack
|
||
|
|
$ packagePath <> ": Updated for version " <> version
|
||
|
|
|
||
|
|
(checkoutExitCode, _, _) <- liftIO
|
||
|
|
$ withFile "/dev/null" WriteMode
|
||
|
|
$ testCheckout repository' branch'
|
||
|
|
|
||
|
|
unless (checkoutExitCode == ExitSuccess)
|
||
|
|
$ liftIO
|
||
|
|
$ callProcess "git" ["-C", repository', "checkout", "-b", branch', "master"]
|
||
|
|
liftIO
|
||
|
|
$ callProcess "git" ["-C", repository', "add", Text.unpack packagePath]
|
||
|
|
>> callProcess "git" ["-C", repository', "commit", "-S", "-m", message]
|
||
|
|
where
|
||
|
|
testCheckout repository' branch' nullHandle =
|
||
|
|
let createCheckoutProcess = (proc "git" ["-C", repository', "checkout", branch'])
|
||
|
|
{ std_in = NoStream
|
||
|
|
, std_err = UseHandle nullHandle
|
||
|
|
}
|
||
|
|
in readCreateProcessWithExitCode createCheckoutProcess ""
|