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

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

    -- * 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.HashQualified (HashQualified (..))
import Unison.HashQualified qualified as HashQualified
import Unison.HashQualifiedPrime qualified as HQ'
import Unison.Name (Name)
import Unison.Prelude hiding (fromString)
import Unison.Syntax.HashQualifiedPrime qualified as HQ'
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
import Unison.Var (Var)
import Unison.Var qualified as Var
import Prelude hiding (take)

parseText :: Text -> Maybe (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

parseTextWith :: P.Parsec (Token Text) [Char] name -> Text -> Maybe (HashQualified name)
parseTextWith :: forall name.
Parsec (Token Text) [Char] name
-> Text -> Maybe (HashQualified name)
parseTextWith Parsec (Token Text) [Char] name
parser 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] 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 Parsec (Token Text) [Char] name
parser 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) [Char]
"" (Text -> [Char]
Text.unpack Text
text))

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

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

unsafeFromVar :: (Var v) => v -> HashQualified Name
unsafeFromVar :: forall v. Var v => v -> HashQualified Name
unsafeFromVar =
  Text -> HashQualified Name
unsafeParseText (Text -> HashQualified Name)
-> (v -> Text) -> v -> HashQualified Name
forall b c a. (b -> c) -> (a -> b) -> a -> c
. v -> Text
forall v. Var v => v -> Text
Var.name

toVar :: (Var v) => HashQualified Name -> v
toVar :: forall v. Var v => HashQualified Name -> v
toVar =
  Text -> v
forall v. Var v => Text -> v
Var.named (Text -> v)
-> (HashQualified Name -> Text) -> HashQualified Name -> v
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HashQualified Name -> Text
toText

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

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