migrate-to-gitea/app/Main.hs

103 lines
2.8 KiB
Haskell

module Main where
import Actions
import Data.Text (pack)
import Options.Applicative
import Request
import Types
data Plan = Plan
{ from :: Source,
to :: Destination,
repos :: [Text]
}
deriving (Eq, Ord, Show)
longShort :: HasName f => String -> Mod f a
longShort t@(c : _) = long t <> short c
longShort t = long t
parsePlan :: ParserInfo Plan
parsePlan =
info
(plan <**> helper)
( fullDesc
<> progDesc "migrate-to-gitea solves the problem wherein you have just spun up a new self-hosted https://gitea.io instance, and now you want to move your project history there (or perhaps to one of the more well known public instances)."
<> header "migrate-to-gitea - cli tool to migrate from git{hub,lab} to a gitea instance"
)
where
plan =
Plan
<$> (sourceSpec <|> source)
<*> (destinationSpec <|> destination)
<*> many repo
sourceSpec =
option
(maybeReader (sourceFromText . pack))
( longShort "from"
<> metavar "FORGE:USER"
<> help "Source to migrate from"
)
source = Source <$> forge <*> fromUser
forge =
option
(str >>= (pure . forgeFromText . pack))
( long "forge"
<> metavar "FORGE"
<> help "Forge to migrate from"
)
fromUser =
mkUser
<$> strOption
( long "from-user"
<> metavar "USER"
<> help "User account to migrate from"
)
destinationSpec =
option
(maybeReader (destinationFromText . pack))
( longShort "to"
<> metavar "GITEA_URL:USER"
<> help "Destination to migrate to"
)
destination = Destination <$> gitea <*> toUser
gitea =
option
(str >>= (pure . mkGitea . pack))
( longShort "gitea-url"
<> metavar "GITEA_URL"
<> help "URL of the Gitea instance to migrate to"
)
toUser =
mkUser
<$> strOption
( long "to-user"
<> metavar "USER"
<> help "Gitea user account to migrate to"
)
repo =
strOption
( longShort "repo"
<> metavar "REPO"
<> help "Repo to migrate. Supply this option multiple times to include multiple repos. Defaults to all repositories"
)
main :: IO ()
main = do
plan <- execParser parsePlan
runRequest (runPlan plan)
runPlan :: Plan -> Request ()
runPlan (Plan {from, to, repos}) = do
repos' <-
if null repos
then listRepos from
else (pure . Right) (sourceRepo from <$> repos)
either
( \case
NotFound -> putTextLn ("Failed to list repos for " <> showSource from)
BadAuth msg -> putText "Authentication issue: " >> putBSLn msg
ParseError msg -> putStrLn msg
)
(mapM_ (chainedTo print . checkRepoExists))
repos'