{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Projects.
--
-- The syntax-related parsing code (what makes a valid project name, etc) could conceivably be moved into a different
-- package, but for now we have just defined the one blessed project/branch name syntax that we allow.
module Unison.Project
  ( ProjectName,
    projectNameUserSlug,
    projectNameToUserProjectSlugs,
    prependUserSlugToProjectName,
    ProjectBranchName,
    projectBranchNameUserSlug,
    ProjectBranchNameKind (..),
    classifyProjectBranchName,
    ProjectBranchNameOrLatestRelease (..),
    ProjectBranchSpecifier (..),
    ProjectAndBranch (..),
    projectAndBranchNamesParser,
    fullyQualifiedProjectAndBranchNamesParser,
    projectAndOptionalBranchParser,
    branchWithOptionalProjectParser,
    ProjectAndBranchNames (..),
    projectAndBranchNamesParser2,
    projectNameParser,
    projectBranchNameParser,

    -- ** Semver
    Semver (..),
  )
where

import Data.Char qualified as Char
import Data.Kind (Type)
import Data.Text qualified as Text
import Data.Text.Read qualified as Text (decimal)
import Data.These (These (..))
import Text.Builder qualified
import Text.Builder qualified as Text (Builder)
import Text.Megaparsec qualified as Megaparsec
import Text.Megaparsec.Char qualified as Megaparsec
import Unison.Core.Project (ProjectAndBranch (..), ProjectBranchName (..), ProjectName (..))
import Unison.Prelude
import Witch

instance From ProjectName Text

instance TryFrom Text ProjectName where
  tryFrom :: Text -> Either (TryFromException Text ProjectName) ProjectName
tryFrom =
    (Text -> Maybe ProjectName)
-> Text -> Either (TryFromException Text ProjectName) ProjectName
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (((ProjectName, Bool) -> ProjectName)
-> Maybe (ProjectName, Bool) -> Maybe ProjectName
forall a b. (a -> b) -> Maybe a -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectName, Bool) -> ProjectName
forall a b. (a, b) -> a
fst (Maybe (ProjectName, Bool) -> Maybe ProjectName)
-> (Text -> Maybe (ProjectName, Bool)) -> Text -> Maybe ProjectName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text (ProjectName, Bool)
-> Text -> Maybe (ProjectName, Bool)
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text (ProjectName, Bool)
projectNameParser)

-- Parse a project name, and whether it ended in a forward slash (which is, of course, not part of the name)
projectNameParser :: Megaparsec.Parsec Void Text (ProjectName, Bool)
projectNameParser :: Parsec Void Text (ProjectName, Bool)
projectNameParser = do
  Builder
userSlug <-
    [ParsecT Void Text Identity Builder]
-> ParsecT Void Text Identity Builder
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ do
          Builder
user <- ParsecT Void Text Identity Builder
userSlugParser
          Builder -> ParsecT Void Text Identity Builder
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Builder
Text.Builder.char Char
'@' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
user Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/'),
        Builder -> ParsecT Void Text Identity Builder
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
forall a. Monoid a => a
mempty
      ]
  Builder
projectSlug <- ParsecT Void Text Identity Builder
projectSlugParser
  Bool
hasTrailingSlash <- Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool)
-> ParsecT Void Text Identity (Maybe Char)
-> ParsecT Void Text Identity Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/')
  (ProjectName, Bool) -> Parsec Void Text (ProjectName, Bool)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> ProjectName
UnsafeProjectName (Builder -> Text
Text.Builder.run (Builder
userSlug Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
projectSlug)), Bool
hasTrailingSlash)
  where
    projectSlugParser :: Megaparsec.Parsec Void Text Text.Builder
    projectSlugParser :: ParsecT Void Text Identity Builder
projectSlugParser = do
      Char
c0 <- (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Megaparsec.satisfy Char -> Bool
Token Text -> Bool
isStartChar
      Text
c1 <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
isStartChar Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
      Builder -> ParsecT Void Text Identity Builder
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Builder
Text.Builder.char Char
c0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
c1)
      where
        isStartChar :: Char -> Bool
        isStartChar :: Char -> Bool
isStartChar Char
c =
          Char -> Bool
Char.isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

-- | Get the user slug at the beginning of a project name, if there is one.
--
-- >>> projectNameUserSlug "@arya/lens"
-- Just "arya"
--
-- >>> projectNameUserSlug "lens"
-- Nothing
projectNameUserSlug :: ProjectName -> Maybe Text
projectNameUserSlug :: ProjectName -> Maybe Text
projectNameUserSlug (UnsafeProjectName Text
projectName) =
  if HasCallStack => Text -> Char
Text -> Char
Text.head Text
projectName Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
    then Text -> Maybe Text
