-- | Utilities related to the parsing and printing of name segments using the default syntax.
module Unison.Syntax.NameSegment
  ( -- * String conversions
    toEscapedText,
    toEscapedTextBuilder,
    parseText,
    unsafeParseText,

    -- * Name segment parsers
    isSymboly,

    -- * Name segment classifiers
    ParseErr (..),
    renderParseErr,
    segmentP,
    symbolyP,
    wordyP,

    -- * Character classifiers
    segmentStartChar,
    symbolyIdChar,
    wordyIdStartChar,
    wordyIdChar,
  )
where

import Data.Char qualified as Char
import Data.Set qualified as Set
import Data.Text qualified as Text
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.NameSegment.Internal (NameSegment (NameSegment))
import Unison.NameSegment.Internal qualified as NameSegment
import Unison.Prelude
import Unison.Syntax.Lexer.Token (Token (..), posP)
import Unison.Syntax.ReservedWords (keywords, reservedOperators)

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

-- | Convert a name segment to escaped text, for display purposes.
--
-- > toEscapedText (unsafeFromText ".~") = "`.~`"
toEscapedText :: NameSegment -> Text
toEscapedText :: NameSegment -> Text
toEscapedText segment :: NameSegment
segment@(NameSegment Text
text)
  | Bool
shouldEscape = Text
"`" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
text Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"`"
  | Bool
otherwise = Text
text
  where
    shouldEscape :: Bool
shouldEscape =
      if NameSegment -> Bool
isSymboly NameSegment
segment
        then Bool
isReservedOperator Bool -> Bool -> Bool
|| Bool
symbolNeedsEscaping
        else Bool
isKeyword
    isKeyword :: Bool
isKeyword = Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
text Set Text
keywords
    isReservedOperator :: Bool
isReservedOperator = Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
text Set Text
reservedOperators
    symbolNeedsEscaping :: Bool
symbolNeedsEscaping = Bool -> Bool
not ((Char -> Bool) -> Text -> Bool
Text.all Char -> Bool
symbolyIdChar Text
text)

toEscapedTextBuilder :: NameSegment -> Text.Builder
toEscapedTextBuilder :: NameSegment -> Builder
toEscapedTextBuilder =
  Text -> Builder
Text.Builder.fromText (Text -> Builder)
-> (NameSegment -> Text) -> NameSegment -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
toEscapedText

-- | Parse text as a name segment.
--
-- > parseText "foo" = Right (NameSegment "foo")
-- > parseText ".~" = Left ...
-- > parseText "`.~`" = Right (NameSegment ".~")
parseText :: Text -> Either Text NameSegment
parseText :: Text -> Either Text NameSegment
parseText Text
text =
  case Parsec (Token Text) [Char] NameSegment
-> [Char]
-> [Char]
-> Either (ParseErrorBundle [Char] (Token Text)) NameSegment
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 NameSegment
-> Parsec (Token Text) [Char] NameSegment
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
renderParseErr) (ParsecT (Token ParseErr) [Char] Identity NameSegment
forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m NameSegment
segmentP ParsecT (Token ParseErr) [Char] Identity NameSegment
-> ParsecT (Token ParseErr) [Char] Identity ()
-> ParsecT (Token ParseErr) [Char] Identity NameSegment
forall a b.
ParsecT (Token ParseErr) [Char] Identity a
-> ParsecT (Token ParseErr) [Char] Identity b
-> ParsecT (Token ParseErr) [Char] Identity a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT (Token ParseErr) [Char] Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
P.eof)) [Char]
"" (Text -> [Char]
Text.unpack Text
text) of
    Left ParseErrorBundle [Char] (Token Text)
err -> Text -> Either Text NameSegment
forall a b. a -> Either a b
Left ([Char] -> Text
Text.pack (ParseErrorBundle [Char] (Token Text) -> [Char]
forall s e.
(VisualStream s, TraversableStream s, ShowErrorComponent e) =>
ParseErrorBundle s e -> [Char]
P.errorBundlePretty ParseErrorBundle [Char] (Token Text)
err))
    Right NameSegment
