Skip to content

Commit 8b177b6

Browse files
dan-amorosodan-amoroso
committed
moved main functionality to GitSub module
1 parent 8e5d9c5 commit 8b177b6

File tree

2 files changed

+104
-96
lines changed

2 files changed

+104
-96
lines changed

‎app/Main.hs

Lines changed: 3 additions & 96 deletions
Original file line numberDiff line numberDiff line change
@@ -1,101 +1,8 @@
1-
{-# LANGUAGE OverloadedStrings #-}
2-
31
module Main (main) where
42

5-
import Data.List hiding (intercalate)
6-
import Data.Monoid
7-
import Data.Text as T hiding (intercalate, unlines)
8-
import Filesystem.Path.CurrentOS as Path (FilePath, encodeString,
9-
toText, valid)
10-
import GitSub.CmdParsers
11-
import GitSub.Submodule (parseSubmodules)
12-
import Options.Applicative
13-
import Prelude hiding (FilePath)
14-
import System.Process (readCreateProcess, shell)
3+
import qualified GitSub
154

165
main :: IO ()
176
main = do
18-
gitSubCommand <-
19-
showHelpOnErrorExecParser
20-
(info
21-
(helper <*> parseCommand)
22-
(fullDesc <> progDesc smDescription <> header smHeader))
23-
run gitSubCommand
24-
25-
smDescription :: String
26-
smDescription = "utility to manage submodules in a git repository"
27-
28-
smHeader :: String
29-
smHeader = "git-sub: git submodules made easy"
30-
31-
run :: Command -> IO ()
32-
run gitSubCommand = case gitSubCommand of
33-
List -> runList
34-
Add url path -> runAdd url path
35-
Remove path -> runRemove path
36-
Move from to -> runMove from to
37-
38-
runList :: IO ()
39-
runList = do
40-
submodulesStr <- readFile ".gitmodules"
41-
let submodules = parseSubmodules submodulesStr
42-
case submodules of
43-
Left _ -> printText ".gitmodules not found."
44-
Right subs -> putStrLn . unlines $ show <$> subs
45-
46-
runAdd :: String -> FilePath -> IO ()
47-
runAdd url path =
48-
if valid path
49-
then do
50-
result <- runShell $ "git submodule add " ++ url ++ " " ++ encodeString path
51-
print result
52-
else printText "invalid path argument"
53-
54-
gitRmCached :: Text
55-
gitRmCached = "git rm --cached "
56-
57-
gitRmGitmodulesEntry :: Text
58-
gitRmGitmodulesEntry = "git config -f .gitmodules --remove-section submodule."
59-
60-
gitRmGitConfigEntry :: Text
61-
gitRmGitConfigEntry = "git config -f .git/config --remove-section submodule."
62-
63-
gitStage :: Text
64-
gitStage = "git add -u"
65-
66-
runRemove :: FilePath -> IO ()
67-
runRemove path = do
68-
runShell removeCached
69-
runShell removeGitmodulesEntry
70-
runShell removeGitConfigEntry
71-
runShell gitStage
72-
printText $ "Submodules entries for " <> path' <> " were deleted."
73-
printText "The changes have been staged for you."
74-
printText "Please commit the changes to complete the submodule removal."
75-
where removeCached = gitRmCached <> path'
76-
removeGitmodulesEntry = gitRmGitmodulesEntry <> path'
77-
removeGitConfigEntry = gitRmGitConfigEntry <> path'
78-
path' = cleanTxt path
79-
80-
runMove :: FilePath -> FilePath -> IO ()
81-
runMove from to = do
82-
runShell $ gitMove <> from' <> " " <> to'
83-
runShell gitStage
84-
printText $ "Submodule moved from " <> from' <> " to " <> to'
85-
printText "The changes have been staged for you."
86-
printText "Please commit the changes to complete the submodule move."
87-
where gitMove = "git mv "
88-
from' = cleanTxt from
89-
to' = cleanTxt to
90-
91-
cleanTxt :: FilePath -> Text
92-
cleanTxt = removeTrailingSlash . toText
93-
where removeTrailingSlash txtPath = case txtPath of
94-
Right text -> if T.last text == '/' then T.dropEnd 1 text else text
95-
Left err -> err
96-
97-
runShell :: (Show a) => a -> IO String
98-
runShell strCommand = readCreateProcess (shell $ show strCommand) ""
99-
100-
printText :: Text -> IO ()
101-
printText = print
7+
gitSubCommand <- GitSub.parseRootCommand
8+
GitSub.run gitSubCommand

‎src/GitSub.hs

Lines changed: 101 additions & 0 deletions
Original file line numberDiff line numberDiff line change
@@ -0,0 +1,101 @@
1+
{-# LANGUAGE OverloadedStrings #-}
2+
3+
module GitSub (run, parseRootCommand) where
4+
5+
import Data.List hiding (intercalate)
6+
import Data.Monoid
7+
import Data.Text as T hiding (intercalate, unlines)
8+
import Filesystem.Path.CurrentOS as Path (FilePath, encodeString,
9+
toText, valid)
10+
11+
import GitSub.CmdParsers
12+
import GitSub.Submodule (parseSubmodules)
13+
import Options.Applicative
14+
import Prelude hiding (FilePath)
15+
import System.Process (readCreateProcess, shell)
16+
17+
run :: Command -> IO ()
18+
run gitSubCommand = case gitSubCommand of
19+
List -> runList
20+
Add url path -> runAdd url path
21+
Remove path -> runRemove path
22+
Move from to -> runMove from to
23+
24+
runList :: IO ()
25+
runList = do
26+
submodulesStr <- readFile ".gitmodules"
27+
let submodules = parseSubmodules submodulesStr
28+
case submodules of
29+
Left _ -> printText ".gitmodules not found."
30+
Right subs -> putStrLn . unlines $ show <$> subs
31+
32+
runAdd :: String -> FilePath -> IO ()
33+
runAdd url path =
34+
if valid path
35+
then do
36+
result <- runShell $ "git submodule add " ++ url ++ " " ++ encodeString path
37+
print result
38+
else printText "invalid path argument"
39+
40+
runRemove :: FilePath -> IO ()
41+
runRemove path = do
42+
runShell removeCached
43+
runShell removeGitmodulesEntry
44+
runShell removeGitConfigEntry
45+
runShell gitStage
46+
printText $ "Submodules entries for " <> path' <> " were deleted."
47+
printText "The changes have been staged for you."
48+
printText "Please commit the changes to complete the submodule removal."
49+
where removeCached = gitRmCached <> path'
50+
removeGitmodulesEntry = gitRmGitmodulesEntry <> path'
51+
removeGitConfigEntry = gitRmGitConfigEntry <> path'
52+
path' = cleanTxt path
53+
54+
runMove :: FilePath -> FilePath -> IO ()
55+
runMove from to = do
56+
runShell $ gitMove <> from' <> " " <> to'
57+
runShell gitStage
58+
printText $ "Submodule moved from " <> from' <> " to " <> to'
59+
printText "The changes have been staged for you."
60+
printText "Please commit the changes to complete the submodule move."
61+
where gitMove = "git mv "
62+
from' = cleanTxt from
63+
to' = cleanTxt to
64+
65+
parseRootCommand :: IO Command
66+
parseRootCommand =
67+
showHelpOnErrorExecParser
68+
(info
69+
(helper <*> parseCommand)
70+
(fullDesc <> progDesc cliDescription <> header cliHeader))
71+
72+
cliDescription :: String
73+
cliDescription = "utility to manage submodules in a git repository"
74+
75+
cliHeader :: String
76+
cliHeader = "git-sub: git submodules made easy"
77+
78+
79+
gitRmCached :: Text
80+
gitRmCached = "git rm --cached "
81+
82+
gitRmGitmodulesEntry :: Text
83+
gitRmGitmodulesEntry = "git config -f .gitmodules --remove-section submodule."
84+
85+
gitRmGitConfigEntry :: Text
86+
gitRmGitConfigEntry = "git config -f .git/config --remove-section submodule."
87+
88+
gitStage :: Text
89+
gitStage = "git add -u"
90+
91+
cleanTxt :: FilePath -> Text
92+
cleanTxt = removeTrailingSlash . toText
93+
where removeTrailingSlash txtPath = case txtPath of
94+
Right text -> if T.last text == '/' then T.dropEnd 1 text else text
95+
Left err -> err
96+
97+
runShell :: (Show a) => a -> IO String
98+
runShell strCommand = readCreateProcess (shell $ show strCommand) ""
99+
100+
printText :: Text -> IO ()
101+
printText = print

0 commit comments

Comments
 (0)