module Unison.Codebase.Path.Parse
  ( -- * Path parsing functions
    parsePath,
    parsePath',
    parseSplit,
    parseSplit',
    parseHQSplit,
    parseHQSplit',
    parseHashOrHQSplit',

    -- * Path parsers
    pathP,
    pathP',
    splitP,
    splitP',
  )
where

import Data.Text qualified as Text
import Text.Megaparsec (Parsec)
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P (char)
import Text.Megaparsec.Internal qualified as P (withParsecT)
import Unison.Codebase.Path
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Prelude hiding (empty, toList)
import Unison.Syntax.Lexer qualified as Lexer
import Unison.Syntax.Name qualified as Name
import Unison.Syntax.NameSegment qualified as NameSegment (renderParseErr)
import Unison.Syntax.ShortHash qualified as ShortHash

------------------------------------------------------------------------------------------------------------------------
-- Path parsing functions

parsePath :: String -> Either Text Path
parsePath :: [Char] -> Either Text Path
parsePath = Parsec (Token Text) [Char] Path -> [Char] -> Either Text Path
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] Path
pathP

parsePath' :: String -> Either Text Path'
parsePath' :: [Char] -> Either Text Path'
parsePath' = \case
  [Char]
"" -> Path' -> Either Text Path'
forall a b. b -> Either a b
Right Path'
Current'
  [Char]
"." -> Path' -> Either Text Path'
forall a b. b -> Either a b
Right Path'
Root'
  [Char]
