module Unison.CommandLine.BranchRelativePath
  ( BranchRelativePath (..),
    parseBranchRelativePath,
    branchRelativePathParser,
    parseIncrementalBranchRelativePath,
    IncrementalBranchRelativePath (..),
  )
where

import Data.Set qualified as Set
import Data.Text qualified as Text
import Data.These (These (..))
import Text.Megaparsec qualified as Megaparsec
import Text.Megaparsec.Char qualified as Megaparsec
import Unison.Codebase.Path qualified as Path
import Unison.Codebase.Path.Parse qualified as Path
import Unison.Codebase.ProjectPath (ProjectPathG (..))
import Unison.Prelude
import Unison.Project (ProjectAndBranch (..), ProjectBranchName, ProjectName)
import Unison.Project qualified as Project
import Unison.Util.ColorText qualified as CT
import Unison.Util.Pretty qualified as P

data BranchRelativePath
  = -- | A path rooted at some specified branch/project
    BranchPathInCurrentProject ProjectBranchName Path.Absolute
  | QualifiedBranchPath ProjectName ProjectBranchName Path.Absolute
  | -- | A path which is relative to the user's current location.
    UnqualifiedPath Path.Path'
  deriving stock (BranchRelativePath -> BranchRelativePath -> Bool
(BranchRelativePath -> BranchRelativePath -> Bool)
-> (BranchRelativePath -> BranchRelativePath -> Bool)
-> Eq BranchRelativePath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: BranchRelativePath -> BranchRelativePath -> Bool
== :: BranchRelativePath -> BranchRelativePath -> Bool
$c/= :: BranchRelativePath -> BranchRelativePath -> Bool
/= :: BranchRelativePath -> BranchRelativePath -> Bool
Eq, Int -> BranchRelativePath -> ShowS
[BranchRelativePath] -> ShowS
BranchRelativePath -> String
(Int -> BranchRelativePath -> ShowS)
-> (BranchRelativePath -> String)
-> ([BranchRelativePath] -> ShowS)
-> Show BranchRelativePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> BranchRelativePath -> ShowS
showsPrec :: Int -> BranchRelativePath -> ShowS
$cshow :: BranchRelativePath -> String
show :: BranchRelativePath -> String
$cshowList :: [BranchRelativePath] -> ShowS
showList :: [BranchRelativePath] -> ShowS
Show)

instance Path.Pathy BranchRelativePath where
  descend :: BranchRelativePath -> NameSegment -> BranchRelativePath
descend BranchRelativePath
brp NameSegment
seg = case BranchRelativePath
brp of
    BranchPathInCurrentProject ProjectBranchName
branch Absolute
abs -> ProjectBranchName -> Absolute -> BranchRelativePath
BranchPathInCurrentProject ProjectBranchName
branch (Absolute -> BranchRelativePath) -> Absolute -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> NameSegment -> Absolute
forall path. Pathy path => path -> NameSegment -> path
Path.descend Absolute
abs NameSegment
seg
    QualifiedBranchPath ProjectName
proj ProjectBranchName
branch Absolute
abs -> ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath ProjectName
proj ProjectBranchName
branch (Absolute -> BranchRelativePath) -> Absolute -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> NameSegment -> Absolute
forall path. Pathy path => path -> NameSegment -> path
Path.descend Absolute
abs NameSegment
seg
    UnqualifiedPath Path'
