src/Command/Checkout.hs


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

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
    mbCommit <- sequence $ fmap (readCommit repo) mbrev
    root <- getCommitTree =<< maybe (createWipCommit repo) return mbCommit
    tree <- maybe return (getSubtree mbCommit) coSubtree $ root
    checkoutAt tree $ maybe "." id coDestination