path -> Split Path' -> Path'
forall path. Pathy path => Split path -> path
unsplit (Split Path' -> Path')
-> Either Text (Split Path') -> Either Text Path'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either Text (Split Path')
parseSplit' [Char]
path

parseSplit :: String -> Either Text (Split Path)
parseSplit :: [Char] -> Either Text (Split Path)
parseSplit = Parsec (Token Text) [Char] (Split Path)
-> [Char] -> Either Text (Split Path)
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] (Split Path)
splitP

parseSplit' :: String -> Either Text (Split Path')
parseSplit' :: [Char] -> Either Text (Split Path')
parseSplit' = Parsec (Token Text) [Char] (Split Path')
-> [Char] -> Either Text (Split Path')
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] (Split Path')
splitP'

parseHashOrHQSplit' :: String -> Either Text (HQ'.HashOrHQ (Split Path'))
parseHashOrHQSplit' :: [Char] -> Either Text (HashOrHQ (Split Path'))
parseHashOrHQSplit' = Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
-> [Char] -> Either Text (HashOrHQ (Split Path'))
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
shortHashOrHQSplitP'

parseHQSplit :: String -> Either Text (HQ'.HashQualified (Split Path))
parseHQSplit :: [Char] -> Either Text (HashQualified (Split Path))
parseHQSplit [Char]
s =
  [Char] -> Either Text (HashQualified (Split Path'))
parseHQSplit' [Char]
s Either Text (HashQualified (Split Path'))
-> (HashQualified (Split Path')
    -> Either Text (HashQualified (Split Path)))
-> Either Text (HashQualified (Split Path))
forall a b. Either Text a -> (a -> Either Text b) -> Either Text b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Split Path' -> Either Text (Split Path))
-> HashQualified (Split Path')
-> Either Text (HashQualified (Split Path))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> HashQualified a -> f (HashQualified b)
traverse \(Path'
path, NameSegment
seg) -> case Path'
path of
    RelativePath' (Relative Path
p) -> Split Path -> Either Text (Split Path)
forall a. a -> Either Text a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Path
p, NameSegment
seg)
    AbsolutePath' (Absolute Path
_) -> Text -> Either Text (Split Path)
forall a b. a -> Either a b
Left (Text -> Either Text (Split Path))
-> Text -> Either Text (Split Path)
forall a b. (a -> b) -> a -> b
$ Text
"Sorry, you can't use an absolute name like " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
Text.pack [Char]
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" here."

parseHQSplit' :: String -> Either Text (HQ'.HashQualified (Split Path'))
parseHQSplit' :: [Char] -> Either Text (HashQualified (Split Path'))
parseHQSplit' = Parsec (Token Text) [Char] (HashQualified (Split Path'))
-> [Char] -> Either Text (HashQualified (Split Path'))
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] (HashQualified (Split Path'))
hqSplitP'

runParser :: Parsec (Lexer.Token Text) [Char] a -> String -> Either Text a
runParser :: forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] a
p =
  (ParseErrorBundle [Char] (Token Text) -> Text)
-> Either (ParseErrorBundle [Char] (Token Text)) a -> Either Text a
forall a c b. (a -> c) -> Either a b -> Either c b
mapLeft ([Char] -> Text
Text.pack ([Char] -> Text)
-> (ParseErrorBundle [Char] (Token Text) -> [Char])
-> ParseErrorBundle [Char] (Token Text)
-> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseErrorBundle [Char] (Token Text) -> [Char]
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
P.errorBundlePretty) (Either (ParseErrorBundle [Char] (Token Text)) a -> Either Text a)
-> ([Char] -> Either (ParseErrorBundle [Char] (Token Text)) a)
-> [Char]
-> Either Text a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parsec (Token Text) [Char] a
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] (Token Text)) a
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
P.runParser (Parsec (Token Text) [Char] a
p Parsec (Token Text) [Char] a
-> ParsecT (Token Text) [Char] Identity ()
-> Parsec (Token Text) [Char] a
forall a b.
ParsecT (Token Text) [Char] Identity a
-> ParsecT (Token Text) [Char] Identity b
-> ParsecT (Token Text) [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Token Text) [Char] Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof) [Char]
""

------------------------------------------------------------------------------------------------------------------------
-- Path parsers

pathP :: Parsec (Lexer.Token Text) [Char] Path
pathP :: Parsec (Token Text) [Char] Path
pathP = (Split Path -> Path
forall path. Pathy path => Split path -> path
unsplit (Split Path -> Path)
-> Parsec (Token Text) [Char] (Split Path)
-> Parsec (Token Text) [Char] Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Token Text) [Char] (Split Path)
splitP) Parsec (Token Text) [Char] Path
-> Parsec (Token Text) [Char] Path
-> Parsec (Token Text) [Char] Path
forall a.
ParsecT (Token Text) [Char] Identity a
-> ParsecT (Token Text) [Char] Identity a
-> ParsecT (Token Text) [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Path -> Parsec (Token Text) [Char] Path
forall a. a -> ParsecT (Token Text) [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path
forall a. Monoid a => a
mempty

pathP' :: Parsec (Lexer.Token Text) [Char] Path'
pathP' :: Parsec (Token Text) [Char] Path'
pathP' =
  [Parsec (Token Text) [Char] Path']
-> Parsec (Token Text) [Char] Path'
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ Split Path' -> Path'
forall path. Pathy path => Split path -> path
unsplit (Split Path' -> Path')
-> Parsec (Token Text) [Char] (Split Path')
-> Parsec (Token Text) [Char] Path'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Token Text) [Char] (Split Path')
splitP',
      Token [Char] -> ParsecT (Token Text) [Char] Identity (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token [Char]
'.' ParsecT (Token Text) [Char] Identity Char
-> Path' -> Parsec (Token Text) [Char] Path'
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Path'
Root',
      Path' -> Parsec (Token Text) [Char] Path'
forall a. a -> ParsecT (Token Text) [Char] Identity a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Path'
Current'
    ]

splitP :: Parsec (Lexer.Token Text) [Char] (Split Path)
splitP :: Parsec (Token Text) [Char] (Split Path)
splitP = Name -> Split Path
splitFromName (Name -> Split Path)
-> ParsecT (Token Text) [Char] Identity Name
-> Parsec (Token Text) [Char] (Split Path)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token ParseErr -> Token Text)
-> ParsecT (Token ParseErr) [Char] Identity Name
-> ParsecT (Token Text) [Char] Identity Name
forall e e' s (m :: * -> *) a.
Ord e' =>
(e -> e') -> ParsecT e s m a -> ParsecT e' s m a
P.withParsecT ((ParseErr -> Text) -> Token ParseErr -> Token Text
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErr -> Text
NameSegment.renderParseErr) ParsecT (Token ParseErr) [Char] Identity Name
forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m Name
Name.relativeNameP

splitP' :: Parsec (Lexer.Token Text) [Char] (Split Path')
splitP' :: Parsec (Token Text) [Char] (Split Path')
splitP' = Name -> Split Path'
parentOfName (Name -> Split Path')
-> ParsecT (Token Text) [Char] Identity Name
-> Parsec (Token Text) [Char] (Split Path')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Token ParseErr -> Token Text)
-> ParsecT (Token ParseErr) [Char] Identity Name
-> ParsecT (Token Text) [Char] Identity Name
forall e e' s (m :: * -> *) a.
Ord e' =>
(e -> e') -> ParsecT e s m a -> ParsecT e' s m a
P.withParsecT ((ParseErr -> Text) -> Token ParseErr -> Token Text
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ParseErr -> Text
NameSegment.renderParseErr) ParsecT (Token ParseErr) [Char] Identity Name
forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m Name
Name.nameP

shortHashOrHQSplitP' :: Parsec (Lexer.Token Text) [Char] (HQ'.HashOrHQ (Split Path'))
shortHashOrHQSplitP' :: Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
shortHashOrHQSplitP' = ShortHash -> HashOrHQ (Split Path')
forall a b. a -> Either a b
Left (ShortHash -> HashOrHQ (Split Path'))
-> ParsecT (Token Text) [Char] Identity ShortHash
-> Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Token Text) [Char] Identity ShortHash
forall (m :: * -> *). ParsecT (Token Text) [Char] m ShortHash
ShortHash.shortHashP Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
-> Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
-> Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
forall a.
ParsecT (Token Text) [Char] Identity a
-> ParsecT (Token Text) [Char] Identity a
-> ParsecT (Token Text) [Char] Identity a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> HashQualified (Split Path') -> HashOrHQ (Split Path')
forall a b. b -> Either a b
Right (HashQualified (Split Path') -> HashOrHQ (Split Path'))
-> Parsec (Token Text) [Char] (HashQualified (Split Path'))
-> Parsec (Token Text) [Char] (HashOrHQ (Split Path'))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Token Text) [Char] (HashQualified (Split Path'))
hqSplitP'

hqSplitP' :: Parsec (Lexer.Token Text) [Char] (HQ'.HashQualified (Split Path'))
hqSplitP' :: Parsec (Token Text) [Char] (HashQualified (Split Path'))
hqSplitP' = do
  Split Path'
split <- Parsec (Token Text) [Char] (Split Path')
splitP'
  ParsecT (Token Text) [Char] Identity ShortHash
-> ParsecT (Token Text) [Char] Identity (Maybe ShortHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional ((Token Text -> Token Text)
-> ParsecT (Token Text) [Char] Identity ShortHash
-> ParsecT (Token Text) [Char] Identity ShortHash
forall e e' s (m :: * -> *) a.
Ord e' =>
(e -> e') -> ParsecT e s m a -> ParsecT e' s m a
P.withParsecT ((Text -> Text) -> Token Text -> Token Text
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Text
"invalid hash: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<>)) ParsecT (Token Text) [Char] Identity ShortHash
forall (m :: * -> *). ParsecT (Token Text) [Char] m ShortHash
ShortHash.shortHashP) ParsecT (Token Text) [Char] Identity (Maybe ShortHash)
-> (Maybe ShortHash -> HashQualified (Split Path'))
-> Parsec (Token Text) [Char] (HashQualified (Split Path'))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe ShortHash
Nothing -> Split Path' -> HashQualified (Split Path')
forall n. n -> HashQualified n
HQ'.fromName Split Path'
split
    Just ShortHash
hash -> Split Path' -> ShortHash -> HashQualified (Split Path')
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified Split Path'
split ShortHash
hash