forall a. a -> Maybe a
Just ((Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (Int -> Text -> Text
Text.drop Int
1 Text
projectName))
    else Maybe Text
forall a. Maybe a
Nothing

-- | Parse a "@arya/lens" into the "arya" and "lens" parts.
--
-- If there's no "arya" part, returns the empty string there.
--
-- >>> projectNameToUserProjectSlugs (UnsafeProjectName "@arya/lens")
-- ("arya","lens")
--
-- >>> projectNameToUserProjectSlugs (UnsafeProjectName "lens")
-- ("","lens")
projectNameToUserProjectSlugs :: ProjectName -> (Text, Text)
projectNameToUserProjectSlugs :: ProjectName -> (Text, Text)
projectNameToUserProjectSlugs (UnsafeProjectName Text
name) =
  case (Char -> Bool) -> Text -> (Text, Text)
Text.span (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') Text
name of
    (Text
project, Text
"") -> (Text
"", Text
project)
    (Text
atUser, Text
slashProject) -> (Int -> Text -> Text
Text.drop Int
1 Text
atUser, Int -> Text -> Text
Text.drop Int
1 Text
slashProject)

-- | Prepend a user slug to a project name, if it doesn't already have one.
--
-- >>> prependUserSlugToProjectName "arya" "lens"
-- "@arya/lens"
--
-- >>> prependUserSlugToProjectName "runar" "@unison/base"
-- "@unison/base"
--
-- >>> prependUserSlugToProjectName "???invalid???" "@unison/base"
-- "@unison/base"
prependUserSlugToProjectName :: Text -> ProjectName -> ProjectName
prependUserSlugToProjectName :: Text -> ProjectName -> ProjectName
prependUserSlugToProjectName Text
userSlug (UnsafeProjectName Text
projectName) =
  if HasCallStack => Text -> Char
Text -> Char
Text.head Text
projectName Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
    then Text -> ProjectName
UnsafeProjectName Text
projectName
    else ProjectName -> Maybe ProjectName -> ProjectName
forall a. a -> Maybe a -> a
fromMaybe (Text -> ProjectName
UnsafeProjectName Text
projectName) ((ProjectName, Bool) -> ProjectName
forall a b. (a, b) -> a
fst ((ProjectName, Bool) -> ProjectName)
-> Maybe (ProjectName, Bool) -> Maybe ProjectName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text (ProjectName, Bool)
-> Text -> Maybe (ProjectName, Bool)
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text (ProjectName, Bool)
projectNameParser Text
newProjectName)
  where
    newProjectName :: Text
newProjectName =
      Builder -> Text
Text.Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
        Char -> Builder
Text.Builder.char Char
'@'
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
userSlug
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/'
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
projectName

instance From ProjectBranchName Text

instance TryFrom Text ProjectBranchName where
  tryFrom :: Text
-> Either
     (TryFromException Text ProjectBranchName) ProjectBranchName
tryFrom =
    (Text -> Maybe ProjectBranchName)
-> Text
-> Either
     (TryFromException Text ProjectBranchName) ProjectBranchName
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec Void Text ProjectBranchName
-> Text -> Maybe ProjectBranchName
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
True))

projectBranchNameParser :: Bool -> Megaparsec.Parsec Void Text ProjectBranchName
projectBranchNameParser :: Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
allowLeadingSlash =
  StructuredProjectBranchName -> ProjectBranchName
unstructureStructuredProjectName (StructuredProjectBranchName -> ProjectBranchName)
-> ParsecT Void Text Identity StructuredProjectBranchName
-> Parsec Void Text ProjectBranchName
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ParsecT Void Text Identity StructuredProjectBranchName
structuredProjectBranchNameParser Bool
allowLeadingSlash

-- An internal type that captures the structure of a project branch name after parsing. 'classifyProjectBranchName' is
-- how a user can recover this structure for the few cases it's relevant (e.g. during push)
data StructuredProjectBranchName
  = StructuredProjectBranchName'Contributor !Text.Builder !Text.Builder
  | StructuredProjectBranchName'DraftRelease !Semver
  | StructuredProjectBranchName'Release !Semver
  | StructuredProjectBranchName'NothingSpecial !Text.Builder

unstructureStructuredProjectName :: StructuredProjectBranchName -> ProjectBranchName
unstructureStructuredProjectName :: StructuredProjectBranchName -> ProjectBranchName
unstructureStructuredProjectName =
  Text -> ProjectBranchName
UnsafeProjectBranchName (Text -> ProjectBranchName)
-> (StructuredProjectBranchName -> Text)
-> StructuredProjectBranchName
-> ProjectBranchName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Text.Builder.run (Builder -> Text)
-> (StructuredProjectBranchName -> Builder)
-> StructuredProjectBranchName
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. \case
    StructuredProjectBranchName'Contributor Builder
user Builder
name ->
      Char -> Builder
Text.Builder.char Char
'@' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
user Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
name
    StructuredProjectBranchName'DraftRelease Semver
ver -> Builder
"releases/drafts/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Semver -> Builder
unstructureSemver Semver
ver
    StructuredProjectBranchName'Release Semver
ver -> Builder
"releases/" Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Semver -> Builder
unstructureSemver Semver
ver
    StructuredProjectBranchName'NothingSpecial Builder
name -> Builder
name
  where
    unstructureSemver :: Semver -> Text.Builder
    unstructureSemver :: Semver -> Builder
unstructureSemver (Semver Int
x Int
y Int
z) =
      Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
x
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'.'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
y
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'.'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
z

structuredProjectBranchNameParser :: Bool -> Megaparsec.Parsec Void Text StructuredProjectBranchName
structuredProjectBranchNameParser :: Bool -> ParsecT Void Text Identity StructuredProjectBranchName
structuredProjectBranchNameParser Bool
allowLeadingSlash = do
  ()
_ <- Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
allowLeadingSlash (ParsecT Void Text Identity (Maybe Char)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/')))
  StructuredProjectBranchName
branch <-
    [ParsecT Void Text Identity StructuredProjectBranchName]
-> ParsecT Void Text Identity StructuredProjectBranchName
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ do
          Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string Tokens Text
"releases/drafts/"
          Semver
ver <- Parsec Void Text Semver
semverParser
          StructuredProjectBranchName
-> ParsecT Void Text Identity StructuredProjectBranchName
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Semver -> StructuredProjectBranchName
StructuredProjectBranchName'DraftRelease Semver
ver),
        do
          Tokens Text
_ <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
Megaparsec.string Tokens Text
"releases/"
          Semver
ver <- Parsec Void Text Semver
semverParser
          StructuredProjectBranchName
-> ParsecT Void Text Identity StructuredProjectBranchName
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Semver -> StructuredProjectBranchName
StructuredProjectBranchName'Release Semver
ver),
        do
          Builder
