Skip to content

Commit d48eb9c

Browse files
committed
Implement acquire repository command
Port `git-elegant-acquire-repository` command to haskell. `unordered-containers` provide HashMap. #297
1 parent 60c9f93 commit d48eb9c

13 files changed

+924
-158
lines changed

elegant-git.cabal

+12
Original file line numberDiff line numberDiff line change
@@ -25,6 +25,7 @@ source-repository head
2525

2626
library
2727
exposed-modules:
28+
Elegit.Cli.Action.AcquireRepository
2829
Elegit.Cli.Action.ShowWork
2930
Elegit.Cli.Command
3031
Elegit.Cli.Parser
@@ -43,6 +44,7 @@ library
4344
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Werror=incomplete-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints
4445
build-depends:
4546
base >=4.7 && <5
47+
, containers
4648
, dlist
4749
, fmt
4850
, free
@@ -57,6 +59,8 @@ library
5759
, transformers
5860
, typed-process
5961
, universum
62+
, unordered-containers
63+
, utility-ht
6064
default-language: Haskell2010
6165

6266
executable git-elegant
@@ -72,6 +76,7 @@ executable git-elegant
7276
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Werror=incomplete-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
7377
build-depends:
7478
base >=4.7 && <5
79+
, containers
7580
, dlist
7681
, elegant-git
7782
, fmt
@@ -87,13 +92,17 @@ executable git-elegant
8792
, transformers
8893
, typed-process
8994
, universum
95+
, unordered-containers
96+
, utility-ht
9097
default-language: Haskell2010
9198

9299
test-suite elegant-git-test
93100
type: exitcode-stdio-1.0
94101
main-is: Spec.hs
95102
other-modules:
103+
Elegit.Cli.Action.AcquireRepositorySpec
96104
Elegit.Cli.Action.ShowWorkSpec
105+
Elegit.Cli.Parser.AcquireRepositorySpec
97106
Elegit.Cli.Parser.ShowWorkSpec
98107
Elegit.Cli.Parser.Util
99108
Elegit.Git.Runner.SimulatedSpec
@@ -107,6 +116,7 @@ test-suite elegant-git-test
107116
ghc-options: -Wall -Wcompat -Widentities -Wincomplete-record-updates -Werror=incomplete-patterns -Wmissing-home-modules -Wpartial-fields -Wredundant-constraints -threaded -rtsopts -with-rtsopts=-N
108117
build-depends:
109118
base >=4.7 && <5
119+
, containers
110120
, dlist
111121
, elegant-git
112122
, fmt
@@ -123,4 +133,6 @@ test-suite elegant-git-test
123133
, transformers
124134
, typed-process
125135
, universum
136+
, unordered-containers
137+
, utility-ht
126138
default-language: Haskell2010

package.yaml

+3
Original file line numberDiff line numberDiff line change
@@ -31,9 +31,12 @@ dependencies:
3131
- mtl
3232
- free
3333
- dlist
34+
- containers
35+
- unordered-containers
3436
- microlens
3537
- microlens-mtl
3638
- microlens-th
39+
- utility-ht
3740

