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

-- | Utilities related to the parsing and printing of names using the default syntax.
module Unison.Syntax.Name
  ( -- * String conversions
    parseText,
    parseTextEither,
    unsafeParseText,
    toText,
    unsafeParseVar,
    parseVar,
    toVar,

    -- * Name parsers
    nameP,
    relativeNameP,

    -- * Name classifiers
    isSymboly,
  )
where

import Control.Monad.Combinators.NonEmpty qualified as Monad
import Data.List.NonEmpty (pattern (:|))
import Data.Text qualified as Text
import Data.Text.Lazy qualified as Text.Lazy
import Data.Text.Lazy.Builder qualified as Text (Builder)
import Data.Text.Lazy.Builder qualified as Text.Builder
import Text.Megaparsec (ParsecT)
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P
import Text.Megaparsec.Internal qualified as P (withParsecT)
import Unison.Name qualified as Name (fromSegments, lastSegment, makeAbsolute)
import Unison.Name.Internal (Name (Name))
import Unison.NameSegment (NameSegment)
import Unison.Position (Position (..))
import Unison.Prelude
import Unison.Syntax.Lexer.Token (Token)
import Unison.Syntax.NameSegment (segmentStartChar)
import Unison.Syntax.NameSegment qualified as NameSegment
  ( ParseErr,
    isSymboly,
    renderParseErr,
    segmentP,
    toEscapedTextBuilder,
  )
import Unison.Var (Var)
import Unison.Var qualified as Var

------------------------------------------------------------------------------------------------------------------------
-- String conversions

-- | Parse a name from a string literal.
parseText :: Text -> Maybe Name
parseText :: Text -> Maybe Name
parseText =
  Either Text Name -> Maybe Name
forall a b. Either a b -> Maybe b
eitherToMaybe (Either Text Name -> Maybe Name)
-> (Text -> Either Text Name) -> Text -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Name
parseTextEither

-- | Parse a name from a string literal.
parseTextEither :: Text -> Either Text Name
parseTextEither :: Text -> Either Text Name
parseTextEither Text
s =
  Parsec (Token Text) [Char] Name
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] (Token Text)) Name
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
P.runParser ((Token ParseErr -> Token Text)
-> ParsecT (Token ParseErr) [Char] Identity Name
-> Parsec (Token Text) [Char] 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
nameP Parsec (Token Text) [Char] Name
-> ParsecT (Token Text) [Char] Identity ()
-> Parsec (Token Text) [Char] Name
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]
"" (Text -> [Char]
Text.unpack Text
s)
    Either (ParseErrorBundle [Char] (Token Text)) Name
-> (Either (ParseErrorBundle [Char] (Token Text)) Name
    -> Either Text Name)
-> Either Text Name
forall a b. a -> (a -> b) -> b
& (ParseErrorBundle [Char] (Token Text) -> Text)
-> Either (ParseErrorBundle [Char] (Token Text)) Name
-> Either Text Name
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)

-- | Unsafely parse a name from a string literal.
unsafeParseText :: (HasCallStack) => Text -> Name
unsafeParseText :: HasCallStack => Text -> Name
unsafeParseText =
  (Text -> Name) -> (Name -> Name) -> Either Text Name -> Name
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Name
forall a. HasCallStack => [Char] -> a
error ([Char] -> Name) -> (Text -> [Char]) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack) Name -> Name
forall a. a -> a
id (Either Text Name -> Name)
-> (Text -> Either Text Name) -> Text -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text Name
parseTextEither

-- | Convert a name to a string representation.
toText :: Name -> Text
toText :: Name -> Text
toText (Name Position
pos (NameSegment
x0 :| [NameSegment]
xs)) =
  Builder -> Text
build (Position -> Builder
buildPos Position
pos Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> (NameSegment -> Builder -> Builder)
-> Builder -> [NameSegment] -> Builder
forall a b. (a -> b -> b) -> b -> [a] -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr NameSegment -> Builder -> Builder
step Builder
forall a. Monoid a => a
mempty [NameSegment]
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Builder
NameSegment.toEscapedTextBuilder NameSegment
x0)
  where
    step :: NameSegment -> Text.Builder -> Text.Builder
    step :: NameSegment -> Builder -> Builder
step NameSegment
x Builder
acc =
      Builder
acc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> NameSegment -> Builder
NameSegment.toEscapedTextBuilder NameSegment
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
"."

    build :: Text.Builder -> Text
    build :: Builder -> Text
build =
      Text -> Text
Text.Lazy.toStrict (Text -> Text) -> (Builder -> Text) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
Text.Builder.toLazyText

    buildPos :: Position -> Text.Builder
    buildPos :: Position -> Builder
buildPos = \case
      Position