user <- ParsecT Void Text Identity Builder
userSlugParser
          Builder
branch <- ParsecT Void Text Identity Builder
branchSlugParser
          StructuredProjectBranchName
-> ParsecT Void Text Identity StructuredProjectBranchName
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> Builder -> StructuredProjectBranchName
StructuredProjectBranchName'Contributor Builder
user Builder
branch),
        do
          Builder
branch <- ParsecT Void Text Identity Builder
branchSlugParser
          StructuredProjectBranchName
-> ParsecT Void Text Identity StructuredProjectBranchName
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Builder -> StructuredProjectBranchName
StructuredProjectBranchName'NothingSpecial Builder
branch)
      ]
  -- Because our branch has a sort of /-delimited pseudo-structure, we fail on trailing forward slashes.
  --
  -- This (perhaps among other things) lets us successfully parse something like "releases/drafts/1.2.3" as a branch
  -- with an optional project component in a straightforward way, which might otherwise succeed with
  -- project="releases", branch="drafts", leftovers="/1.2.3" (as it did before this line was added).
  ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
Megaparsec.notFollowedBy (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/')
  StructuredProjectBranchName
-> ParsecT Void Text Identity StructuredProjectBranchName
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StructuredProjectBranchName
branch
  where
    branchSlugParser :: Megaparsec.Parsec Void Text Text.Builder
    branchSlugParser :: ParsecT Void Text Identity Builder
branchSlugParser = do
      Char
c0 <- (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Megaparsec.satisfy Char -> Bool
Token Text -> Bool
isStartChar
      Text
c1 <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
isStartChar Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
      Builder -> ParsecT Void Text Identity Builder
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Builder
Text.Builder.char Char
c0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
c1)
      where
        isStartChar :: Char -> Bool
        isStartChar :: Char -> Bool
isStartChar Char
c =
          Char -> Bool
Char.isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

data Semver
  = Semver !Int !Int !Int
  deriving stock (Semver -> Semver -> Bool
(Semver -> Semver -> Bool)
-> (Semver -> Semver -> Bool) -> Eq Semver
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Semver -> Semver -> Bool
== :: Semver -> Semver -> Bool
$c/= :: Semver -> Semver -> Bool
/= :: Semver -> Semver -> Bool
Eq, Int -> Semver -> ShowS
[Semver] -> ShowS
Semver -> [Char]
(Int -> Semver -> ShowS)
-> (Semver -> [Char]) -> ([Semver] -> ShowS) -> Show Semver
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Semver -> ShowS
showsPrec :: Int -> Semver -> ShowS
$cshow :: Semver -> [Char]
show :: Semver -> [Char]
$cshowList :: [Semver] -> ShowS
showList :: [Semver] -> ShowS
Show)

instance From Semver Text where
  from :: Semver -> Text
from (Semver Int
x Int
y Int
z) =
    (Builder -> Text
Text.Builder.run (Builder -> Text) -> ([Builder] -> Builder) -> [Builder] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall m. Monoid m => [m] -> m
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold)
      [ Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
x,
        Char -> Builder
Text.Builder.char Char
'.',
        Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
y,
        Char -> Builder
Text.Builder.char Char
'.',
        Int -> Builder
forall a. Integral a => a -> Builder
Text.Builder.decimal Int
z
      ]

instance TryFrom Text Semver where
  tryFrom :: Text -> Either (TryFromException Text Semver) Semver
tryFrom =
    (Text -> Maybe Semver)
-> Text -> Either (TryFromException Text Semver) Semver
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec Void Text Semver -> Text -> Maybe Semver
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text Semver
semverParser)

semverParser :: Megaparsec.Parsec Void Text Semver
semverParser :: Parsec Void Text Semver
semverParser = do
  Int
x <- ParsecT Void Text Identity Int
decimalParser
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'.'
  Int
y <- ParsecT Void Text Identity Int
decimalParser
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'.'
  Int
z <- ParsecT Void Text Identity Int
decimalParser
  Semver -> Parsec Void Text Semver
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Int -> Int -> Semver
Semver Int
x Int
y Int
z)
  where
    decimalParser :: ParsecT Void Text Identity Int
decimalParser = do
      Text
digits <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
"decimal") Char -> Bool
Token Text -> Bool
Char.isDigit
      Int -> ParsecT Void Text Identity Int
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case Reader Int
forall a. Integral a => Reader a
Text.decimal Text
digits of
        Right (Int
n, Text
_) -> Int
n
        Left [Char]
_ -> Int
0 -- impossible

-- | Though a branch name is just a flat string, we have logic that handles certain strings specially.
--
-- A branch's name indicates it is exactly one of the following:
--
--   * A contributor branch like "@arya/topic"
--   * A draft release branch like "releases/drafts/1.2.3"
--   * A release branch like "releases/1.2.3"
--   * None of the above, like "topic"
--
-- Note these classifications are only tied to the branch's (mutable) name, and are not really otherwise indicative of
-- much.
--
-- For instance,
--
--   - The existence of a local "releases/1.2.3" branch does not necessarily imply the existence of some remote release
--     version "1.2.3".
--   - The existence of a local "@arya/topic@ branch does not necessarily imply the existence of some remote "arya"
--     user made some "topic" branch at some point.
--
-- That said, we do try to make the system mostly make sense by rejecting certain inputs (e.g. you should not be able
-- to easily create a local branch called "releases/1.2.3" out of thin air; you should have to clone it from
-- somewhere). But ultimately, again, branch names are best thought of as opaque, flat strings.
data ProjectBranchNameKind
  = ProjectBranchNameKind'Contributor !Text !ProjectBranchName
  | ProjectBranchNameKind'DraftRelease !Semver
  | ProjectBranchNameKind'Release !Semver
  | ProjectBranchNameKind'NothingSpecial