segment -> NameSegment -> Either Text NameSegment
forall a b. b -> Either a b
Right NameSegment
segment

-- | Parse text as a name segment.
unsafeParseText :: Text -> NameSegment
unsafeParseText :: Text -> NameSegment
unsafeParseText =
  (Text -> NameSegment)
-> (NameSegment -> NameSegment)
-> Either Text NameSegment
-> NameSegment
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> NameSegment
forall a. HasCallStack => [Char] -> a
error ([Char] -> NameSegment) -> (Text -> [Char]) -> Text -> NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
Text.unpack) NameSegment -> NameSegment
forall a. a -> a
id (Either Text NameSegment -> NameSegment)
-> (Text -> Either Text NameSegment) -> Text -> NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text NameSegment
parseText

------------------------------------------------------------------------------------------------------------------------
-- Name segment parsers

data ParseErr
  = ReservedOperator !Text
  | ReservedWord !Text
  deriving stock (ParseErr -> ParseErr -> Bool
(ParseErr -> ParseErr -> Bool)
-> (ParseErr -> ParseErr -> Bool) -> Eq ParseErr
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParseErr -> ParseErr -> Bool
== :: ParseErr -> ParseErr -> Bool
$c/= :: ParseErr -> ParseErr -> Bool
/= :: ParseErr -> ParseErr -> Bool
Eq, Eq ParseErr
Eq ParseErr =>
(ParseErr -> ParseErr -> Ordering)
-> (ParseErr -> ParseErr -> Bool)
-> (ParseErr -> ParseErr -> Bool)
-> (ParseErr -> ParseErr -> Bool)
-> (ParseErr -> ParseErr -> Bool)
-> (ParseErr -> ParseErr -> ParseErr)
-> (ParseErr -> ParseErr -> ParseErr)
-> Ord ParseErr
ParseErr -> ParseErr -> Bool
ParseErr -> ParseErr -> Ordering
ParseErr -> ParseErr -> ParseErr
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ParseErr -> ParseErr -> Ordering
compare :: ParseErr -> ParseErr -> Ordering
$c< :: ParseErr -> ParseErr -> Bool
< :: ParseErr -> ParseErr -> Bool
$c<= :: ParseErr -> ParseErr -> Bool
<= :: ParseErr -> ParseErr -> Bool
$c> :: ParseErr -> ParseErr -> Bool
> :: ParseErr -> ParseErr -> Bool
$c>= :: ParseErr -> ParseErr -> Bool
>= :: ParseErr -> ParseErr -> Bool
$cmax :: ParseErr -> ParseErr -> ParseErr
max :: ParseErr -> ParseErr -> ParseErr
$cmin :: ParseErr -> ParseErr -> ParseErr
min :: ParseErr -> ParseErr -> ParseErr
Ord)

renderParseErr :: ParseErr -> Text
renderParseErr :: ParseErr -> Text
renderParseErr = \case
  ReservedOperator Text
s -> Text
"reserved operator: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
  ReservedWord Text
s -> Text
"reserved word: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s

segmentP :: (Monad m) => ParsecT (Token ParseErr) [Char] m NameSegment
segmentP :: forall (m :: * -> *).
Monad m =>
ParsecT (Token ParseErr) [Char] m NameSegment
segmentP =
  (Token Text -> Token ParseErr)
