Try to make some URLs clickable

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")

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>