-- | Classify a project branch name.
--
-- >>> classifyProjectBranchName "@arya/topic"
-- Contributor "arya" "topic"
--
-- >>> classifyProjectBranchName "releases/drafts/1.2.3"
-- DraftRelease (Semver 1 2 3)
--
-- >>> classifyProjectBranchName "releases/1.2.3"
-- Release (Semver 1 2 3)
--
-- >>> classifyProjectBranchName "topic"
-- NothingSpecial
classifyProjectBranchName :: ProjectBranchName -> ProjectBranchNameKind
classifyProjectBranchName :: ProjectBranchName -> ProjectBranchNameKind
classifyProjectBranchName (UnsafeProjectBranchName Text
branchName) =
  case ParsecT Void Text Identity StructuredProjectBranchName
-> Text -> Maybe StructuredProjectBranchName
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (Bool -> ParsecT Void Text Identity StructuredProjectBranchName
structuredProjectBranchNameParser Bool
False) Text
branchName of
    Just (StructuredProjectBranchName'Contributor Builder
user Builder
name) ->
      Text -> ProjectBranchName -> ProjectBranchNameKind
ProjectBranchNameKind'Contributor (Builder -> Text
Text.Builder.run Builder
user) (Text -> ProjectBranchName
UnsafeProjectBranchName (Builder -> Text
Text.Builder.run Builder
name))
    Just (StructuredProjectBranchName'DraftRelease Semver
ver) -> Semver -> ProjectBranchNameKind
ProjectBranchNameKind'DraftRelease Semver
ver
    Just (StructuredProjectBranchName'Release Semver
ver) -> Semver -> ProjectBranchNameKind
ProjectBranchNameKind'Release Semver
ver
    Just (StructuredProjectBranchName'NothingSpecial Builder
_name) -> ProjectBranchNameKind
ProjectBranchNameKind'NothingSpecial
    Maybe StructuredProjectBranchName
Nothing -> [Char] -> ProjectBranchNameKind
forall a. HasCallStack => [Char] -> a
error ([Char] -> ShowS
reportBug [Char]
"E800424" ([Char]
"Invalid project branch name: " [Char] -> ShowS
forall a. [a] -> [a] -> [a]
++ Text -> [Char]
Text.unpack Text
branchName))

-- | Get the user slug at the beginning of a project branch name, if there is one.
--
-- >>> projectBranchNameUserSlug "@arya/topic"
-- Just "arya"
--
-- >>> projectBranchNameUserSlug "topic"
-- Nothing
projectBranchNameUserSlug :: ProjectBranchName -> Maybe Text
projectBranchNameUserSlug :: ProjectBranchName -> Maybe Text
projectBranchNameUserSlug (UnsafeProjectBranchName Text
branchName) =
  if HasCallStack => Text -> Char
Text -> Char
Text.head Text
branchName Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@'
    then Text -> Maybe Text
forall a. a -> Maybe a
Just ((Char -> Bool) -> Text -> Text
Text.takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/') (Int -> Text -> Text
Text.drop Int
1 Text
branchName))
    else Maybe Text
forall a. Maybe a
Nothing

-- | A project branch name, or the latest release of its project.
data ProjectBranchNameOrLatestRelease
  = ProjectBranchNameOrLatestRelease'LatestRelease
  | ProjectBranchNameOrLatestRelease'Name !ProjectBranchName
  deriving stock (ProjectBranchNameOrLatestRelease
-> ProjectBranchNameOrLatestRelease -> Bool
(ProjectBranchNameOrLatestRelease
 -> ProjectBranchNameOrLatestRelease -> Bool)
-> (ProjectBranchNameOrLatestRelease
    -> ProjectBranchNameOrLatestRelease -> Bool)
-> Eq ProjectBranchNameOrLatestRelease
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectBranchNameOrLatestRelease
-> ProjectBranchNameOrLatestRelease -> Bool
== :: ProjectBranchNameOrLatestRelease
-> ProjectBranchNameOrLatestRelease -> Bool
$c/= :: ProjectBranchNameOrLatestRelease
-> ProjectBranchNameOrLatestRelease -> Bool
/= :: ProjectBranchNameOrLatestRelease
-> ProjectBranchNameOrLatestRelease -> Bool
Eq, Int -> ProjectBranchNameOrLatestRelease -> ShowS
[ProjectBranchNameOrLatestRelease] -> ShowS
ProjectBranchNameOrLatestRelease -> [Char]
(Int -> ProjectBranchNameOrLatestRelease -> ShowS)
-> (ProjectBranchNameOrLatestRelease -> [Char])
-> ([ProjectBranchNameOrLatestRelease] -> ShowS)
-> Show ProjectBranchNameOrLatestRelease
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectBranchNameOrLatestRelease -> ShowS
showsPrec :: Int -> ProjectBranchNameOrLatestRelease -> ShowS
$cshow :: ProjectBranchNameOrLatestRelease -> [Char]
show :: ProjectBranchNameOrLatestRelease -> [Char]
$cshowList :: [ProjectBranchNameOrLatestRelease] -> ShowS
showList :: [ProjectBranchNameOrLatestRelease] -> ShowS
Show)

-- | How a project branch can be specified.
data ProjectBranchSpecifier :: Type -> Type where
  -- | By name.
  ProjectBranchSpecifier'Name :: ProjectBranchSpecifier ProjectBranchName
  -- | By name, or "the latest release"
  ProjectBranchSpecifier'NameOrLatestRelease :: ProjectBranchSpecifier ProjectBranchNameOrLatestRelease