-> ParsecT (Token Text) [Char] m NameSegment
-> ParsecT (Token ParseErr) [Char] m NameSegment
forall e e' s (m :: * -> *) a.
Ord e' =>
(e -> e') -> ParsecT e s m a -> ParsecT e' s m a
P.withParsecT ((Text -> ParseErr) -> Token Text -> Token ParseErr
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ParseErr
ReservedOperator) ParsecT (Token Text) [Char] m NameSegment
forall (m :: * -> *). ParsecT (Token Text) [Char] m NameSegment
symbolyP
    ParsecT (Token ParseErr) [Char] m NameSegment
-> ParsecT (Token ParseErr) [Char] m NameSegment
-> ParsecT (Token ParseErr) [Char] m NameSegment
forall a.
ParsecT (Token ParseErr) [Char] m a
-> ParsecT (Token ParseErr) [Char] m a
-> ParsecT (Token ParseErr) [Char] m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Token Text -> Token ParseErr)
-> ParsecT (Token Text) [Char] m NameSegment
-> ParsecT (Token ParseErr) [Char] m NameSegment
forall e e' s (m :: * -> *) a.
Ord e' =>
(e -> e') -> ParsecT e s m a -> ParsecT e' s m a
P.withParsecT ((Text -> ParseErr) -> Token Text -> Token ParseErr
forall a b. (a -> b) -> Token a -> Token b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> ParseErr
ReservedWord) ParsecT (Token Text) [Char] m NameSegment
forall (m :: * -> *). ParsecT (Token Text) [Char] m NameSegment
wordyP

-- | A symboly name segment parser, which consists only of symboly characters.
--
-- A symboly name segment can optionally be escaped by surrounding it with backticks, which expands the list of allowed
-- symbols to include these three: . ( )
--
-- Throws the parsed name segment as an error if it's unescaped and reserved, e.g. "=".
symbolyP :: ParsecT (Token Text) [Char] m NameSegment
symbolyP :: forall (m :: * -> *). ParsecT (Token Text) [Char] m NameSegment
symbolyP = do
  Pos
start <- ParsecT (Token Text) [Char] m Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
  [ParsecT (Token Text) [Char] m NameSegment]
-> ParsecT (Token Text) [Char] m NameSegment
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        Token [Char]
_ <- ParsecT (Token Text) [Char] m (Token [Char])
-> ParsecT (Token Text) [Char] m (Token [Char])
forall a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Token Text) [Char] m (Token [Char])
-> ParsecT (Token Text) [Char] m (Token [Char])
forall a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (Token [Char] -> ParsecT (Token Text) [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 (Token Text) [Char] m Char
-> ParsecT (Token Text) [Char] m (Token [Char])
-> ParsecT (Token Text) [Char] m (Token [Char])
forall a b.
ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m b
-> ParsecT (Token Text) [Char] m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Token [Char] -> Bool)
-> ParsecT (Token Text) [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
escapedSymbolyIdChar))
        ParsecT (Token Text) [Char] m NameSegment
-> ParsecT (Token Text) [Char] m NameSegment
forall (m :: * -> *) a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
escapeP ([Char]
-> (Token [Char] -> Bool)
-> ParsecT (Token Text) [Char] m NameSegment
forall {s} {f :: * -> *} {e}.
(Tokens s ~ [Char], MonadParsec e s f) =>
[Char] -> (Token s -> Bool) -> f NameSegment
segmentP (Set Char -> [Char]
description Set Char
escapedSymbolyIdChars) Char -> Bool
Token [Char] -> Bool
escapedSymbolyIdChar),
      do
        NameSegment
symbol <- [Char]
-> (Token [Char] -> Bool)
-> ParsecT (Token Text) [Char] m NameSegment
forall {s} {f :: * -> *} {e}.
(Tokens s ~ [Char], MonadParsec e s f) =>
[Char] -> (Token s -> Bool) -> f NameSegment
segmentP (Set Char -> [Char]
description Set Char
symbolyIdChars) Char -> Bool
Token [Char] -> Bool
symbolyIdChar
        Pos -> NameSegment -> ParsecT (Token Text) [Char] m ()
forall {f :: * -> *} {s}.
(TraversableStream s, MonadParsec (Token Text) s f) =>
Pos -> NameSegment -> f ()
check Pos
start NameSegment
symbol
        pure NameSegment
symbol
    ]
  where
    segmentP :: [Char] -> (Token s -> Bool) -> f NameSegment
