d-tools: Migrate source downloads with git clone

2 files changed, 12 insertions, 217 deletions

diff --git a/app/Main.hs b/app/Main.hs
index ee8b2c8..ffd9294 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -23,6 +23,7 @@ import SlackBuilder.Download
 import SlackBuilder.Package (Package(..))
 import qualified SlackBuilder.Package as Package
 import Text.URI (URI(..), mkURI)
+import Text.URI.QQ (uri)
 import Crypto.Hash (Digest, MD5)
 import Data.Foldable (for_, find)
 import qualified Text.URI as URI
@@ -231,11 +232,21 @@ autoUpdatable =
         , name = "d-tools"
         , downloaders =
             let dubArguments = GhArguments{ owner = "dlang", name = "dub", transform = Nothing}
+                dscannerArguments = GhArguments{ owner = "dlang-community", name = "D-Scanner", transform = Nothing }
+                dcdArguments = GhArguments{ owner = "dlang-community", name = "DCD", transform = Nothing }
                 latestDub = latestGitHub dubArguments pure
+                latestDscanner = latestGitHub dscannerArguments pure
+                latestDcd = latestGitHub dcdArguments pure
                 dubTemplate = Package.DownloadTemplate
                     $ Package.StaticPlaceholder "https://codeload.github.com/dlang/dub/tar.gz/v"
                     :| [Package.VersionPlaceholder]
-             in [Package.Updater latestDub $ downloadWithTemplate dubTemplate]
+                dscannerURI = [uri|https://github.com/dlang-community/D-Scanner.git|]
+                dcdURI = [uri|https://github.com/dlang-community/DCD.git|]
+             in
+                [ Package.Updater latestDub $ downloadWithTemplate dubTemplate
+                , Package.Updater latestDscanner $ cloneFromGit dscannerURI "v"
+                , Package.Updater latestDcd $ cloneFromGit dcdURI "v"
+                ]
         }
     ]
 