projectBranchSpecifierParser :: ProjectBranchSpecifier branch -> Megaparsec.Parsec Void Text branch
projectBranchSpecifierParser :: forall branch.
ProjectBranchSpecifier branch -> Parsec Void Text branch
projectBranchSpecifierParser = \case
  ProjectBranchSpecifier branch
ProjectBranchSpecifier'Name -> Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False
  ProjectBranchSpecifier branch
ProjectBranchSpecifier'NameOrLatestRelease ->
    [Parsec Void Text branch] -> Parsec Void Text branch
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
      [ branch
ProjectBranchNameOrLatestRelease
ProjectBranchNameOrLatestRelease'LatestRelease branch
-> ParsecT Void Text Identity Text -> Parsec Void Text branch
forall a b.
a -> ParsecT Void Text Identity b -> ParsecT Void Text Identity a
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ ParsecT Void Text Identity Text
"releases/latest",
        ProjectBranchName -> branch
ProjectBranchName -> ProjectBranchNameOrLatestRelease
ProjectBranchNameOrLatestRelease'Name (ProjectBranchName -> branch)
-> Parsec Void Text ProjectBranchName -> Parsec Void Text branch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False
      ]

instance From (ProjectAndBranch ProjectName ProjectBranchName) Text where
  from :: ProjectAndBranch ProjectName ProjectBranchName -> Text
from (ProjectAndBranch ProjectName
project ProjectBranchName
branch) =
    Builder -> Text
Text.Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
      Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectName
project)
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/'
        Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectBranchName
branch)

-- | Sometimes, it's convenient (to users) if we defer interpreting certain names (like "foo") as a project name or
-- branch name, instead leaving it up to a command handler to handle the ambiguity.
--
-- For example, we might want "switch foo" to switch to either the project "foo", or the branch "foo", or complain if
-- both exist.
--
-- This type is useful for those situtations.
data ProjectAndBranchNames
  = ProjectAndBranchNames'Ambiguous ProjectName ProjectBranchName
  | ProjectAndBranchNames'Unambiguous (These ProjectName ProjectBranchName)
  deriving stock (ProjectAndBranchNames -> ProjectAndBranchNames -> Bool
(ProjectAndBranchNames -> ProjectAndBranchNames -> Bool)
-> (ProjectAndBranchNames -> ProjectAndBranchNames -> Bool)
-> Eq ProjectAndBranchNames
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ProjectAndBranchNames -> ProjectAndBranchNames -> Bool
== :: ProjectAndBranchNames -> ProjectAndBranchNames -> Bool
$c/= :: ProjectAndBranchNames -> ProjectAndBranchNames -> Bool
/= :: ProjectAndBranchNames -> ProjectAndBranchNames -> Bool
Eq, Int -> ProjectAndBranchNames -> ShowS
[ProjectAndBranchNames] -> ShowS
ProjectAndBranchNames -> [Char]
(Int -> ProjectAndBranchNames -> ShowS)
-> (ProjectAndBranchNames -> [Char])
-> ([ProjectAndBranchNames] -> ShowS)
-> Show ProjectAndBranchNames
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ProjectAndBranchNames -> ShowS
showsPrec :: Int -> ProjectAndBranchNames -> ShowS
$cshow :: ProjectAndBranchNames -> [Char]
show :: ProjectAndBranchNames -> [Char]
$cshowList :: [ProjectAndBranchNames] -> ShowS
showList :: [ProjectAndBranchNames] -> ShowS
Show)

instance TryFrom Text ProjectAndBranchNames where
  tryFrom :: Text
-> Either
     (TryFromException Text ProjectAndBranchNames) ProjectAndBranchNames
tryFrom =
    (Text -> Maybe ProjectAndBranchNames)
-> Text
-> Either
     (TryFromException Text ProjectAndBranchNames) ProjectAndBranchNames
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec Void Text ProjectAndBranchNames
-> Text -> Maybe ProjectAndBranchNames
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec Void Text ProjectAndBranchNames
projectAndBranchNamesParser2)

projectAndBranchNamesParser2 :: Megaparsec.Parsec Void Text ProjectAndBranchNames
projectAndBranchNamesParser2 :: Parsec Void Text ProjectAndBranchNames
projectAndBranchNamesParser2 = do
  ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/') ParsecT Void Text Identity (Maybe Char)
-> (Maybe Char -> Parsec Void Text ProjectAndBranchNames)
-> Parsec Void Text ProjectAndBranchNames
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Char
Nothing ->
      [Parsec Void Text ProjectAndBranchNames]
-> Parsec Void Text ProjectAndBranchNames
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
        [ Parsec Void Text ProjectAndBranchNames
-> Parsec Void Text ProjectAndBranchNames
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Megaparsec.try do
            (ProjectName
project, Bool
hasTrailingSlash) <- Parsec Void Text (ProjectName, Bool)
projectNameParser
            if Bool
hasTrailingSlash
              then do
                ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Char -> ParsecT Void Text Identity Char
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Megaparsec.lookAhead ParsecT Void Text Identity Char
ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
Megaparsec.anySingle) ParsecT Void Text Identity (Maybe Char)
-> (Maybe Char -> Parsec Void Text ProjectAndBranchNames)
-> Parsec Void Text ProjectAndBranchNames
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                  Maybe Char
Nothing -> ProjectAndBranchNames -> Parsec Void Text ProjectAndBranchNames
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous (ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
project))
                  Just Char
nextChar
                    -- This project looks like "<name>/<digit>" so far... we want to fail here, and pick back up at
                    -- `unambiguousBranchParser` below, because a string like "releases/1.2.3" is a valid branch, and
                    -- we don't want to succeed with project name "releases" and leftovers "1.2.3"
                    --
                    -- Technically it's pointless to fall back on `unambiguousBranchParser` if the project name is not
                    -- exactly "releases", but oh well.
                    | Char -> Bool
