diff --git a/README.md b/README.md index 7cac217..2cb0137 100644 --- a/README.md +++ b/README.md @@ -5,7 +5,7 @@ migrate-to-gitea solves the problem wherein you have just spun up a new self-hos ### usage ``` -migrate-to-gitea --from github --user matthewess --archive +migrate-to-gitea --from github:matthewess --to git.mat.services:mat ``` ### features diff --git a/app/Main.hs b/app/Main.hs index 65ae4a0..463f087 100644 --- a/app/Main.hs +++ b/app/Main.hs @@ -1,4 +1,73 @@ module Main where +import Data.Text (pack) +import Options.Applicative +import Types + +data Options = Options + { from :: Source, + to :: Destination + } + deriving (Eq, Ord, Show) + +longShort :: HasName f => String -> Mod f a +longShort t@(c : _) = long t <> short c +longShort t = long t + +options :: Parser Options +options = + Options + <$> (sourceSpec <|> source) + <*> (destinationSpec <|> destination) + where + sourceSpec = + option + (maybeReader (sourceFromText . pack)) + ( longShort "from" + <> help "Source to migrate from in the form of 'FORGE:USER'" + ) + source = Source <$> forge <*> fromUser + forge = + option + (str >>= (pure . forgeFromText . pack)) + ( long "forge" + <> help "Forge to migrate from" + ) + fromUser = + mkUser + <$> strOption + ( long "from-user" + <> help "User account to migrate from" + ) + destinationSpec = + option + (maybeReader (destinationFromText . pack)) + ( longShort "to" + <> help "Destiation to migrate to in the form of 'GITEA_URL:USER'" + ) + destination = Destination <$> gitea <*> toUser + gitea = + option + (str >>= (pure . mkGitea . pack)) + ( longShort "gitea-url" + <> help "URL of the Gitea instance to migrate to" + ) + toUser = + mkUser + <$> strOption + ( long "to-user" + <> help "User account to migrate to" + ) + main :: IO () -main = putStrLn "Hello, Haskell!" +main = do + args <- execParser parser + print args + where + parser = + info + (options <**> 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" + ) diff --git a/app/Types.hs b/app/Types.hs new file mode 100644 index 0000000..340221b --- /dev/null +++ b/app/Types.hs @@ -0,0 +1,62 @@ +module Types + ( Gitea, + mkGitea, + User, + mkUser, + Source (..), + sourceFromText, + Destination (..), + destinationFromText, + Forge (..), + forgeFromText, + forgeUrl, + ) +where + +import Data.Text (splitOn) +import Network.HTTP.Req (Scheme (Https), Url, https) + +newtype Gitea = G (Url 'Https) + deriving (Eq, Ord, Show) + +mkGitea :: Text -> Gitea +mkGitea = G . https + +newtype User = U Text + deriving (Eq, Ord, Show) + +mkUser :: Text -> User +mkUser = U + +data Source = Source Forge User + deriving (Eq, Ord, Show) + +sourceFromText :: Text -> Maybe Source +sourceFromText (splitOn ":" -> [forge, user]) = Just (Source (forgeFromText forge) (mkUser user)) +sourceFromText _ = Nothing + +data Destination = Destination Gitea User + deriving (Eq, Ord, Show) + +destinationFromText :: Text -> Maybe Destination +destinationFromText (splitOn ":" -> [host, user]) = Just (Destination (mkGitea host) (mkUser user)) +destinationFromText _ = Nothing + +data Forge + = Github + | Gitlab + | Gitea Gitea + deriving (Eq, Ord, Show) + +forgeFromText :: Text -> Forge +forgeFromText "github" = Github +forgeFromText "github.com" = Github +forgeFromText "gitlab" = Gitlab +forgeFromText "gitlab.com" = Gitlab +forgeFromText "codeberg" = Gitea (mkGitea "codeberg.org") +forgeFromText host = Gitea (mkGitea host) + +forgeUrl :: Forge -> Url 'Https +forgeUrl Github = https "github.com" +forgeUrl Gitlab = https "gitlab.com" +forgeUrl (Gitea (G url)) = url diff --git a/migrate-to-gitea.cabal b/migrate-to-gitea.cabal index c5909f2..536622f 100644 --- a/migrate-to-gitea.cabal +++ b/migrate-to-gitea.cabal @@ -27,10 +27,31 @@ executable migrate-to-gitea main-is: Main.hs -- Modules included in this executable, other than Main. - -- other-modules: + other-modules: Types -- LANGUAGE extensions used by modules in this package. - other-extensions: GHC2021 - build-depends: base ^>=4.14.3.0 + default-extensions: + DataKinds + DerivingVia + LambdaCase + MultiWayIf + NoStarIsType + OverloadedStrings + TypeFamilies + ViewPatterns + build-depends: + , base >=4.13.0.0 && <=4.18.0.0 + , relude + , optparse-applicative + , req + , text + , with-utf8 + mixins: + base hiding (Prelude), + relude (Relude as Prelude, Relude.Container.One), + relude hs-source-dirs: app - default-language: Haskell2010 + default-language: GHC2021 + ghc-options: + -Wall -Wincomplete-record-updates -Wincomplete-uni-patterns -Wunused-foralls -Wunused-foralls + -fprint-explicit-foralls -fprint-explicit-kinds