blob: 3667e76e7df62090cea1cc1c0e1b13ee17c52370 (
plain)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
|
module Command.Checkout (
CheckoutCommand,
) where
import Data.Maybe
import Data.Text (Text)
import Data.Text qualified as T
import System.Console.GetOpt
import Command
import Repo
data CheckoutCommand = CheckoutCommand CheckoutOptions (Maybe RepoName) (Maybe Text)
data CheckoutOptions = CheckoutOptions
{ coDestination :: Maybe FilePath
, coSubtree :: Maybe FilePath
}
instance Command CheckoutCommand where
commandName _ = "checkout"
commandDescription _ = "Checkout (part of) a given repository"
type CommandArguments CheckoutCommand = [ Text ]
commandUsage _ = T.pack $ unlines $
[ "Usage: minici checkout [<repo> [<revision>]] [<option>...]"
]
type CommandOptions CheckoutCommand = CheckoutOptions
defaultCommandOptions _ = CheckoutOptions
{ coDestination = Nothing
, coSubtree = Nothing
}
commandOptions _ =
[ Option [] [ "dest" ]
(ReqArg (\val opts -> opts { coDestination = Just val }) "<path>")
"destination path"
, Option [] [ "subtree" ]
(ReqArg (\val opts -> opts { coSubtree = Just val }) "<path>")
"repository subtree to checkout"
]
commandInit _ co args = CheckoutCommand co
(RepoName <$> listToMaybe args)
(listToMaybe $ drop 1 args)
commandExec = cmdCheckout
cmdCheckout :: CheckoutCommand -> CommandExec ()
cmdCheckout (CheckoutCommand CheckoutOptions {..} name mbrev) = do
repo <- maybe getDefaultRepo getRepo name
root <- getCommitTree =<< case mbrev of
Just revision -> readCommit repo revision
Nothing -> createWipCommit repo
tree <- case coSubtree of
Nothing -> return root
Just subtree -> maybe (fail $ "subtree `" <> subtree <> "' not found in " <> maybe "current worktree" (("revision `" <>) . (<> "'") . T.unpack) mbrev) return =<<
getSubtree subtree root
checkoutAt tree $ maybe "." id coDestination
|