84 lines
2.1 KiB
Haskell
84 lines
2.1 KiB
Haskell
module Types where
|
|
|
|
import Data.Text
|
|
import Network.HTTP.Req
|
|
import Request
|
|
import Web.Internal.HttpApiData
|
|
|
|
newtype Gitea = G Text
|
|
deriving (Eq, Ord, Show)
|
|
|
|
mkGitea :: Text -> Gitea
|
|
mkGitea = G
|
|
|
|
newtype User = U Text
|
|
deriving (Eq, Ord, Show)
|
|
|
|
instance ToHttpApiData User where
|
|
toUrlPiece (U t) = t
|
|
|
|
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
|
|
|
|
showSource :: Source -> Text
|
|
showSource (Source forge (U user)) = forgeName forge <> ":" <> user
|
|
|
|
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
|
|
|
|
showDestination :: Destination -> Text
|
|
showDestination (Destination (G host) (U user)) = host <> ":" <> user
|
|
|
|
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)
|
|
|
|
forgeName :: Forge -> Text
|
|
forgeName Github = "github"
|
|
forgeName Gitlab = "gitlab"
|
|
forgeName (Gitea (G host)) = host
|
|
|
|
forgeHost :: Forge -> Text
|
|
forgeHost (Gitea (G host)) = host
|
|
forgeHost (forgeName -> forge) = forge <> ".com"
|
|
|
|
forgeUrl :: Forge -> URL
|
|
forgeUrl (forgeHost -> host) = https host
|
|
|
|
apiUrl :: Forge -> URL
|
|
apiUrl Github = https "api.github.com"
|
|
apiUrl _ = error "Not implemented"
|
|
|
|
data Repo = Repo Forge User Text
|
|
deriving (Eq, Ord, Show)
|
|
|
|
repoUrl :: Repo -> URL
|
|
repoUrl (Repo (apiUrl -> url) user name) = url /~ user /: name
|
|
|
|
sourceRepo :: Source -> Text -> Repo
|
|
sourceRepo (Source repo user) name = Repo repo user name
|
|
|
|
destinationRepo :: Destination -> Text -> Repo
|
|
destinationRepo (Destination gitea user) name = Repo (Gitea gitea) user name
|