Char.isDigit Char
nextChar -> Parsec Void Text ProjectAndBranchNames
forall a. ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a
empty
                    -- If the character after "<name>/" is the valid start of a branch, then parse a branch.
                    | Char -> Bool
Char.isAlpha Char
nextChar Bool -> Bool -> Bool
|| Char
nextChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'@' Bool -> Bool -> Bool
|| Char
nextChar Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' -> do
                        ProjectBranchName
branch <- Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False
                        ProjectAndBranchNames -> Parsec Void Text ProjectAndBranchNames
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous (ProjectName
-> ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. a -> b -> These a b
These ProjectName
project ProjectBranchName
branch))
                    -- Otherwise, some invalid start-of-branch character follows, like a close paren or something.
                    | Bool
otherwise -> ProjectAndBranchNames -> Parsec Void Text ProjectAndBranchNames
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous (ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
project))
              else ProjectAndBranchNames -> Parsec Void Text ProjectAndBranchNames
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure case Parsec Void Text ProjectBranchName
-> Text -> Maybe ProjectBranchName
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False) (forall target source. From source target => source -> target
into @Text ProjectName
project) of
                Maybe ProjectBranchName
Nothing -> These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous (ProjectName -> These ProjectName ProjectBranchName
forall a b. a -> These a b
This ProjectName
project)
                Just ProjectBranchName
branch -> ProjectName -> ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Ambiguous ProjectName
project ProjectBranchName
branch,
          Parsec Void Text ProjectAndBranchNames
unambiguousBranchParser
        ]
    Just Char
_ -> Parsec Void Text ProjectAndBranchNames
unambiguousBranchParser
  where
    unambiguousBranchParser :: Parsec Void Text ProjectAndBranchNames
unambiguousBranchParser = do
      ProjectBranchName
branch <- Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False
      ProjectAndBranchNames -> Parsec Void Text ProjectAndBranchNames
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These ProjectName ProjectBranchName -> ProjectAndBranchNames
ProjectAndBranchNames'Unambiguous (ProjectBranchName -> These ProjectName ProjectBranchName
forall a b. b -> These a b
That ProjectBranchName
branch))

-- TODO this should go away in favor of ProjectAndBranchNames
instance From (These ProjectName ProjectBranchName) Text where
  from :: These ProjectName ProjectBranchName -> Text
from = \case
    This ProjectName
project1 -> forall target source. From source target => source -> target
into @Text ProjectName
project1
    That ProjectBranchName
branch1 -> Builder -> Text
Text.Builder.run (Char -> Builder
Text.Builder.char Char
'/' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectBranchName
branch1))
    These ProjectName
project1 ProjectBranchName
branch1 ->
      Builder -> Text
Text.Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
        Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectName
project1)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/'
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectBranchName
branch1)

instance TryFrom Text (These ProjectName ProjectBranchName) where
  tryFrom :: Text
-> Either
     (TryFromException Text (These ProjectName ProjectBranchName))
     (These ProjectName ProjectBranchName)
tryFrom =
    (Text -> Maybe (These ProjectName ProjectBranchName))
-> Text
-> Either
     (TryFromException Text (These ProjectName ProjectBranchName))
     (These ProjectName ProjectBranchName)
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec Void Text (These ProjectName ProjectBranchName)
-> Text -> Maybe (These ProjectName ProjectBranchName)
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (ProjectBranchSpecifier ProjectBranchName
-> Parsec Void Text (These ProjectName ProjectBranchName)
forall branch.
ProjectBranchSpecifier branch
-> Parsec Void Text (These ProjectName branch)
projectAndBranchNamesParser ProjectBranchSpecifier ProjectBranchName
ProjectBranchSpecifier'Name))

-- Valid things:
--
--   1. project
--   2. project/
--   3. project/branch
--   4. /branch
projectAndBranchNamesParser ::
  forall branch.
  ProjectBranchSpecifier branch ->
  Megaparsec.Parsec Void Text (These ProjectName branch)
projectAndBranchNamesParser :: forall branch.
ProjectBranchSpecifier branch
-> Parsec Void Text (These ProjectName branch)
projectAndBranchNamesParser ProjectBranchSpecifier branch
specifier = do
  Parsec Void Text (ProjectName, Bool)
-> ParsecT Void Text Identity (Maybe (ProjectName, Bool))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parsec Void Text (ProjectName, Bool)
projectNameParser ParsecT Void Text Identity (Maybe (ProjectName, Bool))
-> (Maybe (ProjectName, Bool)
    -> Parsec Void Text (These ProjectName branch))
-> Parsec Void Text (These ProjectName branch)
forall a b.
ParsecT Void Text Identity a
-> (a -> ParsecT Void Text Identity b)
-> ParsecT Void Text Identity b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe (ProjectName, Bool)
Nothing -> do
      Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/'
      branch
branch <- ProjectBranchSpecifier branch -> Parsec Void Text branch
forall branch.
ProjectBranchSpecifier branch -> Parsec Void Text branch
projectBranchSpecifierParser ProjectBranchSpecifier branch
specifier
      These ProjectName branch
-> Parsec Void Text (These ProjectName branch)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (branch -> These ProjectName branch
forall a b. b -> These a b
That branch
branch)
    Just (ProjectName
project, Bool
hasTrailingSlash) ->
      if Bool
hasTrailingSlash
        then do
          Parsec Void Text branch
-> ParsecT Void Text Identity (Maybe branch)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ProjectBranchSpecifier branch -> Parsec Void Text branch
forall branch.
ProjectBranchSpecifier branch -> Parsec Void Text branch
projectBranchSpecifierParser ProjectBranchSpecifier branch
specifier) ParsecT Void Text Identity (Maybe branch)
-> (Maybe branch -> These ProjectName branch)
-> Parsec Void Text (These ProjectName branch)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            Maybe branch
Nothing -> ProjectName -> These ProjectName branch
forall a b. a -> These a b
This ProjectName
project
            Just branch
