{-# OPTIONS_GHC -Wno-redundant-constraints #-}
module Morley.Michelson.Text
( MText (..)
, mkMText
, mkMTextCut
, writeMText
, takeMText
, dropMText
, isMChar
, minBoundMChar
, maxBoundMChar
, qqMText
, mt
, DoNotUseTextError
, symbolToMText
, labelToMText
, mtextHeadToUpper
) where
import Data.Aeson (FromJSON(..), ToJSON(..))
import Data.Char qualified as C
import Data.Data (Data)
import Data.Text qualified as T
import Fmt (Buildable)
import Language.Haskell.TH qualified as TH
import Language.Haskell.TH.Quote qualified as TH
import Type.Errors (DelayError)
import Morley.Util.CLI
import Morley.Util.Label (Label(..), labelToText)
import Morley.Util.TypeLits
newtype MText = UnsafeMText { MText -> Text
unMText :: Text }
deriving stock (Int -> MText -> ShowS
[MText] -> ShowS
MText -> [Char]
(Int -> MText -> ShowS)
-> (MText -> [Char]) -> ([MText] -> ShowS) -> Show MText
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [MText] -> ShowS
$cshowList :: [MText] -> ShowS
show :: MText -> [Char]
$cshow :: MText -> [Char]
showsPrec :: Int -> MText -> ShowS
$cshowsPrec :: Int -> MText -> ShowS
Show, MText -> MText -> Bool
(MText -> MText -> Bool) -> (MText -> MText -> Bool) -> Eq MText
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MText -> MText -> Bool
$c/= :: MText -> MText -> Bool
== :: MText -> MText -> Bool
$c== :: MText -> MText -> Bool
Eq, Eq MText
Eq MText
-> (MText -> MText -> Ordering)
-> (MText -> MText -> Bool)
-> (MText -> MText -> Bool)
-> (MText -> MText -> Bool)
-> (MText -> MText -> Bool)
-> (MText -> MText -> MText)
-> (MText -> MText -> MText)
-> Ord MText
MText -> MText -> Bool
MText -> MText -> Ordering
MText -> MText -> MText
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
min :: MText -> MText -> MText
$cmin :: MText -> MText -> MText
max :: MText -> MText -> MText
$cmax :: MText -> MText -> MText
>= :: MText -> MText -> Bool
$c>= :: MText -> MText -> Bool
> :: MText -> MText -> Bool
$c> :: MText -> MText -> Bool
<= :: MText -> MText -> Bool
$c<= :: MText -> MText -> Bool
< :: MText -> MText -> Bool
$c< :: MText -> MText -> Bool
compare :: MText -> MText -> Ordering
$ccompare :: MText -> MText -> Ordering
Ord, Typeable MText
Typeable MText
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MText -> c MText)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MText)
-> (MText -> Constr)
-> (MText -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MText))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MText))
-> ((forall b. Data b => b -> b) -> MText -> MText)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r)
-> (forall u. (forall d. Data d => d -> u) -> MText -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> MText -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MText -> m MText)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText)
-> Data MText
MText -> DataType
MText -> Constr
(forall b. Data b => b -> b) -> MText -> MText
forall a.
Typeable a
-> (forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> MText -> u
forall u. (forall d. Data d => d -> u) -> MText -> [u]
forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r
forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MText -> m MText
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MText
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MText -> c MText
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MText)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MText)
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> MText -> m MText
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MText -> m MText
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> MText -> m MText
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MText -> u
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> MText -> u
gmapQ :: forall u. (forall d. Data d => d -> u) -> MText -> [u]
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> MText -> [u]
gmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r
$cgmapQr :: forall r r'.
(r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r
gmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r
$cgmapQl :: forall r r'.
(r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> MText -> r
gmapT :: (forall b. Data b => b -> b) -> MText -> MText
$cgmapT :: (forall b. Data b => b -> b) -> MText -> MText
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MText)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c MText)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MText)
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c MText)
dataTypeOf :: MText -> DataType
$cdataTypeOf :: MText -> DataType
toConstr :: MText -> Constr
$ctoConstr :: MText -> Constr
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MText
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c MText
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MText -> c MText
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> MText -> c MText
Data, (forall x. MText -> Rep MText x)
-> (forall x. Rep MText x -> MText) -> Generic MText
forall x. Rep MText x -> MText
forall x. MText -> Rep MText x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MText x -> MText
$cfrom :: forall x. MText -> Rep MText x
Generic)
deriving newtype (NonEmpty MText -> MText
MText -> MText -> MText
(MText -> MText -> MText)
-> (NonEmpty MText -> MText)
-> (forall b. Integral b => b -> MText -> MText)
-> Semigroup MText
forall b. Integral b => b -> MText -> MText
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: forall b. Integral b => b -> MText -> MText
$cstimes :: forall b. Integral b => b -> MText -> MText
sconcat :: NonEmpty MText -> MText
$csconcat :: NonEmpty MText -> MText
<> :: MText -> MText -> MText
$c<> :: MText -> MText -> MText
Semigroup, Semigroup MText
MText
Semigroup MText
-> MText
-> (MText -> MText -> MText)
-> ([MText] -> MText)
-> Monoid MText
[MText] -> MText
MText -> MText -> MText
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
mconcat :: [MText] -> MText
$cmconcat :: [MText] -> MText
mappend :: MText -> MText -> MText
$cmappend :: MText -> MText -> MText
mempty :: MText
$cmempty :: MText
Monoid, Eq (Element MText) => Element MText -> MText -> Bool
Ord (Element MText) => MText -> Maybe (Element MText)
Monoid (Element MText) => MText -> Element MText
(Element MText ~ Bool) => MText -> Bool
MText -> Bool
MText -> Int
MText -> [Element MText]
MText -> Maybe (Element MText)
(Element MText -> Bool) -> MText -> Bool
(Element MText -> Bool) -> MText -> Maybe (Element MText)
(Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText)
(MText -> [Element MText])
-> (MText -> Bool)
-> (forall b. (Element MText -> b -> b) -> b -> MText -> b)
-> (forall b. (b -> Element MText -> b) -> b -> MText -> b)
-> (forall b. (b -> Element MText -> b) -> b -> MText -> b)
-> (MText -> Int)
-> (Eq (Element MText) => Element MText -> MText -> Bool)
-> (forall m. Monoid m => (Element MText -> m) -> MText -> m)
-> (Monoid (Element MText) => MText -> Element MText)
-> (forall b. (Element MText -> b -> b) -> b -> MText -> b)
-> (Eq (Element MText) => Element MText -> MText -> Bool)
-> ((Element MText -> Bool) -> MText -> Bool)
-> ((Element MText -> Bool) -> MText -> Bool)
-> ((Element MText ~ Bool) => MText -> Bool)
-> ((Element MText ~ Bool) => MText -> Bool)
-> ((Element MText -> Bool) -> MText -> Maybe (Element MText))
-> (MText -> Maybe (Element MText))
-> (Ord (Element MText) => MText -> Maybe (Element MText))
-> (Ord (Element MText) => MText -> Maybe (Element MText))
-> ((Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText))
-> ((Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText))
-> Container MText
forall m. Monoid m => (Element MText -> m) -> MText -> m
forall t.
(t -> [Element t])
-> (t -> Bool)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (forall b. (b -> Element t -> b) -> b -> t -> b)
-> (t -> Int)
-> (Eq (Element t) => Element t -> t -> Bool)
-> (forall m. Monoid m => (Element t -> m) -> t -> m)
-> (Monoid (Element t) => t -> Element t)
-> (forall b. (Element t -> b -> b) -> b -> t -> b)
-> (Eq (Element t) => Element t -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t -> Bool) -> t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t ~ Bool) => t -> Bool)
-> ((Element t -> Bool) -> t -> Maybe (Element t))
-> (t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> (Ord (Element t) => t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
-> t -> Maybe (Element t))
-> ((Element t -> Element t -> Element t)
-> t -> Maybe (Element t))
-> Container t
forall b. (b -> Element MText -> b) -> b -> MText -> b
forall b. (Element MText -> b -> b) -> b -> MText -> b
safeFoldl1 :: (Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText)
$csafeFoldl1 :: (Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText)
safeFoldr1 :: (Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText)
$csafeFoldr1 :: (Element MText -> Element MText -> Element MText)
-> MText -> Maybe (Element MText)
safeMinimum :: Ord (Element MText) => MText -> Maybe (Element MText)
$csafeMinimum :: Ord (Element MText) => MText -> Maybe (Element MText)
safeMaximum :: Ord (Element MText) => MText -> Maybe (Element MText)
$csafeMaximum :: Ord (Element MText) => MText -> Maybe (Element MText)
safeHead :: MText -> Maybe (Element MText)
$csafeHead :: MText -> Maybe (Element MText)
find :: (Element MText -> Bool) -> MText -> Maybe (Element MText)
$cfind :: (Element MText -> Bool) -> MText -> Maybe (Element MText)
or :: (Element MText ~ Bool) => MText -> Bool
$cor :: (Element MText ~ Bool) => MText -> Bool
and :: (Element MText ~ Bool) => MText -> Bool
$cand :: (Element MText ~ Bool) => MText -> Bool
any :: (Element MText -> Bool) -> MText -> Bool
$cany :: (Element MText -> Bool) -> MText -> Bool
all :: (Element MText -> Bool) -> MText -> Bool
$call :: (Element MText -> Bool) -> MText -> Bool
notElem :: Eq (Element MText) => Element MText -> MText -> Bool
$cnotElem :: Eq (Element MText) => Element MText -> MText -> Bool
foldr' :: forall b. (Element MText -> b -> b) -> b -> MText -> b
$cfoldr' :: forall b. (Element MText -> b -> b) -> b -> MText -> b
fold :: Monoid (Element MText) => MText -> Element MText
$cfold :: Monoid (Element MText) => MText -> Element MText
foldMap :: forall m. Monoid m => (Element MText -> m) -> MText -> m
$cfoldMap :: forall m. Monoid m => (Element MText -> m) -> MText -> m
elem :: Eq (Element MText) => Element MText -> MText -> Bool
$celem :: Eq (Element MText) => Element MText -> MText -> Bool
length :: MText -> Int
$clength :: MText -> Int
foldl' :: forall b. (b -> Element MText -> b) -> b -> MText -> b
$cfoldl' :: forall b. (b -> Element MText -> b) -> b -> MText -> b
foldl :: forall b. (b -> Element MText -> b) -> b -> MText -> b
$cfoldl :: forall b. (b -> Element MText -> b) -> b -> MText -> b
foldr :: forall b. (Element MText -> b -> b) -> b -> MText -> b
$cfoldr :: forall b. (Element MText -> b -> b) -> b -> MText -> b
null :: MText -> Bool
$cnull :: MText -> Bool
toList :: MText -> [Element MText]
$ctoList :: MText -> [Element MText]
Container, MText -> Builder
(MText -> Builder) -> Buildable MText
forall p. (p -> Builder) -> Buildable p
build :: MText -> Builder
$cbuild :: MText -> Builder
Buildable, Int -> MText -> Int
MText -> Int
(Int -> MText -> Int) -> (MText -> Int) -> Hashable MText
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: MText -> Int
$chash :: MText -> Int
hashWithSalt :: Int -> MText -> Int
$chashWithSalt :: Int -> MText -> Int
Hashable)
instance NFData MText
minBoundMChar, maxBoundMChar :: Int
minBoundMChar :: Int
minBoundMChar = Int
32
maxBoundMChar :: Int
maxBoundMChar = Int
126
isMChar :: Char -> Bool
isMChar :: Char -> Bool
isMChar Char
c = Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
minBoundMChar Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
&& Char -> Int
forall a. Enum a => a -> Int
fromEnum Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
maxBoundMChar
invalidMCharError :: Char -> Text
invalidMCharError :: Char -> Text
invalidMCharError Char
c = Text
"Invalid character in string literal: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. ToText a => a -> Text
toText [Char
c]
mkMText :: Text -> Either Text MText
mkMText :: Text -> Either Text MText
mkMText Text
txt = (Char -> Either Text ()) -> [Char] -> Either Text [()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Char -> Either Text ()
checkMChar (Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
txt) Either Text [()] -> MText -> Either Text MText
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text -> MText
UnsafeMText Text
txt
where
checkMChar :: Char -> Either Text ()
checkMChar Char
c
| Char -> Bool
isMChar Char
c Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' = Either Text ()
forall (f :: * -> *). Applicative f => f ()
pass
| Bool
otherwise = Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$ Char -> Text
invalidMCharError Char
c
mkMTextCut :: Text -> MText
mkMTextCut :: Text -> MText
mkMTextCut Text
txt =
Text -> MText
UnsafeMText (Text -> MText) -> ([Char] -> Text) -> [Char] -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. ToText a => a -> Text
toText ([Char] -> Text) -> ShowS -> [Char] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> ShowS
forall a. (a -> Bool) -> [a] -> [a]
filter Char -> Bool
isAllowed ([Char] -> MText) -> [Char] -> MText
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
txt
where
isAllowed :: Char -> Bool
isAllowed Char
c = Char -> Bool
isMChar Char
c Bool -> Bool -> Bool
forall a. Boolean a => a -> a -> a
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n'
writeMText :: MText -> Text
writeMText :: MText -> Text
writeMText (UnsafeMText Text
t) = Text
t
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
T.replace Text
"\\" Text
"\\\\"
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
T.replace Text
"\n" Text
"\\n"
Text -> (Text -> Text) -> Text
forall a b. a -> (a -> b) -> b
& Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\""
takeMText :: Int -> MText -> MText
takeMText :: Int -> MText -> MText
takeMText Int
n (UnsafeMText Text
txt) = Text -> MText
UnsafeMText (Text -> MText) -> Text -> MText
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.take Int
n Text
txt
dropMText :: Int -> MText -> MText
dropMText :: Int -> MText -> MText
dropMText Int
n (UnsafeMText Text
txt) = Text -> MText
UnsafeMText (Text -> MText) -> Text -> MText
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.drop Int
n Text
txt
instance ToText MText where
toText :: MText -> Text
toText = MText -> Text
unMText
instance ToJSON MText where
toJSON :: MText -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (MText -> Text) -> MText -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. MText -> Text
unMText
instance FromJSON MText where
parseJSON :: Value -> Parser MText
parseJSON Value
v =
(Text -> Parser MText)
-> (MText -> Parser MText) -> Either Text MText -> Parser MText
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Char] -> Parser MText
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Parser MText)
-> (Text -> [Char]) -> Text -> Parser MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Char]
forall a. ToString a => a -> [Char]
toString) MText -> Parser MText
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either Text MText -> Parser MText)
-> (Text -> Either Text MText) -> Text -> Parser MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Parser MText) -> Parser Text -> Parser MText
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. FromJSON a => Value -> Parser a
parseJSON @Text Value
v
instance HasCLReader MText where
getReader :: ReadM MText
getReader = ([Char] -> Either [Char] MText) -> ReadM MText
forall a. ([Char] -> Either [Char] a) -> ReadM a
eitherReader ((Text -> [Char]) -> Either Text MText -> Either [Char] MText
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> [Char]
forall a. ToString a => a -> [Char]
toString (Either Text MText -> Either [Char] MText)
-> ([Char] -> Either Text MText) -> [Char] -> Either [Char] MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> ([Char] -> Text) -> [Char] -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> Text
forall a. ToText a => a -> Text
toText)
getMetavar :: [Char]
getMetavar = [Char]
"MICHELSON STRING"
mt :: TH.QuasiQuoter
mt :: QuasiQuoter
mt = QuasiQuoter :: ([Char] -> Q Exp)
-> ([Char] -> Q Pat)
-> ([Char] -> Q Type)
-> ([Char] -> Q [Dec])
-> QuasiQuoter
TH.QuasiQuoter
{ quoteExp :: [Char] -> Q Exp
TH.quoteExp = \[Char]
s ->
case [Char] -> Either Text [Char]
qqMText [Char]
s of
Left Text
err -> [Char] -> Q Exp
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Q Exp) -> [Char] -> Q Exp
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
err
Right [Char]
txt -> [e| UnsafeMText (toText @String txt) |]
, quotePat :: [Char] -> Q Pat
TH.quotePat = \[Char]
s ->
case [Char] -> Either Text [Char]
qqMText [Char]
s of
Left Text
err -> [Char] -> Q Pat
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail ([Char] -> Q Pat) -> [Char] -> Q Pat
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
forall a. ToString a => a -> [Char]
toString Text
err
Right [Char]
txt -> [p| UnsafeMText $(TH.litP $ TH.StringL txt) |]
, quoteType :: [Char] -> Q Type
TH.quoteType = \[Char]
_ ->
[Char] -> Q Type
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot use this QuasiQuoter at type position"
, quoteDec :: [Char] -> Q [Dec]
TH.quoteDec = \[Char]
_ ->
[Char] -> Q [Dec]
forall (m :: * -> *) a. MonadFail m => [Char] -> m a
fail [Char]
"Cannot use this QuasiQuoter at declaration position"
}
{-# ANN module ("HLint: ignore Use list literal pattern" :: Text) #-}
qqMText :: String -> Either Text String
qqMText :: [Char] -> Either Text [Char]
qqMText [Char]
txt = [Char] -> Either Text [Char]
scan [Char]
txt
where
scan :: [Char] -> Either Text [Char]
scan = \case
Char
'\\' : [] -> Text -> Either Text [Char]
forall a b. a -> Either a b
Left Text
"Unterminated '\\' in string literal"
Char
'\\' : Char
'\\' : [Char]
s -> (Char
'\\' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Either Text [Char] -> Either Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either Text [Char]
scan [Char]
s
Char
'\\' : Char
'n' : [Char]
s -> (Char
'\n' Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Either Text [Char] -> Either Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either Text [Char]
scan [Char]
s
Char
'\\' : Char
c : [Char]
_ -> Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Text
"Unknown escape sequence: '\\" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
forall a. ToText a => a -> Text
toText [Char
c] Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
Char
c : [Char]
s
| Char -> Bool
isMChar Char
c -> (Char
c Char -> ShowS
forall a. a -> [a] -> [a]
:) ShowS -> Either Text [Char] -> Either Text [Char]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Char] -> Either Text [Char]
scan [Char]
s
| Bool
otherwise -> Text -> Either Text [Char]
forall a b. a -> Either a b
Left (Text -> Either Text [Char]) -> Text -> Either Text [Char]
forall a b. (a -> b) -> a -> b
$ Char -> Text
invalidMCharError Char
c
[] -> [Char] -> Either Text [Char]
forall a b. b -> Either a b
Right []
type DoNotUseTextError = DelayError
( 'Text "`Text` is not isomorphic to Michelson strings," ':$$:
'Text "consider using `MText` type instead"
)
symbolToMText :: forall name. KnownSymbol name => MText
symbolToMText :: forall (name :: Symbol). KnownSymbol name => MText
symbolToMText = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Text -> Either Text MText) -> Text -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> MText) -> Text -> MText
forall a b. (a -> b) -> a -> b
$ forall (s :: Symbol). KnownSymbol s => Text
symbolValT' @name
labelToMText :: Label name -> MText
labelToMText :: forall (name :: Symbol). Label name -> MText
labelToMText = Either Text MText -> MText
forall a b. (HasCallStack, Buildable a) => Either a b -> b
unsafe (Either Text MText -> MText)
-> (Label name -> Either Text MText) -> Label name -> MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either Text MText
mkMText (Text -> Either Text MText)
-> (Label name -> Text) -> Label name -> Either Text MText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Label name -> Text
forall (name :: Symbol). Label name -> Text
labelToText
mtextHeadToUpper :: HasCallStack => MText -> MText
mtextHeadToUpper :: HasCallStack => MText -> MText
mtextHeadToUpper (UnsafeMText Text
txt) = case Text -> Maybe (Char, Text)
T.uncons Text
txt of
Maybe (Char, Text)
Nothing -> Text -> MText
forall a. HasCallStack => Text -> a
error Text
"Empty text"
Just (Char
c, Text
cs) -> Text -> MText
UnsafeMText (Text -> MText) -> Text -> MText
forall a b. (a -> b) -> a -> b
$ Char -> Text -> Text
T.cons (Char -> Char
C.toUpper Char
c) Text
cs