3841
- optparse-applicative
3942
- typed-process
+130
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,130 @@
1+
{-# LANGUAGE QuasiQuotes #-}
2+
module Elegit.Cli.Action.AcquireRepository
3+
( cli
4+
, cmd
5+
) where
6+
7+
import Control.Monad.Free.Class
8+
import Data.String.QQ
9+
import Elegit.Cli.Command
10+
import qualified Elegit.Git.Action as GA
11+
import Fmt
12+
import Options.Applicative
13+
import qualified Options.Applicative.Help.Pretty as OA
14+
import Universum
15+
16+
17+
site:: Text
18+
site = "placeholder"
19+
20+
purpose :: OA.Doc
21+
purpose = OA.text "Configures the current local Git repository."
22+
23+
description :: OA.Doc
24+
description = OA.string $ [s|
25+
Applies the "basics", "standards", "aliases", and "signature" configurations
26+
to the current Git repository using `git config --local`. The command asks to
27+
provide information that is needed for the current repository configuration.
28+
29+
The behavior of the command varies depend on `git elegant acquire-git`
30+
execution (a global configuration). If the global configuration is applied,
31+
then this command configures repository-related staffs only, otherwise, it
32+
applies all configurations to the current local repository.
33+
34+
To find out what will be configured, please visit
35+
|] ++ (fmt ""+|site|+"/en/latest/configuration/")
36+
37+
38+
cli :: Mod CommandFields ElegitCommand
39+
cli = command "acquire-repository" $ info (pure AcquireRepositoryCommand) $
40+
mconcat [ progDescDoc (Just purpose )
41+
, footerDoc (Just description )
42+
]
43+
44+
45+
data ConfigKey
46+
= UserNameKey
47+
| UserEmailKey
48+
| CoreEditorKey
49+
| DefaultBranchKey
50+
| ProtectedBranchesKey
51+
52+
53+
configName :: ConfigKey -> Text
54+
configName UserNameKey = "user.name"
55+
configName UserEmailKey = "user.email"
56+
configName CoreEditorKey = "core.editor"
57+
configName DefaultBranchKey = "elegant-git.default-branch"
58+
configName ProtectedBranchesKey = "elegant-git.protected-branches"
59+
60+
61+
configPrompt :: ConfigKey -> Text
62+
configPrompt UserNameKey = "What is your user name?"
63+
configPrompt UserEmailKey = "What is your email?"
64+
configPrompt CoreEditorKey = "What is the command to launching an editor?"
65+
configPrompt DefaultBranchKey = "What is the default branch?"
66+
configPrompt ProtectedBranchesKey = "What are protected branches (split with space)"
67+
68+
69+
configDefault :: (MonadFree GA.GitF m) => ConfigKey -> m (Maybe Text)
70+
configDefault cKey = case cKey of
71+
UserNameKey -> getFromConfig
72+
UserEmailKey -> getFromConfig
73+
CoreEditorKey -> getFromConfig
74+
DefaultBranchKey -> return $ Just "master"
75+
ProtectedBranchesKey -> return $ Just "master"
76+
77+
where
78+
getFromConfig :: (MonadFree GA.GitF m) => m (Maybe Text)
79+
getFromConfig = GA.readConfig GA.AutoConfig (configName cKey)
80+
81+
82+
configureBasics :: (MonadFree GA.GitF m) => GA.ConfigScope -> m ()
83+
configureBasics cScope = do
84+
for_ basicConfigs $ \cKey -> do
85+
keyDefault <- configDefault cKey
86+
newValue <- GA.promptDefault (configPrompt cKey) keyDefault
87+
GA.setConfigVerbose cScope (configName cKey) newValue
88+
89+
where
90+
basicConfigs :: [ConfigKey]
91+
basicConfigs =
92+
[ UserNameKey
93+
, UserEmailKey
94+
, CoreEditorKey
95+
, DefaultBranchKey
96+
, ProtectedBranchesKey
97+
]
98+
99+
100+
configureStandards :: (MonadFree GA.GitF m) => GA.ConfigScope -> m ()
101+
configureStandards cScope =
102+
for_ standardConfigs $ \(cKey,cValue) -> do
103+
GA.setConfigVerbose cScope cKey cValue
104+
where
105+
standardConfigs :: [(Text, Text)]
106+
standardConfigs =
107+
[ ("core.commentChar", "|")
108+
, ("apply.whitespace", "fix")
109+
, ("fetch.prune", "true")
110+
, ("fetch.pruneTags", "false")
111+
, ("core.autocrlf", "input")
112+
, ("pull.rebase", "true")
113+
, ("rebase.autoStash", "false")
114+
, ("credential.helper", "osxkeychain")
115+
]
116+
117+
118+
-- | Execution description of the AcquireRepository action
119+
cmd :: (MonadFree GA.GitF m) => m ()
120+
cmd = do
121+
GA.removeObsoleteConfiguration GA.LocalConfig
122+
GA.print =<< GA.formatInfoBox "Configuring basics..."
123+
configureBasics GA.LocalConfig
124+
unlessM GA.isGitAcquired $ do
125+
GA.print =<< GA.formatInfoBox "Configuring standards..."
126+
configureStandards GA.LocalConfig
127+
-- GA.print =<< GA.formatInfoBox "Configuring aliases..."
128+
-- TODO: Setup aliases
129+
-- GA.print =<< GA.formatInfoBox "Configuring signature..."
130+
-- TODO: Setup gpg key

src/Elegit/Cli/Action/ShowWork.hs

+11-10
Original file line numberDiff line numberDiff line change
@@ -50,24 +50,25 @@ cmd = do
5050
changes <- GA.status GA.StatusShort
5151
stashes <- GA.stashList
5252

53-
GA.reportInfo ">>> Branch refs:"
54-
GA.reportInfo (fmt "local: "+|currentBranch|+"")
53+
GA.print =<< GA.formatInfo ">>> Branch refs:"
54+
GA.print =<< GA.formatInfo (fmt "local: "+|currentBranch|+"")
5555
case mCurrentUpstream of
56-
Just currentUpstream -> GA.reportInfo (fmt "remote: "+|currentUpstream|+"")
57-
Nothing -> pass
56+
Nothing -> pass
57+
Just currentUpstream ->
58+
GA.print =<< GA.formatInfo (fmt "remote: "+|currentUpstream|+"")
5859

59-
GA.reportInfo ""
60+
GA.print ""
6061

6162
unless (null logs) $ do
62-
GA.reportInfo (fmt ">>> New commits (comparing to "+|branchWithLatestChanges|+" branch):")
63+
GA.print =<< GA.formatInfo (fmt ">>> New commits (comparing to "+|branchWithLatestChanges|+" branch):")
6364
GA.print $ T.intercalate "\n" logs
64-
GA.reportInfo ""
65+
GA.print ""
6566

6667
unless (null changes) $ do
67-
GA.reportInfo ">>> Uncommitted modifications:"
68+
GA.print =<< GA.formatInfo ">>> Uncommitted modifications:"
6869
GA.print $ T.intercalate "\n" changes
69-
GA.reportInfo ""
70+
GA.print ""
7071

7172
unless (null stashes) $ do
72-
GA.reportInfo ">>> Available stashes:"
73+
GA.print =<< GA.formatInfo ">>> Available stashes:"
7374
GA.print $ T.intercalate "\n" stashes

src/Elegit/Cli/Command.hs

+1
Original file line numberDiff line numberDiff line change
@@ -4,4 +4,5 @@ import Universum
44

55
data ElegitCommand
66
= ShowWorkCommand
7+
| AcquireRepositoryCommand
78
deriving (Eq, Show)

src/Elegit/Cli/Parser.hs

+3-1
Original file line numberDiff line numberDiff line change
@@ -1,6 +1,7 @@
11
module Elegit.Cli.Parser where
22

3-
import qualified Elegit.Cli.Action.ShowWork as ShowWork
3+
import qualified Elegit.Cli.Action.AcquireRepository as AcquireRepository
4+
import qualified Elegit.Cli.Action.ShowWork as ShowWork
45
import Elegit.Cli.Command
56
import Options.Applicative
67
import Universum
@@ -13,6 +14,7 @@ dayToDayContributionsCommand :: Command ElegitCommand
1314
dayToDayContributionsCommand =
1415
commandGroup "make day-to-day contributions"
1516
<> ShowWork.cli
17+
<> AcquireRepository.cli
1618

1719

1820
cli :: ParserInfo ElegitCommand

0 commit comments

Comments
 (0)