Support repository path in commits

1 files changed, 56 insertions, 0 deletions

diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs
new file mode 100644
index 0000000..2b4f5dd
--- /dev/null
+++ b/app/SlackBuilder/Download.hs
@@ -0,0 +1,56 @@
+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 ""