From a314155903b0c88da22f7f9194402e991ee9ac65 Mon Sep 17 00:00:00 2001
From: Filip Gralinski <filip.gralinski@applica.pl>
Date: Sun, 31 May 2020 21:26:29 +0200
Subject: [PATCH] Try to make some URLs clickable

---
 Handler/Query.hs                   | 20 ++++++++++++++++++++
 templates/submission-header.hamlet |  6 +++++-
 2 files changed, 25 insertions(+), 1 deletion(-)

diff --git a/Handler/Query.hs b/Handler/Query.hs
index 077a118..4d0ddfc 100644
--- a/Handler/Query.hs
+++ b/Handler/Query.hs
@@ -337,6 +337,26 @@ resultTable (Entity submissionId submission) = do
   $(widgetFile "result-table")
 
 
+data GitServer = Gogs | GitLab
+  deriving (Eq, Show)
+
+guessGitServer :: Text -> Maybe GitServer
+guessGitServer bareUrl
+  | "git.wmi.amu.edu.pl" `isPrefixOf` bareUrl = Just Gogs
+  | "gitlab." `isPrefixOf` bareUrl = Just GitLab
+  | "git." `isPrefixOf` bareUrl = Just GitLab
+  | otherwise = Nothing
+
+getHttpLink :: Repo -> Maybe (Text, Text)
+getHttpLink repo = case guessGitServer bareUrl of
+  Just Gogs -> Just (convertToHttpLink bareUrl, "/src/" <> branch)
+  Just GitLab -> Just (convertToHttpLink bareUrl, "/-/tree/" <> branch)
+  Nothing -> Nothing
+  where bareUrl = T.replace "git@" "" url
+        url = repoUrl repo
+        branch = repoBranch repo
+        convertToHttpLink = ("https://" <>) . (T.replace ":" "/") . (T.replace ".git" "")
+
 submissionHeader :: FullSubmissionInfo -> Maybe Text -> WidgetFor App ()
 submissionHeader submission mVariantName =
   $(widgetFile "submission-header")
diff --git a/templates/submission-header.hamlet b/templates/submission-header.hamlet
index 0e7609f..62e9dff 100644
--- a/templates/submission-header.hamlet
+++ b/templates/submission-header.hamlet
@@ -11,7 +11,11 @@
   <dt>submitted
   <dd>#{stamp}
   <dt>original repo
-  <dd><code>#{repoUrl $ fsiRepo submission}</code> / branch <code>#{repoBranch $ fsiRepo submission}</code>
+  <dd>
+    $maybe (url, branchPart) <- getHttpLink (fsiRepo submission)
+      <code><a href="#{url}">#{repoUrl $ fsiRepo submission}</code></a> / branch <a href="#{url <> branchPart}"><code>#{repoBranch $ fsiRepo submission}</code></a>
+    $nothing
+      <code>#{repoUrl $ fsiRepo submission}</code> / branch <code>#{repoBranch $ fsiRepo submission}</code>
   $if submissionIsPublic $ fsiSubmission submission
     <dt>publicly available at
     <dd><code>#{publicSubmissionRepo}</code> / branch <code>#{publicSubmissionBranch}</code>