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

    -- * 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.ShortHash (ShortHash)
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'
relativeEmpty'
  [Char]
"." -> Path' -> Either Text Path'
forall a b. b -> Either a b
Right Path'
absoluteEmpty'
  [Char]
path -> Split' -> Path'
unsplit' (Split' -> Path') -> Either Text Split' -> Either Text Path'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either Text Split'
parseSplit' [Char]
path

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

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

parseShortHashOrHQSplit' :: String -> Either Text (Either ShortHash HQSplit')
parseShortHashOrHQSplit' :: [Char] -> Either Text (Either ShortHash HQSplit')
parseShortHashOrHQSplit' =
  Parsec (Token Text) [Char] (Either ShortHash HQSplit')
-> [Char] -> Either Text (Either ShortHash HQSplit')
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] (Either ShortHash HQSplit')
shortHashOrHqSplitP'

parseHQSplit :: String -> Either Text HQSplit
parseHQSplit :: [Char] -> Either Text HQSplit
parseHQSplit [Char]
s =
  [Char] -> Either Text HQSplit'
parseHQSplit' [Char]
s Either Text HQSplit'
-> (HQSplit' -> Either Text HQSplit) -> Either Text HQSplit
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
>>= \case
    (RelativePath' (Relative Path
p), HQSegment
hqseg) -> HQSplit -> Either Text HQSplit
forall a b. b -> Either a b
Right (Path
p, HQSegment
hqseg)
    HQSplit'
_ -> Text -> Either Text HQSplit
forall a b. a -> Either a b
Left (Text -> Either Text HQSplit) -> Text -> Either Text HQSplit
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 HQSplit'
parseHQSplit' :: [Char] -> Either Text HQSplit'
parseHQSplit' =
  Parsec (Token Text) [Char] HQSplit'
-> [Char] -> Either Text HQSplit'
forall a. Parsec (Token Text) [Char] a -> [Char] -> Either Text a
runParser Parsec (Token Text) [Char] HQSplit'
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
unsplit (Split -> Path)
-> Parsec (Token Text) [Char] Split
-> Parsec (Token Text) [Char] Path
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Token Text) [Char] Split
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
empty

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'
unsplit' (Split' -> Path')
-> Parsec (Token Text) [Char] Split'
-> Parsec (Token Text) [Char] Path'
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Token Text) [Char] Split'
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'
absoluteEmpty',
      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'
relativeEmpty'
    ]

splitP :: Parsec (Lexer.Token Text) [Char] Split
splitP :: Parsec (Token Text) [Char] Split
splitP =
  Name -> Split
splitFromName (Name -> Split)
-> ParsecT (Token Text) [Char] Identity Name
-> Parsec (Token Text) [Char] Split
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'
splitP' :: Parsec (Token Text) [Char] Split'
splitP' =
  Name -> Split'
splitFromName' (Name -> Split')
-> ParsecT (Token Text) [Char] Identity Name
-> Parsec (Token Text) [Char] Split'
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] (Either ShortHash HQSplit')
shortHashOrHqSplitP' :: Parsec (Token Text) [Char] (Either ShortHash HQSplit')
shortHashOrHqSplitP' =
  ShortHash -> Either ShortHash HQSplit'
forall a b. a -> Either a b
Left (ShortHash -> Either ShortHash HQSplit')
-> ParsecT (Token Text) [Char] Identity ShortHash
-> Parsec (Token Text) [Char] (Either ShortHash HQSplit')
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] (Either ShortHash HQSplit')
-> Parsec (Token Text) [Char] (Either ShortHash HQSplit')
-> Parsec (Token Text) [Char] (Either ShortHash HQSplit')
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
<|> HQSplit' -> Either ShortHash HQSplit'
forall a b. b -> Either a b
Right (HQSplit' -> Either ShortHash HQSplit')
-> Parsec (Token Text) [Char] HQSplit'
-> Parsec (Token Text) [Char] (Either ShortHash HQSplit')
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parsec (Token Text) [Char] HQSplit'
hqSplitP'

hqSplitP' :: Parsec (Lexer.Token Text) [Char] HQSplit'
hqSplitP' :: Parsec (Token Text) [Char] HQSplit'
hqSplitP' = do
  (Path'
segs, NameSegment
seg) <- Parsec (Token Text) [Char] Split'
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 -> HQSplit')
-> Parsec (Token Text) [Char] HQSplit'
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
    Maybe ShortHash
Nothing -> (Path'
segs, NameSegment -> HQSegment
forall n. n -> HashQualified n
HQ'.fromName NameSegment
seg)
    Just ShortHash
hash -> (Path'
segs, NameSegment -> ShortHash -> HQSegment
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified NameSegment
seg ShortHash
hash)