on master help sign in
isGithubThunk: "Proove" the github case by decomposition the URL
commit8148f40be9d56544376332cf27b4150faf315038 authorJohn Ericson <git@JohnEricson.me> dateSun 14 Oct 2018, 15:04 (8 years ago) parent457071a
1 file changed+18−16
lib/command/src/Obelisk/Command/Thunk.hs+18−16
lib/command/src/Obelisk/Command/Thunk.hs+18−16
@@ -746,29 +746,31 @@ getThunkPtr' checkClean thunkDir upstream = do
746746 refs
747747 mCurrentUpstreamBranch = Map.lookup currentHead remoteHeads
748748 <|> Map.lookup currentHead localHeads
749− if isGithubThunk remoteUri
750− then githubThunkPtr remoteUri currentHead mCurrentUpstreamBranch
751− else do
752− currentUpstreamBranch <- case mCurrentUpstreamBranch of
753− Just b -> pure b
754− Nothing -> failWith "Need explicit branch for git remote"
755− gitThunkPtr remoteUri currentHead currentUpstreamBranch
749+ case isGithubThunk remoteUri of
750+ Just (owner, repo) -> githubThunkPtr owner repo currentHead mCurrentUpstreamBranch
751+ Nothing -> do
752+ currentUpstreamBranch <- case mCurrentUpstreamBranch of
753+ Just b -> pure b
754+ Nothing -> failWith "Need explicit branch for git remote"
755+ gitThunkPtr remoteUri currentHead currentUpstreamBranch
756756 where
757757 refsToTuples [x, y] = (x, y)
758758 refsToTuples x = error $ "thunk pack: cannot parse ref " <> show x
759759
760−isGithubThunk :: URI -> Bool
760+-- Just comes with "proof" with the decomposed URL.x
761+isGithubThunk :: URI -> Maybe (String, String)
761762isGithubThunk u
762763 | Just uriAuth <- uriAuthority u
763− = case uriScheme u of
764+ , case uriScheme u of
764765 "ssh:" -> uriAuth == URIAuth "git@" "github.com" ""
765766 s -> s `L.elem` [ "git:", "https:", "http:" ] -- "http:" just redirects to "https:"
766767 && uriRegName uriAuth == "github.com"
767− | otherwise = False
768+ , ["/", owner', repo'] <- splitDirectories (uriPath u)
769+ = Just (owner', repo')
770+ | otherwise = Nothing
768771
769−githubThunkPtr :: MonadObelisk m => URI -> Text -> Maybe Text -> m ThunkPtr
770−githubThunkPtr u commit' branch' = do
771− ["/", owner', repo'] <- return $ splitDirectories (uriPath u)
772+githubThunkPtr :: MonadObelisk m => String -> String -> Text -> Maybe Text -> m ThunkPtr
773+githubThunkPtr owner' repo' commit' branch' = do
772774 let owner = N (T.pack owner')
773775 repo = N (T.pack (dropExtension repo'))
774776 commit = N commit'
@@ -820,9 +822,9 @@ uriThunkPtr uri mbranch = do
820822 Nothing -> gitLookupDefaultBranch bothMaps
821823 Just b -> pure b
822824 commit <- rethrowE $ gitLookupCommitForRef bothMaps (GitRef_Branch branch)
823− if isGithubThunk uri
824− then githubThunkPtr uri commit mbranch
825− else gitThunkPtr uri commit branch
825+ case isGithubThunk uri of
826+ Just (owner, repo) -> githubThunkPtr owner repo commit mbranch
827+ Nothing -> gitThunkPtr uri commit branch
826828 where
827829 rethrowE = either failWith pure
828830