src/Command/Subtree.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

module Command.Subtree (
    SubtreeCommand,
) where

import Data.Text (Text)
import Data.Text qualified as T

import Command
import Output
import Repo


data SubtreeCommand = SubtreeCommand SubtreeOptions [ Text ]

data SubtreeOptions = SubtreeOptions

instance Command SubtreeCommand where
    commandName _ = "subtree"
    commandDescription _ = "Resolve subdirectory of given repo tree"

    type CommandArguments SubtreeCommand = [ Text ]

    commandUsage _ = T.pack $ unlines $
        [ "Usage: minici subtree <tree> <path>"
        ]

    type CommandOptions SubtreeCommand = SubtreeOptions
    defaultCommandOptions _ = SubtreeOptions

    commandInit _ opts = SubtreeCommand opts
    commandExec = cmdSubtree


cmdSubtree :: SubtreeCommand -> CommandExec ()
cmdSubtree (SubtreeCommand SubtreeOptions args) = do
    [ treeParam, path ] <- return args
    out <- getOutput
    repo <- getDefaultRepo

    let ( tree, subdir ) =
            case T.splitOn "(" treeParam of
                (t : param : _) -> ( t, T.unpack $ T.takeWhile (/= ')') param )
                _ -> ( treeParam, "" )

    subtree <- getSubtree Nothing (T.unpack path) =<< readTree repo subdir tree
    outputMessage out $ textTreeId $ treeId subtree
    outputEvent out $ TestMessage $ "path " <> T.pack (treeSubdir subtree)