diff --git a/app/SlackBuilder/Download.hs b/app/SlackBuilder/Download.hs
deleted file mode 100644
index 011def7..0000000
--- a/app/SlackBuilder/Download.hs
+++ /dev/null
@@ -1,216 +0,0 @@
-module SlackBuilder.Download
-    ( clone
-    , cloneAndArchive
-    , commit
-    , download
-    , downloadAndDeploy
-    , hostedSources
-    , remoteFileExists
-    , updateSlackBuildVersion
-    , uploadCommand
-    ) where
-
-import Data.ByteString (ByteString)
-import qualified Data.ByteString as ByteString
-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 ((</>), (<.>), takeBaseName, splitPath, joinPath)
-import System.Process
-    ( CreateProcess(..)
-    , StdStream(..)
-    , proc
-    , readCreateProcessWithExitCode
-    , callProcess
-    )
-import System.Exit (ExitCode(..))
-import Control.Monad (unless)
-import Text.URI (URI(..), mkURI)
-import Network.HTTP.Req
-    ( useHttpsURI
-    , HEAD(..)
-    , NoReqBody(..)
-    , req
-    , runReq
-    , defaultHttpConfig
-    , ignoreResponse
-    , responseStatusCode
-    , HttpConfig(..)
-    , GET(..)
-    , reqBr
-    )
-import Data.Functor ((<&>))
-import Network.HTTP.Client (BodyReader, Response(..), brRead)
-import Conduit
-    ( ConduitT
-    , yield
-    , runConduitRes
-    , sinkFile
-    , (.|)
-    , ZipSink(..)
-    , await
-    , sourceFile
-    )
-import Crypto.Hash (Digest, MD5, hashInit, hashFinalize, hashUpdate)
-import Data.Void (Void)
-
-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
-    signature' <- SlackBuilderT $ asks $ signature . maintainer
-    let message = Text.unpack
-            $ packagePath <> ": Updated for version " <> version
-        mainCommitArguments = ["-C", repository', "commit", "-m", message]
-        commitArguments =
-            if signature'
-            then mainCommitArguments <> ["-S"]
-            else mainCommitArguments
-
-    (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" commitArguments
-  where
-    testCheckout repository' branch' nullHandle =
-        let createCheckoutProcess = (proc "git" ["-C", repository', "checkout", branch'])
-                { std_in = NoStream
-                , std_err = UseHandle nullHandle
-                }
-         in readCreateProcessWithExitCode createCheckoutProcess ""
-
-hostedSources :: Text -> SlackBuilderT URI
-hostedSources absoluteURL = SlackBuilderT (asks downloadURL)
-    >>= liftIO . mkURI . (<> absoluteURL)
-
-remoteFileExists :: Text -> SlackBuilderT Bool
-remoteFileExists url = hostedSources url
-    >>= traverse (runReq httpConfig . go . fst) . useHttpsURI
-    <&> maybe False ((== 200) . responseStatusCode)
-  where
-    httpConfig = defaultHttpConfig
-        { httpConfigCheckResponse = const $ const $ const Nothing
-        }
-    go uri = req HEAD uri NoReqBody ignoreResponse mempty
-
-uploadCommand :: Text -> Text -> SlackBuilderT ()
-uploadCommand localPath remotePath' = do
-    remoteRoot <- SlackBuilderT $ asks remotePath
-    repository' <- SlackBuilderT $ asks repository
-
-    liftIO $ callProcess "scp"
-        [ repository' </> Text.unpack localPath
-        , Text.unpack $ remoteRoot <> remotePath'
-        ]
-
-cloneAndArchive :: Text -> Text -> FilePath -> Text -> SlackBuilderT ()
-cloneAndArchive repo nameVersion tarball tagPrefix = do
-    let (_, version) = Text.breakOnEnd "-" nameVersion
-        nameVersion' = Text.unpack nameVersion
-
-    repository' <- SlackBuilderT $ asks repository
-    liftIO $ callProcess "rm" ["-rf", nameVersion']
-
-    liftIO $ callProcess "git" ["clone", Text.unpack repo, nameVersion']
-    liftIO $ callProcess "git"
-        [ "-C"
-        , nameVersion'
-        , "checkout"
-        , Text.unpack $ tagPrefix <> version
-        ]
-    liftIO $ callProcess "git"
-        [ "-C"
-        , nameVersion'
-        , "submodule"
-        , "update"
-        , "--init"
-        , "--recursive"
-        ]
-
-    liftIO $ callProcess "tar"
-        [ "Jcvf"
-        , repository' </> tarball
-        , nameVersion'
-        ]
-    liftIO $ callProcess "rm" ["-rf", nameVersion']
-
-responseBodySource :: MonadIO m => Response BodyReader -> ConduitT i ByteString m ()
-responseBodySource = bodyReaderSource . responseBody
-  where
-    bodyReaderSource br = liftIO (brRead br) >>= go br
-    go br bs = unless (ByteString.null bs) $ yield bs >> bodyReaderSource br
-
-sinkHash :: Monad m => ConduitT ByteString Void m (Digest MD5)
-sinkHash = sink hashInit
-  where
-    sink ctx = await
-        >>= maybe (pure $ hashFinalize ctx) (sink . hashUpdate ctx)
-
-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
-    repository' <- SlackBuilderT $ asks repository
-    let tarballPath = Text.unpack tarball
-        nameVersion = Text.pack $ takeBaseName tarballPath
-        remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath
-        localPath = repository' </> 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
-
-downloadAndDeploy :: Text -> Text -> SlackBuilderT (Maybe (Digest MD5))
-downloadAndDeploy uri tarball = do
-    repository' <- SlackBuilderT $ asks repository
-    let tarballPath = Text.unpack tarball
-        remotePath = Text.pack $ joinPath $ ("/" :) $ drop 1 $ splitPath tarballPath
-        localPath = repository' </> tarballPath
-    remoteFileExists' <- remoteFileExists remotePath
-
-    if remoteFileExists'
-    then
-        hostedSources remotePath >>= flip download localPath
-    else do
-        checksum <- liftIO (mkURI uri) >>= flip download localPath
-        uploadCommand tarball remotePath
-        pure checksum