path -> Path' -> BranchRelativePath
UnqualifiedPath (Path' -> BranchRelativePath) -> Path' -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Path' -> NameSegment -> Path'
forall path. Pathy path => path -> NameSegment -> path
Path.descend Path'
path NameSegment
seg
  prefix :: BranchRelativePath -> Relative -> BranchRelativePath
prefix BranchRelativePath
pre Relative
suf = case BranchRelativePath
pre of
    BranchPathInCurrentProject ProjectBranchName
branch Absolute
abs -> ProjectBranchName -> Absolute -> BranchRelativePath
BranchPathInCurrentProject ProjectBranchName
branch (Absolute -> BranchRelativePath) -> Absolute -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> Relative -> Absolute
forall path. Pathy path => path -> Relative -> path
Path.prefix Absolute
abs Relative
suf
    QualifiedBranchPath ProjectName
proj ProjectBranchName
branch Absolute
abs -> ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath ProjectName
proj ProjectBranchName
branch (Absolute -> BranchRelativePath) -> Absolute -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> Relative -> Absolute
forall path. Pathy path => path -> Relative -> path
Path.prefix Absolute
abs Relative
suf
    UnqualifiedPath Path'
path -> Path' -> BranchRelativePath
UnqualifiedPath (Path' -> BranchRelativePath) -> Path' -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Path' -> Relative -> Path'
forall path. Pathy path => path -> Relative -> path
Path.prefix Path'
path Relative
suf
  split :: BranchRelativePath -> Maybe (Split BranchRelativePath)
split = \case
    BranchPathInCurrentProject ProjectBranchName
branch Absolute
abs -> (Absolute -> BranchRelativePath)
-> (Absolute, NameSegment) -> Split BranchRelativePath
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ProjectBranchName -> Absolute -> BranchRelativePath
BranchPathInCurrentProject ProjectBranchName
branch) ((Absolute, NameSegment) -> Split BranchRelativePath)
-> Maybe (Absolute, NameSegment)
-> Maybe (Split BranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Absolute -> Maybe (Absolute, NameSegment)
forall path. Pathy path => path -> Maybe (Split path)
Path.split Absolute
abs
    QualifiedBranchPath ProjectName
proj ProjectBranchName
branch Absolute
abs -> (Absolute -> BranchRelativePath)
-> (Absolute, NameSegment) -> Split BranchRelativePath
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath ProjectName
proj ProjectBranchName
branch) ((Absolute, NameSegment) -> Split BranchRelativePath)
-> Maybe (Absolute, NameSegment)
-> Maybe (Split BranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Absolute -> Maybe (Absolute, NameSegment)
forall path. Pathy path => path -> Maybe (Split path)
Path.split Absolute
abs
    UnqualifiedPath Path'
path -> (Path' -> BranchRelativePath)
-> (Path', NameSegment) -> Split BranchRelativePath
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Path' -> BranchRelativePath
UnqualifiedPath ((Path', NameSegment) -> Split BranchRelativePath)
-> Maybe (Path', NameSegment) -> Maybe (Split BranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Path' -> Maybe (Path', NameSegment)
forall path. Pathy path => path -> Maybe (Split path)
Path.split Path'
path
  toText :: BranchRelativePath -> Text
toText = \case
    BranchPathInCurrentProject ProjectBranchName
pbName Absolute
path -> ()
-> ProjectBranchName
-> Absolute
-> ProjectPathG () ProjectBranchName
forall proj branch.
proj -> branch -> Absolute -> ProjectPathG proj branch
ProjectPath () ProjectBranchName
pbName Absolute
path ProjectPathG () ProjectBranchName
-> (ProjectPathG () ProjectBranchName -> Text) -> Text
forall a b. a -> (a -> b) -> b
& forall target source. From source target => source -> target
into @Text
    QualifiedBranchPath ProjectName
projName ProjectBranchName
pbName Absolute
path -> ProjectName
-> ProjectBranchName
-> Absolute
-> ProjectPathG ProjectName ProjectBranchName
forall proj branch.
proj -> branch -> Absolute -> ProjectPathG proj branch
ProjectPath ProjectName
projName ProjectBranchName
pbName Absolute
path ProjectPathG ProjectName ProjectBranchName
-> (ProjectPathG ProjectName ProjectBranchName -> Text) -> Text
forall a b. a -> (a -> b) -> b
& forall target source. From source target => source -> target
into @Text
    UnqualifiedPath Path'
path' -> Path' -> Text
forall path. Pathy path => path -> Text
Path.toText Path'
path'

-- | Strings without colons are parsed as loose code paths. A path with a colon may specify:
-- 1. A project and branch
-- 2. Only a branch, in which case the project is assumed to be the current project
-- 3. Only a path, in which case the path is rooted at the branch root
--
-- Specifying only a project is not allowed.
--
-- >>> parseBranchRelativePath "foo"
-- Right (UnqualifiedPath foo)
-- >>> parseBranchRelativePath "foo/bar:"
-- Right (QualifiedBranchPath (UnsafeProjectName "foo") (UnsafeProjectBranchName "bar") .)
-- >>> parseBranchRelativePath "foo/bar:.some.path"
-- Right (QualifiedBranchPath (UnsafeProjectName "foo") (UnsafeProjectBranchName "bar") .some.path)
-- >>> parseBranchRelativePath "/bar:.some.path"
-- Right (BranchPathInCurrentProject (UnsafeProjectBranchName "bar") .some.path)
-- >>> parseBranchRelativePath ":.some.path"
-- Right (UnqualifiedPath .some.path)
--
-- >>> parseBranchRelativePath ".branch"
-- Right (UnqualifiedPath .branch)
parseBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) BranchRelativePath
parseBranchRelativePath :: String -> Either (Pretty ColorText) BranchRelativePath
parseBranchRelativePath =
  (ParseErrorBundle Text Void -> Pretty ColorText)
-> Either (ParseErrorBundle Text Void) BranchRelativePath
-> Either (Pretty ColorText) BranchRelativePath
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string (String -> Pretty ColorText)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty) (Either (ParseErrorBundle Text Void) BranchRelativePath
 -> Either (Pretty ColorText) BranchRelativePath)
-> (String
    -> Either (ParseErrorBundle Text Void) BranchRelativePath)
-> String
-> Either (Pretty ColorText) BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text BranchRelativePath
-> String
-> Text
-> Either (ParseErrorBundle Text Void) BranchRelativePath
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parsec Void Text BranchRelativePath
branchRelativePathParser String
"<none>" (Text -> Either (ParseErrorBundle Text Void) BranchRelativePath)
-> (String -> Text)
-> String
-> Either (ParseErrorBundle Text Void) BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

-- |
-- >>> from @BranchRelativePath @Text (BranchPathInCurrentProject "foo" (Path.absoluteEmpty "bar"))
instance From BranchRelativePath Text where
  from :: BranchRelativePath -> Text
from = BranchRelativePath -> Text
forall path. Pathy path => path -> Text
Path.toText

data IncrementalBranchRelativePath
  = -- | no dots, slashes, or colons, so could be a project name or a single path segment
    ProjectOrPath' Text Path.Path'
  | -- | dots, no slashes or colons, must be a relative or absolute path
    OnlyPath' Path.Path'
  | -- | valid project, no slash
    IncompleteProject ProjectName
  | -- | valid project/branch, slash, no colon
    IncompleteBranch (Maybe ProjectName) (Maybe ProjectBranchName)
  | -- | valid project/branch, with colon
    IncompletePath (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) (Maybe Path.Absolute)
  | PathRelativeToCurrentBranch Path.Absolute
  deriving stock (Int -> IncrementalBranchRelativePath -> ShowS
[IncrementalBranchRelativePath] -> ShowS
IncrementalBranchRelativePath -> String
(Int -> IncrementalBranchRelativePath -> ShowS)
-> (IncrementalBranchRelativePath -> String)
-> ([IncrementalBranchRelativePath] -> ShowS)
-> Show IncrementalBranchRelativePath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> IncrementalBranchRelativePath -> ShowS
showsPrec :: Int -> IncrementalBranchRelativePath -> ShowS
$cshow :: IncrementalBranchRelativePath -> String
show :: IncrementalBranchRelativePath -> String
$cshowList :: [IncrementalBranchRelativePath] -> ShowS
showList :: [IncrementalBranchRelativePath] -> ShowS
Show)

-- |
-- >>> parseIncrementalBranchRelativePath "foo"
-- Right (ProjectOrRelative "foo" foo)
--
-- >>> parseIncrementalBranchRelativePath "foo/bar:"
-- Right (IncompletePath (Left (ProjectAndBranch {project = UnsafeProjectName "foo", branch = UnsafeProjectBranchName "bar"})) Nothing)
--
-- >>> parseIncrementalBranchRelativePath "foo/bar:some.path"
-- Right (IncompletePath (Left (ProjectAndBranch {project = UnsafeProjectName "foo", branch = UnsafeProjectBranchName "bar"})) (Just some.path))
--
-- >>> parseIncrementalBranchRelativePath "/bar:some.path"
-- Right (IncompletePath (Right (UnsafeProjectBranchName "bar")) (Just some.path))
--
-- >>> parseIncrementalBranchRelativePath ":some.path"
-- Right (PathRelativeToCurrentBranch some.path)
--
-- >>> parseIncrementalBranchRelativePath "/branch"
-- Right (IncompleteBranch Nothing (Just (UnsafeProjectBranchName "branch")))
--
-- >>> parseIncrementalBranchRelativePath "/"
-- Right (IncompleteBranch Nothing Nothing)
parseIncrementalBranchRelativePath :: String -> Either (P.Pretty CT.ColorText) IncrementalBranchRelativePath
parseIncrementalBranchRelativePath :: String -> Either (Pretty ColorText) IncrementalBranchRelativePath
parseIncrementalBranchRelativePath =
  (ParseErrorBundle Text Void -> Pretty ColorText)
-> Either
     (ParseErrorBundle Text Void) IncrementalBranchRelativePath
-> Either (Pretty ColorText) IncrementalBranchRelativePath
forall a b c. (a -> b) -> Either a c -> Either b c
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first (String -> Pretty ColorText
forall s. IsString s => String -> Pretty s
P.string (String -> Pretty ColorText)
-> (ParseErrorBundle Text Void -> String)
-> ParseErrorBundle Text Void
-> Pretty ColorText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle Text Void -> String
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> String
Megaparsec.errorBundlePretty)
    (Either (ParseErrorBundle Text Void) IncrementalBranchRelativePath
 -> Either (Pretty ColorText) IncrementalBranchRelativePath)
-> (String
    -> Either
         (ParseErrorBundle Text Void) IncrementalBranchRelativePath)
-> String
-> Either (Pretty ColorText) IncrementalBranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec Void Text IncrementalBranchRelativePath
-> String
-> Text
-> Either
     (ParseErrorBundle Text Void) IncrementalBranchRelativePath
forall e s a.
Parsec e s a -> String -> s -> Either (ParseErrorBundle s e) a
Megaparsec.parse Parsec Void Text IncrementalBranchRelativePath
incrementalBranchRelativePathParser String
"<none>"
    (Text
 -> Either
      (ParseErrorBundle Text Void) IncrementalBranchRelativePath)
-> (String -> Text)
-> String
-> Either
     (ParseErrorBundle Text Void) IncrementalBranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
Text.pack

incrementalBranchRelativePathParser :: Megaparsec.Parsec Void Text IncrementalBranchRelativePath
incrementalBranchRelativePathParser :: Parsec Void Text IncrementalBranchRelativePath
incrementalBranchRelativePathParser =
  [Parsec Void Text IncrementalBranchRelativePath]
-> Parsec Void Text IncrementalBranchRelativePath
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Maybe ProjectName -> Parsec Void Text IncrementalBranchRelativePath
startingAtSlash Maybe ProjectName
forall a. Maybe a
Nothing,
      Parsec Void Text IncrementalBranchRelativePath
pathRelativeToCurrentBranch,
      Parsec Void Text IncrementalBranchRelativePath
projectName
    ]
  where
    projectName :: Parsec Void Text IncrementalBranchRelativePath
projectName = do
      -- Attempt to parse a project name from the string prefix, or a
      -- Path' cosuming the entire string, switch based on if we
      -- unambiguously parse one or the other.
      Parsec Void Text (ProjectName, Bool)
-> Parsec Void Text Path'
-> Parsec Void Text (These (ProjectName, Bool) Path')
forall a b.
Parsec Void Text a
-> Parsec Void Text b -> Parsec Void Text (These a b)
parseThese Parsec Void Text (ProjectName, Bool)
Project.projectNameParser Parsec Void Text Path'
path' Parsec Void Text (These (ProjectName, Bool) Path')
-> (These (ProjectName, Bool) Path'
    -> Parsec Void Text IncrementalBranchRelativePath)
-> Parsec Void Text IncrementalBranchRelativePath
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
        -- project name parser consumed the slash
        This (ProjectName
projectName, Bool
True) -> Maybe ProjectName -> Parsec Void Text IncrementalBranchRelativePath
startingAtBranch (ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
Just ProjectName
projectName)
        -- project name parser did not consume a slash
        --
        -- Either we are at the end of input or the next character
        -- is not a slash, so we have invalid input
        This (ProjectName
projectName, Bool
False) ->
          let end :: Parsec Void Text IncrementalBranchRelativePath
end = do
                ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof
                pure (ProjectName -> IncrementalBranchRelativePath
IncompleteProject ProjectName
projectName)
           in Parsec Void Text IncrementalBranchRelativePath
end Parsec Void Text IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe ProjectName -> Parsec Void Text IncrementalBranchRelativePath
startingAtSlash (ProjectName -> Maybe ProjectName
forall a. a -> Maybe a
Just ProjectName
projectName)
        -- The string doesn't parse as a project name but does parse as a path
        That Path'
path -> IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path' -> IncrementalBranchRelativePath
OnlyPath' Path'
path)
        -- The string parses both as a project name and a path
        These (ProjectName
_, Bool
_) Path'
path -> Text -> Path' -> IncrementalBranchRelativePath
ProjectOrPath' (Text -> Path' -> IncrementalBranchRelativePath)
-> ParsecT Void Text Identity Text
-> ParsecT
     Void Text Identity (Path' -> IncrementalBranchRelativePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
Megaparsec.takeRest ParsecT Void Text Identity (Path' -> IncrementalBranchRelativePath)
-> Parsec Void Text Path'
-> Parsec Void Text IncrementalBranchRelativePath
forall a b.
ParsecT Void Text Identity (a -> b)
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Path' -> Parsec Void Text Path'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path'
path

    startingAtBranch :: Maybe ProjectName -> Megaparsec.Parsec Void Text IncrementalBranchRelativePath
    startingAtBranch :: Maybe ProjectName -> Parsec Void Text IncrementalBranchRelativePath
startingAtBranch Maybe ProjectName
mproj =
      Parsec Void Text (Maybe ProjectBranchName)
optionalBranch Parsec Void Text (Maybe ProjectBranchName)
-> (Maybe ProjectBranchName
    -> Parsec Void Text IncrementalBranchRelativePath)
-> Parsec Void Text IncrementalBranchRelativePath
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 ProjectBranchName
Nothing -> IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProjectName
-> Maybe ProjectBranchName -> IncrementalBranchRelativePath
IncompleteBranch Maybe ProjectName
mproj Maybe ProjectBranchName
forall a. Maybe a
Nothing)
        Just ProjectBranchName
branch ->
          Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> Parsec Void Text IncrementalBranchRelativePath
startingAtColon (Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> (ProjectName
    -> Either
         (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName)
-> Maybe ProjectName
-> Either
     (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (ProjectBranchName
-> Either
     (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
forall a b. b -> Either a b
Right ProjectBranchName
branch) (\ProjectName
proj -> ProjectAndBranch ProjectName ProjectBranchName
-> Either
     (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
forall a b. a -> Either a b
Left (ProjectName
-> ProjectBranchName
-> ProjectAndBranch ProjectName ProjectBranchName
forall a b. a -> b -> ProjectAndBranch a b
ProjectAndBranch ProjectName
proj ProjectBranchName
branch)) Maybe ProjectName
mproj)
            Parsec Void Text IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ProjectName
-> Maybe ProjectBranchName -> IncrementalBranchRelativePath
IncompleteBranch Maybe ProjectName
mproj (ProjectBranchName -> Maybe ProjectBranchName
forall a. a -> Maybe a
Just ProjectBranchName
branch))

    startingAtSlash ::
      Maybe ProjectName ->
      Megaparsec.Parsec Void Text IncrementalBranchRelativePath
    startingAtSlash :: Maybe ProjectName -> Parsec Void Text IncrementalBranchRelativePath
startingAtSlash Maybe ProjectName
mproj = 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 Char
-> Parsec Void Text IncrementalBranchRelativePath
-> Parsec Void Text IncrementalBranchRelativePath
forall a b.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity b -> ParsecT Void Text Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Maybe ProjectName -> Parsec Void Text IncrementalBranchRelativePath
startingAtBranch Maybe ProjectName
mproj

    startingAtColon ::
      (Either (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName) ->
      Megaparsec.Parsec Void Text IncrementalBranchRelativePath
    startingAtColon :: Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> Parsec Void Text IncrementalBranchRelativePath
startingAtColon Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
projStuff = 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
':'
      Maybe Absolute
p <- Parsec Void Text Absolute -> Parsec Void Text (Maybe Absolute)
forall a. Parsec Void Text a -> Parsec Void Text (Maybe a)
optionalEof Parsec Void Text Absolute
brPath
      pure (Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> Maybe Absolute -> IncrementalBranchRelativePath
IncompletePath Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
projStuff Maybe Absolute
p)

    pathRelativeToCurrentBranch :: Megaparsec.Parsec Void Text IncrementalBranchRelativePath
    pathRelativeToCurrentBranch :: Parsec Void Text IncrementalBranchRelativePath
pathRelativeToCurrentBranch = 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
':'
      Absolute
p <- Parsec Void Text Absolute
brPath
      pure (Absolute -> IncrementalBranchRelativePath
PathRelativeToCurrentBranch Absolute
p)

    optionalEof :: Megaparsec.Parsec Void Text a -> Megaparsec.Parsec Void Text (Maybe a)
    optionalEof :: forall a. Parsec Void Text a -> Parsec Void Text (Maybe a)
optionalEof Parsec Void Text a
pa = a -> Maybe a
forall a. a -> Maybe a
Just (a -> Maybe a)
-> Parsec Void Text a -> ParsecT Void Text Identity (Maybe a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec Void Text a
pa ParsecT Void Text Identity (Maybe a)
-> ParsecT Void Text Identity (Maybe a)
-> ParsecT Void Text Identity (Maybe a)
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Maybe a
forall a. Maybe a
Nothing Maybe a
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Maybe a)
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 ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
Megaparsec.eof)

    optionalBranch :: Megaparsec.Parsec Void Text (Maybe ProjectBranchName)
    optionalBranch :: Parsec Void Text (Maybe ProjectBranchName)
optionalBranch = Parsec Void Text ProjectBranchName
-> Parsec Void Text (Maybe ProjectBranchName)
forall a. Parsec Void Text a -> Parsec Void Text (Maybe a)
optionalEof Parsec Void Text ProjectBranchName
branchNameParser

    branchNameParser :: Parsec Void Text ProjectBranchName
branchNameParser = Bool -> Parsec Void Text ProjectBranchName
Project.projectBranchNameParser Bool
False

    brPath :: Megaparsec.Parsec Void Text Path.Absolute
    brPath :: Parsec Void Text Absolute
brPath = do
      Int
offset <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
Megaparsec.getOffset
      Parsec Void Text Path'
path' Parsec Void Text Path'
-> (Path' -> Parsec Void Text Absolute)
-> Parsec Void Text Absolute
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
        Path.AbsolutePath' Absolute
_ -> Int -> Text -> Parsec Void Text Absolute
forall a. Int -> Text -> Parsec Void Text a
failureAt Int
offset Text
"Branch qualified paths don't require a leading '.'"
        -- Branch relative paths are written as relative paths, but are always absolute to the branch root
        Path.RelativePath' (Path.Relative Path
x) -> Absolute -> Parsec Void Text Absolute
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Absolute -> Parsec Void Text Absolute)
-> Absolute -> Parsec Void Text Absolute
forall a b. (a -> b) -> a -> b
$ Path -> Absolute
Path.Absolute Path
x
    path' :: Parsec Void Text Path'
path' = Parsec Void Text Path' -> Parsec Void Text Path'
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
      Int
offset <- ParsecT Void Text Identity Int
forall e s (m :: * -> *). MonadParsec e s m => m Int
Megaparsec.getOffset
      (Text -> Parsec Void Text Path')
-> (Path' -> Parsec Void Text Path')
-> Either Text Path'
-> Parsec Void Text Path'
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Int -> Text -> Parsec Void Text Path'
forall a. Int -> Text -> Parsec Void Text a
failureAt Int
offset) Path' -> Parsec Void Text Path'
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text Path' -> Parsec Void Text Path')
-> (Text -> Either Text Path') -> Text -> Parsec Void Text Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Either Text Path'
Path.parsePath' (String -> Either Text Path')
-> (Text -> String) -> Text -> Either Text Path'
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack (Text -> Parsec Void Text Path')
-> ParsecT Void Text Identity Text -> Parsec Void Text Path'
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ParsecT Void Text Identity Text
ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *). MonadParsec e s m => m (Tokens s)
Megaparsec.takeRest

    failureAt :: forall a. Int -> Text -> Megaparsec.Parsec Void Text a
    failureAt :: forall a. Int -> Text -> Parsec Void Text a
failureAt Int
offset Text
str = ParseError Text Void -> ParsecT Void Text Identity a
forall a. ParseError Text Void -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
Megaparsec.parseError (Int -> Set (ErrorFancy Void) -> ParseError Text Void
forall s e. Int -> Set (ErrorFancy e) -> ParseError s e
Megaparsec.FancyError Int
offset (ErrorFancy Void -> Set (ErrorFancy Void)
forall a. a -> Set a
Set.singleton (String -> ErrorFancy Void
forall e. String -> ErrorFancy e
Megaparsec.ErrorFail (Text -> String
Text.unpack Text
str))))

    parseThese ::
      forall a b.
      Megaparsec.Parsec Void Text a ->
      Megaparsec.Parsec Void Text b ->
      Megaparsec.Parsec Void Text (These a b)
    parseThese :: forall a b.
Parsec Void Text a
-> Parsec Void Text b -> Parsec Void Text (These a b)
parseThese Parsec Void Text a
pa Parsec Void Text b
pb = do
      Either (ParseError Text Void) (Int, a)
ea <- Parsec Void Text a
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, a))
forall {c}.
ParsecT Void Text Identity c
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, c))
observeParse Parsec Void Text a
pa
      Either (ParseError Text Void) (Int, b)
eb <- Parsec Void Text b
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, b))
forall {c}.
ParsecT Void Text Identity c
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, c))
observeParse Parsec Void Text b
pb
      case (Either (ParseError Text Void) (Int, a)
ea, Either (ParseError Text Void) (Int, b)
eb) of
        (Left ParseError Text Void
aerr, Left ParseError Text Void
berr) -> ParseError Text Void -> Parsec Void Text (These a b)
forall a. ParseError Text Void -> ParsecT Void Text Identity a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
ParseError s e -> m a
Megaparsec.parseError (ParseError Text Void -> Parsec Void Text (These a b))
-> ParseError Text Void -> Parsec Void Text (These a b)
forall a b. (a -> b) -> a -> b
$ ParseError Text Void
aerr ParseError Text Void
-> ParseError Text Void -> ParseError Text Void
forall a. Semigroup a => a -> a -> a
<> ParseError Text Void
berr
        (Left ParseError Text Void
_, Right (Int
blen, b
b)) -> do
          Maybe String -> Int -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