branch -> ProjectName -> branch -> These ProjectName branch
forall a b. a -> b -> These a b
These ProjectName
project branch
branch
        else These ProjectName branch
-> Parsec Void Text (These ProjectName branch)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName -> These ProjectName branch
forall a b. a -> These a b
This ProjectName
project)

-- | Parse a fully specified myproject/mybranch name.
--
-- >>> import Text.Megaparsec (parseMaybe)
-- >>> parseMaybe fullyQualifiedProjectAndBranchNamesParser ("myproject/mybranch" :: Text)
-- Just (ProjectAndBranch {project = UnsafeProjectName "myproject", branch = UnsafeProjectBranchName "mybranch"})
fullyQualifiedProjectAndBranchNamesParser :: Megaparsec.Parsec Void Text (ProjectAndBranch ProjectName ProjectBranchName)
fullyQualifiedProjectAndBranchNamesParser :: Parsec Void Text (ProjectAndBranch ProjectName ProjectBranchName)
fullyQualifiedProjectAndBranchNamesParser = do
  (ProjectName
project, Bool
hadSlash) <- Parsec Void Text (ProjectName, Bool)
projectNameParser
  if Bool
hadSlash
    then () -> ParsecT Void Text Identity ()
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    else ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/'
  ProjectBranchName
branch <- Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False
  ProjectAndBranch ProjectName ProjectBranchName
-> Parsec
     Void Text (ProjectAndBranch ProjectName ProjectBranchName)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
project ProjectBranchName
branch)

-- | @project/branch@ syntax, where the branch is optional.
instance From (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) Text where
  from :: ProjectAndBranch ProjectName (Maybe ProjectBranchName) -> Text
from = \case
    ProjectAndBranch ProjectName
project Maybe ProjectBranchName
Nothing -> forall target source. From source target => source -> target
into @Text ProjectName
project
    ProjectAndBranch ProjectName
project (Just ProjectBranchName
branch) ->
      Builder -> Text
Text.Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
        Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectName
project)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/'
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectBranchName
branch)

instance TryFrom Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName)) where
  tryFrom :: Text
