WIP · JavaDerek/unison@e5f9773 · GitHub
Skip to content

Commit e5f9773

Browse files
ChrisPennerChrisPenner
committed
WIP
1 parent 138799f commit e5f9773

4 files changed

Lines changed: 105 additions & 59 deletions

File tree

‎codebase2/codebase-sqlite/U/Codebase/Sqlite/Queries.hs‎

Lines changed: 6 additions & 0 deletions

‎parser-typechecker/src/Unison/Codebase/Editor/Git.hs‎

Lines changed: 34 additions & 8 deletions
Original file line numberDiff line numberDiff line change
@@ -2,7 +2,15 @@
22
{-# LANGUAGE OverloadedStrings #-}
33
{-# LANGUAGE ViewPatterns #-}
44

5-
module Unison.Codebase.Editor.Git (gitIn, gitTextIn, pullBranch, withIOError, withStatus) where
5+
module Unison.Codebase.Editor.Git
6+
( gitIn,
7+
gitTextIn,
8+
pullRepo,
9+
withIOError,
10+
withStatus,
11+
withIsolatedRepo,
12+
)
13+
where
614

715
import Unison.Prelude
816

@@ -20,7 +28,8 @@ import UnliftIO.IO (hFlush, stdout)
2028
import qualified Data.ByteString.Base16 as ByteString
2129
import qualified Data.Char as Char
2230
import Unison.Codebase.GitError (GitProtocolError)
23-
import UnliftIO (handleIO)
31+
import UnliftIO (handleIO, MonadUnliftIO)
32+
import qualified UnliftIO
2433

2534

2635
-- https://superuser.com/questions/358855/what-characters-are-safe-in-cross-platform-file-names-for-linux-windows-and-os
@@ -37,8 +46,8 @@ encodeFileName = let
3746
encodeUtf8 . Text.pack
3847
in go
3948

40-
tempGitDir :: MonadIO m => Text -> m FilePath
41-
tempGitDir url =
49+
gitCacheDir :: MonadIO m => Text -> m FilePath
50+
gitCacheDir url =
4251
getXdgDirectory XdgCache
4352
$ "unisonlanguage"
4453
</> "gitfiles"
@@ -55,12 +64,30 @@ withStatus str ma = do
5564
liftIO . putStr $ " " ++ str ++ "\r"
5665
hFlush stdout
5766

67+
-- | Run an action on an isolated copy of the provided repo. The repo is deleted when the
68+
-- action exits or fails.
69+
withIsolatedRepo ::
70+
forall m r.
71+
(MonadUnliftIO m) =>
72+
FilePath ->
73+
(FilePath -> m r) ->
74+
m (Either GitProtocolError r)
75+
withIsolatedRepo srcPath action = do
76+
UnliftIO.withSystemTempDirectory "ucm-isolated-repo" $ \tempDir -> do
77+
(UnliftIO.tryIO $ copyCommand tempDir) >>= \case
78+
Left gitErr -> pure $ Left (GitError.CopyException srcPath tempDir (show gitErr))
79+
Right () -> Right <$> action tempDir
80+
where
81+
copyCommand :: FilePath -> m ()
82+
copyCommand dest = liftIO $
83+
"git" $^ (["clone", "--quiet"] ++ ["--depth", "1"] ++ [Text.pack srcPath, Text.pack dest])
84+
5885
-- | Given a remote git repo url, and branch/commit hash (currently
5986
-- not allowed): checks for git, clones or updates a cached copy of the repo
60-
pullBranch :: (MonadIO m, MonadError GitProtocolError m) => ReadRepo -> m CodebasePath
61-
pullBranch repo@(ReadGitRepo uri) = do
87+
pullRepo :: (MonadIO m, MonadError GitProtocolError m) => ReadRepo -> m CodebasePath
88+
pullRepo repo@(ReadGitRepo uri) = do
6289
checkForGit
63-
localPath <- tempGitDir uri
90+
localPath <- gitCacheDir uri
6491
ifM (doesDirectoryExist localPath)
6592
-- try to update existing directory
6693
(ifM (isGitRepo localPath)
@@ -69,7 +96,6 @@ pullBranch repo@(ReadGitRepo uri) = do
6996
-- directory doesn't exist, so clone anew
7097
(checkOutNew localPath Nothing)
7198
pure localPath
72-
7399
where
74100
-- | Do a `git clone` (for a not-previously-cached repo).
75101
checkOutNew :: (MonadIO m, MonadError GitProtocolError m) => CodebasePath -> Maybe Text -> m ()

‎parser-typechecker/src/Unison/Codebase/GitError.hs‎

Lines changed: 9 additions & 9 deletions
Original file line numberDiff line numberDiff line change
@@ -1,30 +1,30 @@
1-
{- ORMOLU_DISABLE -} -- Remove this when the file is ready to be auto-formatted
21
module Unison.Codebase.GitError where
32

4-
import Unison.Prelude
5-
6-
import Unison.Codebase.ShortBranchHash (ShortBranchHash)
7-
import Unison.Codebase.Editor.RemoteRepo (ReadRepo, WriteRepo, ReadRemoteNamespace)
3+
import Unison.Codebase.Editor.RemoteRepo (ReadRemoteNamespace, ReadRepo, WriteRepo)
84
import Unison.Codebase.Path
5+
import Unison.Codebase.ShortBranchHash (ShortBranchHash)
6+
import Unison.Prelude
97

108
type CodebasePath = FilePath
119

1210
data GitProtocolError
1311
= NoGit
1412
| UnrecognizableCacheDir ReadRepo CodebasePath
1513
| UnrecognizableCheckoutDir ReadRepo CodebasePath
14+
| -- srcPath destPath error-description
15+
CopyException FilePath FilePath String
1616
| CloneException ReadRepo String
1717
| PushException WriteRepo String
1818
| PushNoOp WriteRepo
19-
-- url commit Diff of what would change on merge with remote
20-
| PushDestinationHasNewStuff WriteRepo
19+
| -- url commit Diff of what would change on merge with remote
20+
PushDestinationHasNewStuff WriteRepo
2121
| CleanupError SomeException
22-
deriving Show
22+
deriving (Show)
2323

2424
data GitCodebaseError h
2525
= NoRemoteNamespaceWithHash ReadRepo ShortBranchHash
2626
| RemoteNamespaceHashAmbiguous ReadRepo ShortBranchHash (Set h)
2727
| CouldntLoadRootBranch ReadRepo h
2828
| CouldntLoadSyncedBranch ReadRemoteNamespace h
2929
| CouldntFindRemoteBranch ReadRepo Path
30-
deriving Show
30+
deriving (Show)

‎parser-typechecker/src/Unison/Codebase/SqliteCodebase.hs‎

Lines changed: 56 additions & 42 deletions

0 commit comments

Comments
 (0)