segmentP [Char]
name Token s -> Bool
predicate =
      Text -> NameSegment
NameSegment (Text -> NameSegment) -> ([Char] -> Text) -> [Char] -> NameSegment
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
Text.pack ([Char] -> NameSegment) -> f [Char] -> f NameSegment
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe [Char] -> (Token s -> Bool) -> f (Tokens s)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
name) Token s -> Bool
predicate

    check :: Pos -> NameSegment -> f ()
check Pos
start (NameSegment Text
symbol) =
      Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
symbol Set Text
reservedOperators) do
        Pos
end <- f Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
        Token Text -> f ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Text -> Pos -> Pos -> Token Text
forall a. a -> Pos -> Pos -> Token a
Token Text
symbol Pos
start Pos
end)

    description :: Set Char -> [Char]
description Set Char
valid =
      [Char]
"operator (valid characters: " [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ Set Char -> [Char]
forall a. Set a -> [a]
Set.toList Set Char
valid [Char] -> [Char] -> [Char]
forall a. [a] -> [a] -> [a]
++ [Char]
")"

-- | A wordy name segment parser, which consists only of wordy characters.
--
-- Throws the parsed name segment as an error if it's an unescaped keyword, e.g. "match".
wordyP :: ParsecT (Token Text) [Char] m NameSegment
wordyP :: forall (m :: * -> *). ParsecT (Token Text) [Char] m NameSegment
wordyP = do
  Pos
start <- ParsecT (Token Text) [Char] m Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
  [ParsecT (Token Text) [Char] m NameSegment]
-> ParsecT (Token Text) [Char] m NameSegment
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Alternative f) =>
t (f a) -> f a
asum
    [ do
        Token [Char]
_ <- ParsecT (Token Text) [Char] m (Token [Char])
-> ParsecT (Token Text) [Char] m (Token [Char])
forall a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.try (ParsecT (Token Text) [Char] m (Token [Char])
-> ParsecT (Token Text) [Char] m (Token [Char])
forall a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
P.lookAhead (Token [Char] -> ParsecT (Token Text) [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 (Token Text) [Char] m Char
-> ParsecT (Token Text) [Char] m (Token [Char])
-> ParsecT (Token Text) [Char] m (Token [Char])
forall a b.
ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m b
-> ParsecT (Token Text) [Char] m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Token [Char] -> Bool)
-> ParsecT (Token Text) [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
wordyIdStartChar))
        ParsecT (Token Text) [Char] m NameSegment
-> ParsecT (Token Text) [Char] m NameSegment
forall (m :: * -> *) a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
escapeP ParsecT (Token Text) [Char] m NameSegment
unescaped,
      do
        NameSegment
word <- ParsecT (Token Text) [Char] m NameSegment
unescaped
        Pos -> NameSegment -> ParsecT (Token Text) [Char] m ()
forall {f :: * -> *} {s}.
(TraversableStream s, MonadParsec (Token Text) s f) =>
Pos -> NameSegment -> f ()
check Pos
start NameSegment
word
        pure NameSegment
word
    ]
  where
    unescaped :: ParsecT (Token Text) [Char] m NameSegment
unescaped = do
      Char
ch <- (Token [Char] -> Bool)
-> ParsecT (Token Text) [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
wordyIdStartChar
      [Char]
rest <- Maybe [Char]
-> (Token [Char] -> Bool)
-> ParsecT (Token Text) [Char] m (Tokens [Char])
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe [Char] -> (Token s -> Bool) -> m (Tokens s)
P.takeWhileP ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
wordyMsg) Char -> Bool
Token [Char] -> Bool
wordyIdChar
      pure (Text -> NameSegment
NameSegment ([Char] -> Text
Text.pack (Char
ch Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
rest)))

    check :: Pos -> NameSegment -> f ()
check Pos
start (NameSegment Text
word) =
      Bool -> f () -> f ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Set Text -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Text
word Set Text
keywords) do
        Pos