Absolute -> Builder
"."
      Position
Relative -> Builder
""

-- | Parse a name from a var, by first rendering the var as a string.
parseVar :: (Var v) => v -> Maybe Name
parseVar :: forall v. Var v => v -> Maybe Name
parseVar =
  Text -> Maybe Name
parseText (Text -> Maybe Name) -> (v -> Text) -> v -> Maybe Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name

-- | Unsafely parse a name from a var, by first rendering the var as a string.
--
-- See 'unsafeFromText'.
unsafeParseVar :: (Var v) => v -> Name
unsafeParseVar :: forall v. Var v => v -> Name
unsafeParseVar =
  HasCallStack => Text -> Name
Text -> Name
unsafeParseText (Text -> Name) -> (v -> Text) -> v -> Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name

-- | Convert a name to a string representation, then parse that as a var.
toVar :: (Var v) => Name -> v
toVar :: forall v. Var v => Name -> v
toVar =
  Text -> v
forall v. Var v => Text -> v
Var.named (Text -> v) -> (Name -> Text) -> Name -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> Text
toText

------------------------------------------------------------------------------------------------------------------------
-- Name parsers

-- | A name parser.
nameP :: (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name
nameP :: forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m Name
nameP =
  ParsecT (Token ParseErr) [Char] m Name
-> ParsecT (Token ParseErr) [Char] m Name
forall a.
ParsecT (Token ParseErr) [Char] m a
-> ParsecT (Token ParseErr) [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
    Bool
leadingDot <- Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust (Maybe Char -> Bool)
-> ParsecT (Token ParseErr) [Char] m (Maybe Char)
-> ParsecT (Token ParseErr) [Char] m Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Token ParseErr) [Char] m Char
-> ParsecT (Token ParseErr) [Char] m (Maybe Char)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
P.optional (Token [Char] -> ParsecT (Token ParseErr) [Char] m (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token [Char]
'.')
    Name
name <- ParsecT (Token ParseErr) [Char] m Name
forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m Name
relativeNameP
    pure (if Bool
leadingDot then Name -> Name
Name.makeAbsolute Name
name else Name
name)

-- | A relative name parser.
relativeNameP :: forall m. (Monad m) => ParsecT (Token NameSegment.ParseErr) [Char] m Name
relativeNameP :: forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m Name
relativeNameP = do
  NonEmpty NameSegment -> Name
Name.fromSegments (NonEmpty NameSegment -> Name)
-> ParsecT (Token ParseErr) [Char] m (NonEmpty NameSegment)
-> ParsecT (Token ParseErr) [Char] m Name
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT (Token ParseErr) [Char] m NameSegment
-> ParsecT (Token ParseErr) [Char] m Char
-> ParsecT (Token ParseErr) [Char] m (NonEmpty NameSegment)
forall (m :: * -> *) a sep.
MonadPlus m =>
m a -> m sep -> m (NonEmpty a)
Monad.sepBy1 ParsecT (Token ParseErr) [Char] m NameSegment
forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m NameSegment
NameSegment.segmentP ParsecT (Token ParseErr) [Char] m Char
forall e. Ord e => ParsecT e [Char] m Char
separatorP
  where
    -- The separator between segments is just a dot, but we don't want to commit to parsing another segment unless the
    -- character after the dot can begin a segment.
    --
    -- This allows (for example) the "a." in "forall a. a -> a" to successfully parse as an identifier "a" followed by
    -- the reserved symbol ".", rathern than fail to parse as an identifier, because it looks like the prefix of some
    -- "a.b" that stops in the middle.
    separatorP :: (Ord e) => ParsecT e [Char] m Char
    separatorP :: forall e. Ord e => ParsecT e [Char] m Char
separatorP =
      ParsecT e [Char] m Char -> ParsecT e [Char] m Char
forall a. ParsecT e [Char] m a -> ParsecT e [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try do
        Char
c <- Token [Char] -> ParsecT e [Char] m (Token [Char])
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
P.char Char
Token [Char]
'.'
        ParsecT e [Char] m (Token [Char])
-> ParsecT e [Char] m (Token [Char])
forall a. ParsecT e [Char] m a -> ParsecT e [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead ((Token [Char] -> Bool) -> ParsecT e [Char] m (Token [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
P.satisfy Char -> Bool
Token [Char] -> Bool
segmentStartChar)
        pure Char
c

------------------------------------------------------------------------------------------------------------------------
-- Name classifiers

isSymboly :: Name -> Bool
isSymboly :: Name -> Bool
isSymboly =
  NameSegment -> Bool
NameSegment.isSymboly (NameSegment -> Bool) -> (Name -> NameSegment) -> Name -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Name -> NameSegment
Name.lastSegment