mirror of
https://code.naskya.net/repos/ndqEd
synced 2025-01-25 20:17:50 +09:00
78 lines
2.6 KiB
Haskell
78 lines
2.6 KiB
Haskell
{- This file is part of Vervis.
|
|
-
|
|
- Written in 2016, 2019, 2020, 2022 by fr33domlover <fr33domlover@riseup.net>.
|
|
-
|
|
- ♡ Copying is an act of love. Please copy, reuse and share.
|
|
-
|
|
- The author(s) have dedicated all copyright and related and neighboring
|
|
- rights to this software to the public domain worldwide. This software is
|
|
- distributed without any warranty.
|
|
-
|
|
- You should have received a copy of the CC0 Public Domain Dedication along
|
|
- with this software. If not, see
|
|
- <http://creativecommons.org/publicdomain/zero/1.0/>.
|
|
-}
|
|
|
|
module Development.PatchMediaType
|
|
( VersionControlSystem (..)
|
|
, PatchMediaType (..)
|
|
, parseVersionControlSystemName
|
|
, parseVersionControlSystemURI
|
|
, versionControlSystemName
|
|
, versionControlSystemURI
|
|
, patchMediaTypeVCS
|
|
, parsePatchMediaType
|
|
, renderPatchMediaType
|
|
)
|
|
where
|
|
|
|
import Control.Monad
|
|
import Data.Text (Text)
|
|
|
|
import qualified Data.Text as T
|
|
|
|
data VersionControlSystem = VCSDarcs | VCSGit deriving Eq
|
|
|
|
data PatchMediaType = PatchMediaTypeDarcs | PatchMediaTypeGit deriving Eq
|
|
|
|
forgeFedPrefix :: Text
|
|
forgeFedPrefix = "https://forgefed.org/ns#"
|
|
|
|
parseVersionControlSystemName :: Text -> Maybe VersionControlSystem
|
|
parseVersionControlSystemName = parse . T.toLower
|
|
where
|
|
parse "darcs" = Just VCSDarcs
|
|
parse "git" = Just VCSGit
|
|
parse _ = Nothing
|
|
|
|
parseVersionControlSystemURI :: Text -> Maybe VersionControlSystem
|
|
parseVersionControlSystemURI = parse <=< T.stripPrefix forgeFedPrefix
|
|
where
|
|
parse "darcs" = Just VCSDarcs
|
|
parse "git" = Just VCSGit
|
|
parse _ = Nothing
|
|
|
|
versionControlSystemName :: VersionControlSystem -> Text
|
|
versionControlSystemName VCSDarcs = "Darcs"
|
|
versionControlSystemName VCSGit = "Git"
|
|
|
|
versionControlSystemURI :: VersionControlSystem -> Text
|
|
versionControlSystemURI vcs = forgeFedPrefix <> rest vcs
|
|
where
|
|
rest VCSDarcs = "darcs"
|
|
rest VCSGit = "git"
|
|
|
|
patchMediaTypeVCS :: PatchMediaType -> VersionControlSystem
|
|
patchMediaTypeVCS PatchMediaTypeDarcs = VCSDarcs
|
|
patchMediaTypeVCS PatchMediaTypeGit = VCSGit
|
|
|
|
-- I don't think there's any standard media type for git patches, just picked
|
|
-- something that resembles the darcs media type
|
|
parsePatchMediaType :: Text -> Maybe PatchMediaType
|
|
parsePatchMediaType "application/x-darcs-patch" = Just PatchMediaTypeDarcs
|
|
parsePatchMediaType "application/x-git-patch" = Just PatchMediaTypeGit
|
|
parsePatchMediaType _ = Nothing
|
|
|
|
renderPatchMediaType :: PatchMediaType -> Text
|
|
renderPatchMediaType PatchMediaTypeDarcs = "application/x-darcs-patch"
|
|
renderPatchMediaType PatchMediaTypeGit = "application/x-git-patch"
|