end <- f Pos
forall e s (m :: * -> *).
(Ord e, TraversableStream s, MonadParsec e s m) =>
m Pos
posP
        Token Text -> f ()
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure (Text -> Pos -> Pos -> Token Text
forall a. a -> Pos -> Pos -> Token a
Token Text
word Pos
start Pos
end)

    wordyMsg :: [Char]
wordyMsg = [Char]
"identifier (ex: abba1, snake_case, .foo.bar#xyz, .foo.++#xyz, or 🌻)"

escapeP :: ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
escapeP :: forall (m :: * -> *) a.
ParsecT (Token Text) [Char] m a -> ParsecT (Token Text) [Char] m a
escapeP ParsecT (Token Text) [Char] m a
parser =
  Token [Char] -> ParsecT (Token Text) [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 (Token Text) [Char] m Char
-> ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m a
forall a b.
ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m b
-> ParsecT (Token Text) [Char] m b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT (Token Text) [Char] m a
parser ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m Char
-> ParsecT (Token Text) [Char] m a
forall a b.
ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m b
-> ParsecT (Token Text) [Char] m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token [Char] -> ParsecT (Token Text) [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]
'`'

------------------------------------------------------------------------------------------------------------------------
-- Character classifiers

isSymboly :: NameSegment -> Bool
isSymboly :: NameSegment -> Bool
isSymboly =
  Bool -> Bool
not (Bool -> Bool) -> (NameSegment -> Bool) -> NameSegment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
wordyIdStartChar (Char -> Bool) -> (NameSegment -> Char) -> NameSegment -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Char
Text -> Char
Text.head (Text -> Char) -> (NameSegment -> Text) -> NameSegment -> Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NameSegment -> Text
NameSegment.toUnescapedText

------------------------------------------------------------------------------------------------------------------------
-- Character classifiers

segmentStartChar :: Char -> Bool
segmentStartChar :: Char -> Bool
segmentStartChar Char
c =
  Char -> Bool
wordyIdStartChar Char
c Bool -> Bool -> Bool
|| Char -> Bool
symbolyIdChar Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'`' -- backtick starts an escaped segment

symbolyIdChar :: Char -> Bool
symbolyIdChar :: Char -> Bool
symbolyIdChar =
  (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
symbolyIdChars)

-- | The set of characters allowed in an unescaped symboly identifier.
symbolyIdChars :: Set Char
symbolyIdChars :: Set Char
symbolyIdChars =
  [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
"!$%^&*-=+<>~\\/|:"

escapedSymbolyIdChar :: Char -> Bool
escapedSymbolyIdChar :: Char -> Bool
escapedSymbolyIdChar =
  (Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
escapedSymbolyIdChars)

-- | The set of characters allowed in an escaped symboly identifier.
escapedSymbolyIdChars :: Set Char
escapedSymbolyIdChars :: Set Char
escapedSymbolyIdChars =
  [Char] -> Set Char
forall a. Ord a => [a] -> Set a
Set.fromList [Char]
".()" Set Char -> Set Char -> Set Char
forall a. Semigroup a => a -> a -> a
<> Set Char
symbolyIdChars

wordyIdStartChar :: Char -> Bool
wordyIdStartChar :: Char -> Bool
wordyIdStartChar Char
ch =
  Char -> Bool
Char.isAlpha Char
ch Bool -> Bool -> Bool
|| Char -> Bool
isEmoji Char
ch Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_'

wordyIdChar :: Char -> Bool
wordyIdChar :: Char -> Bool
wordyIdChar Char
ch =
  Char -> Bool
Char.isAlphaNum Char
ch Bool -> Bool -> Bool
|| Char -> Bool
isEmoji Char
ch Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'!' Bool -> Bool -> Bool
|| Char
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

isEmoji :: Char -> Bool
isEmoji :: Char -> Bool
isEmoji Char
c =
  Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
'\x1F300' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
<= Char
'\x1FAFF'