-- | Utilities related to the parsing and printing of short hashes using the default syntax.
module Unison.Syntax.ShortHash
  ( -- * Short hash parsers
    shortHashP,
  )
where

import Data.Char qualified as Char
import Data.Set qualified as Set
import Data.Text qualified as Text
import Text.Megaparsec (ParsecT)
import Text.Megaparsec qualified as P
import Text.Megaparsec.Char qualified as P
import Unison.Prelude
import Unison.ShortHash (ShortHash)
import Unison.ShortHash qualified as ShortHash
import Unison.Syntax.Lexer.Token (Token (..), tokenP)
import Unison.Syntax.ReservedWords (delimiters)

-- | A short hash parser.
--
-- Throws the parsed hash as an error if it's invalid.
shortHashP :: ParsecT (Token Text) [Char] m ShortHash
shortHashP :: forall (m :: * -> *). ParsecT (Token Text) [Char] m ShortHash
shortHashP =
  [Char]
-> ParsecT (Token Text) [Char] m ShortHash
-> ParsecT (Token Text) [Char] m ShortHash
forall a.
[Char]
-> ParsecT (Token Text) [Char] m a
-> ParsecT (Token Text) [Char] m a
forall e s (m :: * -> *) a.
MonadParsec e s m =>
[Char] -> m a -> m a
P.label [Char]
hashMsg do
    ParsecT (Token Text) [Char] m Char
-> ParsecT (Token Text) [Char] m 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]
'#')
    Token Text
token <-
      ParsecT (Token Text) [Char] m Text
-> ParsecT (Token Text) [Char] m (Token Text)
forall e s (m :: * -> *) a.
(Ord e, TraversableStream s, MonadParsec e s m) =>
m a -> m (Token a)
tokenP do
        [Char] -> Text
Text.pack ([Char] -> Text)
-> ParsecT (Token Text) [Char] m [Char]
-> ParsecT (Token Text) [Char] m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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.takeWhile1P ([Char] -> Maybe [Char]
forall a. a -> Maybe a
Just [Char]
hashMsg) (\Token [Char]
ch -> Bool -> Bool
not (Char -> Bool
isSep Char
Token [Char]
ch) Bool -> Bool -> Bool
&& Char
Token [Char]
ch Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'`')
    case Text -> Maybe ShortHash
ShortHash.fromText (Token Text -> Text
forall a. Token a -> a
payload Token Text
token) of
      Maybe ShortHash
Nothing -> Token Text -> ParsecT (Token Text) [Char] m ShortHash
forall e s (m :: * -> *) a. MonadParsec e s m => e -> m a
P.customFailure Token Text
token
      Just ShortHash
sh -> ShortHash -> ParsecT (Token Text) [Char] m ShortHash
forall a. a -> ParsecT (Token Text) [Char] m a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ShortHash
sh
  where
    hashMsg :: [Char]
hashMsg = [Char]
"hash (ex: #af3sj3)"

    isSep :: Char -> Bool
    isSep :: Char -> Bool
isSep Char
c =
      Char -> Bool
Char.isSpace Char
c Bool -> Bool -> Bool
|| Char -> Set Char -> Bool
forall a. Ord a => a -> Set a -> Bool
Set.member Char
c Set Char
delimiters