Megaparsec.takeP Maybe String
forall a. Maybe a
Nothing Int
blen
          pure $ b -> These a b
forall a b. b -> These a b
That b
b
        (Right (Int
alen, a
a), Left ParseError Text Void
_) -> do
          Maybe String -> Int -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> Int -> m (Tokens s)
Megaparsec.takeP Maybe String
forall a. Maybe a
Nothing Int
alen
          pure $ a -> These a b
forall a b. a -> These a b
This a
a
        (Right (Int
_, a
a), Right (Int
_, b
b)) -> These a b -> Parsec Void Text (These a b)
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (These a b -> Parsec Void Text (These a b))
-> These a b -> Parsec Void Text (These a b)
forall a b. (a -> b) -> a -> b
$ a -> b -> These a b
forall a b. a -> b -> These a b
These a
a b
b
    observeParse :: ParsecT Void Text Identity c
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, c))
observeParse = ParsecT Void Text Identity (Int, c)
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, c))
forall a.
ParsecT Void Text Identity a
-> ParsecT Void Text Identity (Either (ParseError Text Void) a)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Either (ParseError s e) a)
Megaparsec.observing (ParsecT Void Text Identity (Int, c)
 -> ParsecT
      Void Text Identity (Either (ParseError Text Void) (Int, c)))
