Implement clone command in the binary

3 files changed, 37 insertions, 7 deletions

diff --git a/app/Main.hs b/app/Main.hs
index eea4951..654dcf7 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -13,6 +13,7 @@ import qualified Toml
 import qualified Data.Text as Text
 import Control.Monad.Trans.Reader (ReaderT(..))
 import SlackBuilder.Download
+import Text.URI (mkURI)
 
 main :: IO ()
 main = do
@@ -38,8 +39,12 @@ main = do
             <$> remoteFileExists urlPath
         ArchiveCommand repo nameVersion tarball tagPrefix ->
             cloneAndArchive repo nameVersion tarball tagPrefix >> pure Nothing
-        DownloadCommand url target -> fmap (Text.pack . show)
-            <$> download url target
+        DownloadCommand url target
+            | Just uri <- mkURI url -> fmap (Text.pack . show)
+                <$> download uri target
+            | otherwise -> pure Nothing
+        CloneCommand repo tarball tagPrefix -> fmap (Text.pack . show)
+            <$> clone repo tarball tagPrefix
     chooseTransformFunction (Just "php") = phpTransform
     chooseTransformFunction (Just "rdiff-backup") = Text.stripPrefix "v"
     chooseTransformFunction _ = stripPrefix "v"
diff --git a/app/SlackBuilder/CommandLine.hs b/app/SlackBuilder/CommandLine.hs
index f486b5a..1b0d7ed 100644
--- a/app/SlackBuilder/CommandLine.hs
+++ b/app/SlackBuilder/CommandLine.hs
@@ -28,6 +28,7 @@ data SlackBuilderCommand
     | ExistsCommand Text
     | ArchiveCommand Text Text String Text
     | DownloadCommand Text String
+    | CloneCommand Text Text Text
     deriving (Eq, Show)
 
 data PackagistArguments = PackagistArguments
@@ -71,6 +72,7 @@ slackBuilderCommand = subparser
     <> command "exists" (info existsCommand mempty)
     <> command "archive" (info archiveCommand mempty)
     <> command "download" (info downloadCommand mempty)
+    <> command "clone" (info cloneCommand mempty)
   where
     slackBuildCommand = SlackBuildCommand
         <$> argument str (metavar "PATH")
@@ -87,3 +89,7 @@ slackBuilderCommand = subparser
     downloadCommand = DownloadCommand
         <$> argument str (metavar "URI")
         <*> argument str (metavar "TARGET")
+    cloneCommand = CloneCommand
+        <$> argument str (metavar "REPO")
+        <*> argument str (metavar "TARBALL")
+        <*> argument str (metavar "TAG_PREFIX")
diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs
index 842f4ae..c6516d4 100644
--- a/app/SlackBuilder/Download.hs
+++ b/app/SlackBuilder/Download.hs
@@ -1,5 +1,6 @@
 module SlackBuilder.Download
-    ( cloneAndArchive
+    ( clone
+    , cloneAndArchive
     , commit
     , download
     , hostedSources
@@ -17,7 +18,7 @@ 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.FilePath ((</>), (<.>), takeBaseName, splitPath, joinPath)
 import System.Process
     ( CreateProcess(..)
     , StdStream(..)
@@ -51,6 +52,7 @@ import Conduit
     , (.|)
     , ZipSink(..)
     , await
+    , sourceFile
     )
 import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
 import Data.Void (Void)
@@ -159,12 +161,29 @@ sinkHash = sink hashInit
     sink ctx = await
         >>= maybe (pure $ hashFinalize ctx) (sink . hashUpdate ctx)
 
-download :: Text -> FilePath -> SlackBuilderT (Maybe (Digest MD5))
-download uri target = SlackBuilderT (liftIO $ mkURI uri)
-    >>= traverse (runReq defaultHttpConfig . go . fst) . useHttpsURI
+download :: URI -> FilePath -> SlackBuilderT (Maybe (Digest MD5))
+download uri target = traverse (runReq defaultHttpConfig . go . fst)
+    $ useHttpsURI uri
   where
     go uri' = reqBr GET uri' NoReqBody mempty readResponse
     readResponse :: Response BodyReader -> IO (Digest MD5)
     readResponse response = runConduitRes
         $ responseBodySource response
         .| getZipSink (ZipSink (sinkFile target) *> ZipSink sinkHash)
+
+clone :: Text -> Text -> Text -> SlackBuilderT (Maybe (Digest MD5))
+clone repo tarball tagPrefix = do
+    let tarballPath = Text.unpack tarball
+        nameVersion = Text.pack $ takeBaseName tarballPath
+        remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath
+        localPath = "slackbuilds" </> tarballPath
+    remoteFileExists' <- remoteFileExists remotePath
+
+    if remoteFileExists'
+    then
+        hostedSources remotePath >>= flip download localPath
+    else
+        let go = sourceFile localPath .| sinkHash
+         in cloneAndArchive repo nameVersion tarballPath tagPrefix
+            >> uploadCommand tarball remotePath
+            >> liftIO (runConduitRes go) <&> Just