-> Either
     (TryFromException
        Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName)))
     (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
tryFrom =
    (Text
 -> Maybe (ProjectAndBranch ProjectName (Maybe ProjectBranchName)))
-> Text
-> Either
     (TryFromException
        Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName)))
     (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec
  Void Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
-> Text
-> Maybe (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (ProjectBranchSpecifier ProjectBranchName
-> Parsec
     Void Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
forall branch.
ProjectBranchSpecifier branch
-> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
projectAndOptionalBranchParser ProjectBranchSpecifier ProjectBranchName
ProjectBranchSpecifier'Name))

-- | Attempt to parse a project and branch name from a string where both are required.
instance TryFrom Text (ProjectAndBranch ProjectName ProjectBranchName) where
  tryFrom :: Text
-> Either
     (TryFromException
        Text (ProjectAndBranch ProjectName ProjectBranchName))
     (ProjectAndBranch ProjectName ProjectBranchName)
tryFrom =
    (Text -> Maybe (ProjectAndBranch ProjectName ProjectBranchName))
-> Text
-> Either
     (TryFromException
        Text (ProjectAndBranch ProjectName ProjectBranchName))
     (ProjectAndBranch ProjectName ProjectBranchName)
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom ((Text -> Maybe (ProjectAndBranch ProjectName ProjectBranchName))
 -> Text
 -> Either
      (TryFromException
         Text (ProjectAndBranch ProjectName ProjectBranchName))
      (ProjectAndBranch ProjectName ProjectBranchName))
-> (Text -> Maybe (ProjectAndBranch ProjectName ProjectBranchName))
-> Text
-> Either
     (TryFromException
        Text (ProjectAndBranch ProjectName ProjectBranchName))
     (ProjectAndBranch ProjectName ProjectBranchName)
forall a b. (a -> b) -> a -> b
$ \Text
txt -> do
      ProjectAndBranch ProjectName
projectName Maybe ProjectBranchName
mayBranchName <- Parsec
  Void Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
-> Text
-> Maybe (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (ProjectBranchSpecifier ProjectBranchName
-> Parsec
     Void Text (ProjectAndBranch ProjectName (Maybe ProjectBranchName))
forall branch.
ProjectBranchSpecifier branch
-> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
projectAndOptionalBranchParser ProjectBranchSpecifier ProjectBranchName
ProjectBranchSpecifier'Name) Text
txt
      ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
projectName (ProjectBranchName
 -> ProjectAndBranch ProjectName ProjectBranchName)
-> Maybe ProjectBranchName
-> Maybe (ProjectAndBranch ProjectName ProjectBranchName)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe ProjectBranchName
mayBranchName

instance TryFrom Text (ProjectAndBranch ProjectName (Maybe ProjectBranchNameOrLatestRelease)) where
  tryFrom :: Text
-> Either
     (TryFromException
        Text
        (ProjectAndBranch
           ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
tryFrom =
    (Text
 -> Maybe
      (ProjectAndBranch
         ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
-> Text
-> Either
     (TryFromException
        Text
        (ProjectAndBranch
           ProjectName (Maybe ProjectBranchNameOrLatestRelease)))
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec
  Void
  Text
  (ProjectAndBranch
     ProjectName (Maybe ProjectBranchNameOrLatestRelease))
-> Text
-> Maybe
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe (ProjectBranchSpecifier ProjectBranchNameOrLatestRelease
-> Parsec
     Void
     Text
     (ProjectAndBranch
        ProjectName (Maybe ProjectBranchNameOrLatestRelease))
forall branch.
ProjectBranchSpecifier branch
-> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
projectAndOptionalBranchParser ProjectBranchSpecifier ProjectBranchNameOrLatestRelease
ProjectBranchSpecifier'NameOrLatestRelease))

-- Valid things:
--
--   1. project
--   2. project/
--   3. project/branch
projectAndOptionalBranchParser ::
  forall branch.
  ProjectBranchSpecifier branch ->
  Megaparsec.Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
projectAndOptionalBranchParser :: forall branch.
ProjectBranchSpecifier branch
-> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
projectAndOptionalBranchParser ProjectBranchSpecifier branch
specifier = do
  (ProjectName
project, Bool
hasTrailingSlash) <- Parsec Void Text (ProjectName, Bool)
projectNameParser
  (Maybe branch -> ProjectAndBranch ProjectName (Maybe branch))
-> ParsecT Void Text Identity (Maybe branch)
-> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
forall a b.
(a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (ProjectName
-> Maybe branch -> ProjectAndBranch ProjectName (Maybe branch)
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
project) (ParsecT Void Text Identity (Maybe branch)
 -> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch)))
-> ParsecT Void Text Identity (Maybe branch)
-> Parsec Void Text (ProjectAndBranch ProjectName (Maybe branch))
forall a b. (a -> b) -> a -> b
$
    if Bool
hasTrailingSlash
      then ParsecT Void Text Identity branch
-> ParsecT Void Text Identity (Maybe branch)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ProjectBranchSpecifier branch -> ParsecT Void Text Identity branch
forall branch.
ProjectBranchSpecifier branch -> Parsec Void Text branch
projectBranchSpecifierParser ProjectBranchSpecifier branch
specifier)
      else Maybe branch -> ParsecT Void Text Identity (Maybe branch)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe branch
forall a. Maybe a
Nothing

-- | @project/branch@ syntax, where the project is optional. The branch can optionally be preceded by a forward slash.
instance From (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) Text where
  from :: ProjectAndBranch (Maybe ProjectName) ProjectBranchName -> Text
from = \case
    ProjectAndBranch Maybe ProjectName
Nothing ProjectBranchName
branch -> forall target source. From source target => source -> target
into @Text ProjectBranchName
branch
    ProjectAndBranch (Just ProjectName
project) ProjectBranchName
branch ->
      Builder -> Text
Text.Builder.run (Builder -> Text) -> Builder -> Text
forall a b. (a -> b) -> a -> b
$
        Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectName
project)
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Text.Builder.char Char
'/'
          Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text (forall target source. From source target => source -> target
into @Text ProjectBranchName
branch)

instance TryFrom Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName) where
  tryFrom :: Text
-> Either
     (TryFromException
        Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
tryFrom =
    (Text
 -> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
-> Text
-> Either
     (TryFromException
        Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName))
     (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall source target.
(source -> Maybe target)
-> source -> Either (TryFromException source target) target
maybeTryFrom (Parsec
  Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Text
-> Maybe (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
Megaparsec.parseMaybe Parsec
  Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
branchWithOptionalProjectParser)

-- Valid things:
--
--   1. branch
--   2. /branch
--   3. project/branch
branchWithOptionalProjectParser :: Megaparsec.Parsec Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
branchWithOptionalProjectParser :: Parsec
  Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
branchWithOptionalProjectParser =
  [Parsec
   Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)]
-> Parsec
     Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Parsec
  Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
-> Parsec
     Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a.
ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
Megaparsec.try do
        (ProjectName
project, Bool
hasTrailingSlash) <- Parsec Void Text (ProjectName, Bool)
projectNameParser
        Bool -> ParsecT Void Text Identity ()
forall (f :: * -> *). Alternative f => Bool -> f ()
guard Bool
hasTrailingSlash
        ProjectBranchName
branch <- Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
False
        ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Parsec
     Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProjectName
-> ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch (ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
Just ProjectName
project) ProjectBranchName
branch),
      do
        ProjectBranchName
branch <- Bool -> Parsec Void Text ProjectBranchName
projectBranchNameParser Bool
True
        ProjectAndBranch (Maybe ProjectName) ProjectBranchName
-> Parsec
     Void Text (ProjectAndBranch (Maybe ProjectName) ProjectBranchName)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProjectName
-> ProjectBranchName
-> ProjectAndBranch (Maybe ProjectName) ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch Maybe ProjectName
forall a. Maybe a
Nothing ProjectBranchName
branch)
    ]

------------------------------------------------------------------------------------------------------------------------

-- Projects and branches may begin with a "user slug", which looks like "@arya/". This parser parses such slugs,
-- returning just the username (e.g. "arya").
--
-- slug       = @ start-char char* /
-- start-char = alpha
-- char       = alpha | digit | -
userSlugParser :: Megaparsec.Parsec Void Text Text.Builder.Builder
userSlugParser :: ParsecT Void Text Identity Builder
userSlugParser = do
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'@'
  Char
c0 <- (Token Text -> Bool) -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
Megaparsec.satisfy Char -> Bool
Token Text -> Bool
Char.isAlpha
  Text
c1 <- Maybe [Char]
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
Megaparsec.takeWhileP Maybe [Char]
forall a. Maybe a
Nothing (\Token Text
c -> Char -> Bool
Char.isAlpha Char
Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
Char.isDigit Char
Token Text
c Bool -> Bool -> Bool
|| Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-')
  Char
_ <- Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
Megaparsec.char Char
Token Text
'/'
  Builder -> ParsecT Void Text Identity Builder
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Builder
Text.Builder.char Char
c0 Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
Text.Builder.text Text
c1)