-> (ParsecT Void Text Identity c
    -> ParsecT Void Text Identity (Int, c))
-> ParsecT Void Text Identity c
-> ParsecT
     Void Text Identity (Either (ParseError Text Void) (Int, c))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity (Int, c)
-> ParsecT Void Text Identity (Int, c)
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 (Int, c)
 -> ParsecT Void Text Identity (Int, c))
-> (ParsecT Void Text Identity c
    -> ParsecT Void Text Identity (Int, c))
-> ParsecT Void Text Identity c
-> ParsecT Void Text Identity (Int, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity (Int, c)
-> ParsecT Void Text Identity (Int, c)
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 (ParsecT Void Text Identity (Int, c)
 -> ParsecT Void Text Identity (Int, c))
-> (ParsecT Void Text Identity c
    -> ParsecT Void Text Identity (Int, c))
-> ParsecT Void Text Identity c
-> ParsecT Void Text Identity (Int, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, c) -> (Int, c))
-> ParsecT Void Text Identity (Text, c)
-> ParsecT Void Text Identity (Int, c)
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 ((Text -> Int) -> (Text, c) -> (Int, c)
forall a b c. (a -> b) -> (a, c) -> (b, c)
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> Int
Text.length) (ParsecT Void Text Identity (Text, c)
 -> ParsecT Void Text Identity (Int, c))
