0 | module Pack.Core.Git
 1 |
 2 | import Data.String
 3 | import public Pack.Core.Git.Consts
 4 | import Pack.Core.IO
 5 | import Pack.Core.Types
 6 |
 7 | %default total
 8 |
 9 | ||| (Temporary) Directory to use for a Git project.
10 | export %inline
11 | gitTmpDir : TmpDir => (pkg : PkgName) -> Path Abs
12 | gitTmpDir pkg = tmpDir <//> pkg
13 |
14 | ||| Cached directory to use for a Git project.
15 | export %inline
16 | gitCacheDir : (pd : PackDirs) => (url : URL) -> Path Abs
17 | gitCacheDir url = pd.cache <//> "git" <//> url
18 |
19 | parameters {auto has : HasIO io}
20 |
21 |   ||| Clones a Git repository to the given destination
22 |   cloneRemote : (url : URL) -> (dest : Path Abs) -> EitherT PackErr io ()
23 |   cloneRemote url dest = sys ["git", "clone", "--depth", "1", "-q", url, dest]
24 |
25 |   ||| Creates a shared clone of a cached local git clone
26 |   cloneShared :
27 |        {auto _ : PackDirs}
28 |     -> {auto _ : TmpDir}
29 |     -> (url    : URL)
30 |     -> PkgName
31 |     -> EitherT PackErr io ()
32 |   cloneShared url pkg =
33 |     let cache := gitCacheDir url
34 |         tmp   := gitTmpDir pkg
35 |      in sys ["git", "clone", "--shared", "-q", cache, tmp]
36 |
37 |   ||| Fetch the given commit from upstream
38 |   fetch : (commit : Commit) -> EitherT PackErr io ()
39 |   fetch commit = sys ["git", "fetch", "-q", "origin", commit]
40 |
41 |   ||| Checkout to the given commit
42 |   export
43 |   checkout : (commit : Commit) -> EitherT PackErr io ()
44 |   checkout commit = sys ["git", "checkout", "-q", commit]
45 |
46 |   ||| Query a Git repo for the latest commit of the main branch.
47 |   export covering
48 |   gitLatest : (url : URL) -> (branch : Branch) -> EitherT PackErr io Commit
49 |   gitLatest url b =
50 |     MkCommit . fst . break isSpace <$> sysRun ["git", "ls-remote", url, b]
51 |
52 |   ||| Clone a git repository into `dir`, switch to the
53 |   ||| given commit and run the given action.
54 |   export
55 |   withGit :
56 |        {auto _     : TmpDir}
57 |     -> {auto _     : PackDirs}
58 |     -> (pkg        : PkgName)
59 |     -> (url        : URL)
60 |     -> (commit     : Commit)
61 |     -> (forceFetch : Bool)
62 |     -> (act        : Path Abs -> EitherT PackErr io a)
63 |     -> EitherT PackErr io a
64 |   withGit pkg url commit forceFetch act =
65 |     let cache := gitCacheDir url
66 |         tmp   := gitTmpDir pkg
67 |
68 |      in do
69 |        False <- exists tmp
70 |          | True => case forceFetch of
71 |              False => inDir tmp act
72 |              True  => inDir tmp (\d => fetch commit >> checkout commit >> act d)
73 |
74 |        -- clone a Git repo if it's not already cached
75 |        when !(missing cache) $ do
76 |          mkParentDir cache
77 |          cloneRemote url cache
78 |
79 |        -- fetch the required commit
80 |        inDir cache $ \_ => fetch commit
81 |
82 |        mkParentDir tmp
83 |
84 |        cloneShared url pkg
85 |        inDir tmp (\d => fetch commit >> checkout commit >> act d)
86 |