Reorganize

main
mat ess 2022-07-16 23:12:03 -04:00
parent e9a8fee5b4
commit 4c6cbf7a86
4 changed files with 158 additions and 6 deletions

View File

@ -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

View File

@ -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"
)

62
app/Types.hs Normal file
View File

@ -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

View File

@ -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