-> (ParsecT Void Text Identity c
    -> ParsecT Void Text Identity (Text, c))
-> ParsecT Void Text Identity c
-> ParsecT Void Text Identity (Int, c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity c
-> ParsecT Void Text Identity (Text, c)
ParsecT Void Text Identity c
-> ParsecT Void Text Identity (Tokens Text, c)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> m (Tokens s, a)
Megaparsec.match

branchRelativePathParser :: Megaparsec.Parsec Void Text BranchRelativePath
branchRelativePathParser :: Parsec Void Text BranchRelativePath
branchRelativePathParser =
  Parsec Void Text IncrementalBranchRelativePath
incrementalBranchRelativePathParser Parsec Void Text IncrementalBranchRelativePath
-> (IncrementalBranchRelativePath
    -> Parsec Void Text BranchRelativePath)
-> Parsec Void Text BranchRelativePath
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
    ProjectOrPath' Text
_txt Path'
path -> BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> Parsec Void Text BranchRelativePath)
-> BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Path' -> BranchRelativePath
UnqualifiedPath Path'
path
    OnlyPath' Path'
path -> BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> Parsec Void Text BranchRelativePath)
-> BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Path' -> BranchRelativePath
UnqualifiedPath Path'
path
    IncompleteProject ProjectName
