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

-- | Syntax-related combinators for HashQualified' (to/from string types).
module Unison.Syntax.HashQualifiedPrime
  ( -- * String conversions
    parseText,
    unsafeParseText,
    toText,

    -- * Parsers
    hashQualifiedP,
  )
where

import Data.Text qualified as Text
import Text.Megaparsec (ParsecT)
import Text.Megaparsec qualified as P
import Text.Megaparsec.Internal qualified as P (withParsecT)
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Prelude hiding (fromString)
import Unison.Syntax.Lexer.Token (Token)
import Unison.Syntax.Name qualified as Name (nameP, toText)
import Unison.Syntax.NameSegment qualified as NameSegment
import Unison.Syntax.ShortHash qualified as ShortHash (shortHashP)

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

parseText :: Text -> Maybe (HQ'.HashQualified Name)
parseText :: Text -> Maybe (HashQualified Name)
parseText Text
text =
  Either (ParseErrorBundle [Char] (Token Text)) (HashQualified Name)
-> Maybe (HashQualified Name)
forall a b. Either a b -> Maybe b
eitherToMaybe (Parsec (Token Text) [Char] (HashQualified Name)
-> [Char]
-> [Char]
-> Either
     (ParseErrorBundle [Char] (Token Text)) (HashQualified Name)
forall e s a.
Parsec e s a -> [Char] -> s -> Either (ParseErrorBundle s e) a
P.runParser Parsec (Token Text) [Char] (HashQualified Name)
parser [Char]
"" (Text -> [Char]
Text.unpack Text
text))
  where
    parser :: Parsec (Token Text) [Char] (HashQualified Name)
parser =
      ParsecT (Token Text) [Char] Identity Name
-> Parsec (Token Text) [Char] (HashQualified Name)
forall (m :: * -> *) name.
Monad m =>
ParsecT (Token Text) [Char] m name
-> ParsecT (Token Text) [Char] m (HashQualified name)
hashQualifiedP ((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) Parsec (Token Text) [Char] (HashQualified Name)
-> ParsecT (Token Text) [Char] Identity ()
-> Parsec (Token Text) [Char] (HashQualified 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

unsafeParseText :: (HasCallStack) => Text -> HQ'.HashQualified Name
unsafeParseText :: HasCallStack => Text -> HashQualified Name
unsafeParseText Text
txt = HashQualified Name
-> Maybe (HashQualified Name) -> HashQualified Name
forall a. a -> Maybe a -> a
fromMaybe HashQualified Name
msg (Text -> Maybe (HashQualified Name)
parseText Text
txt)
  where
    msg :: HashQualified Name
msg = [Char] -> HashQualified Name
forall a. HasCallStack => [Char] -> a
error ([Char]
"HashQualified.unsafeFromText " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Text -> [Char]
forall a. Show a => a -> [Char]
show Text
txt)

toText :: HQ'.HashQualified Name -> Text
toText :: HashQualified Name -> Text
toText =
  (Name -> Text) -> HashQualified Name -> Text
forall n. (n -> Text) -> HashQualified n -> Text
HQ'.toTextWith Name -> Text
Name.toText

------------------------------------------------------------------------------------------------------------------------
-- Hash-qualified parsers

-- | A hash-qualified parser.
hashQualifiedP ::
  (Monad m) =>
  ParsecT (Token Text) [Char] m name ->
  ParsecT (Token Text) [Char] m (HQ'.HashQualified name)
hashQualifiedP :: forall (m :: * -> *) name.
Monad m =>
ParsecT (Token Text) [Char] m name
-> ParsecT (Token Text) [Char] m (HashQualified name)
hashQualifiedP ParsecT (Token Text) [Char] m name
nameP =
  ParsecT (Token Text) [Char] m (HashQualified name)
-> ParsecT (Token Text) [Char] m (HashQualified name)
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 do
    name
name <- ParsecT (Token Text) [Char] m name
nameP
    ParsecT (Token Text) [Char] m ShortHash
-> ParsecT (Token Text) [Char] m (Maybe ShortHash)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT (Token Text) [Char] m ShortHash
forall (m :: * -> *). ParsecT (Token Text) [Char] m ShortHash
ShortHash.shortHashP ParsecT (Token Text) [Char] m (Maybe ShortHash)
-> (Maybe ShortHash -> HashQualified name)
-> ParsecT (Token Text) [Char] m (HashQualified name)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
      Maybe ShortHash
Nothing -> name -> HashQualified name
forall n. n -> HashQualified n
HQ'.NameOnly name
name
      Just ShortHash
hash -> name -> ShortHash -> HashQualified name
forall n. n -> ShortHash -> HashQualified n
HQ'.HashQualified name
name ShortHash
hash