_proj -> String -> Parsec Void Text BranchRelativePath
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Branch relative paths require a branch. Expected `/` here."
    IncompleteBranch Maybe ProjectName
_mproj Maybe ProjectBranchName
_mbranch -> String -> Parsec Void Text BranchRelativePath
forall a. String -> ParsecT Void Text Identity a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Branch relative paths require a colon. Expected `:` here."
    PathRelativeToCurrentBranch Absolute
p -> BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> Parsec Void Text BranchRelativePath)
-> (Path' -> BranchRelativePath)
-> Path'
-> Parsec Void Text BranchRelativePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Path' -> BranchRelativePath
UnqualifiedPath (Path' -> Parsec Void Text BranchRelativePath)
-> Path' -> Parsec Void Text BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> Path'
Path.AbsolutePath' Absolute
p
    IncompletePath Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
projStuff Maybe Absolute
mpath ->
      BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a. a -> ParsecT Void Text Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (BranchRelativePath -> Parsec Void Text BranchRelativePath)
-> BranchRelativePath -> Parsec Void Text BranchRelativePath
forall a b. (a -> b) -> a -> b
$
        (ProjectAndBranch ProjectName ProjectBranchName
 -> BranchRelativePath)
-> (ProjectBranchName -> BranchRelativePath)
-> Either
     (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
-> BranchRelativePath
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either
          ( \(ProjectAndBranch ProjectName
projName ProjectBranchName
branchName) ->
              ProjectName -> ProjectBranchName -> Absolute -> BranchRelativePath
QualifiedBranchPath ProjectName
projName ProjectBranchName
branchName (Absolute -> BranchRelativePath) -> Absolute -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> Maybe Absolute -> Absolute
forall a. a -> Maybe a -> a
fromMaybe Absolute
Path.Root Maybe Absolute
mpath
          )
          ((ProjectBranchName -> Absolute -> BranchRelativePath)
-> Absolute -> ProjectBranchName -> BranchRelativePath
forall a b c. (a -> b -> c) -> b -> a -> c
flip ProjectBranchName -> Absolute -> BranchRelativePath
BranchPathInCurrentProject (Absolute -> ProjectBranchName -> BranchRelativePath)
-> Absolute -> ProjectBranchName -> BranchRelativePath
forall a b. (a -> b) -> a -> b
$ Absolute -> Maybe Absolute -> Absolute
forall a. a -> Maybe a -> a
fromMaybe Absolute
Path.Root Maybe Absolute
mpath)
          Either
  (ProjectAndBranch ProjectName ProjectBranchName) ProjectBranchName
projStuff