-- SPDX-FileCopyrightText: 2018 obsidian.systems -- SPDX-FileCopyrightText: 2020 Tocqueville Group -- -- SPDX-License-Identifier: LicenseRef-MIT-obsidian-systems -- | Module that defines helper types and functions that are related -- to Micheline. module Morley.Micheline.Json ( StringEncode (..) , TezosBigNum , TezosInt64 , TezosMutez (..) , TezosNat ) where import Data.Aeson (FromJSON, ToJSON, parseJSON, toEncoding, toJSON) import Data.Aeson.Encoding qualified as AE import Data.Aeson.Types qualified as Aeson import Data.Bits (Bits) import Data.Typeable (typeRep) import Fmt (Buildable(..)) import Text.Show qualified as T import Morley.Tezos.Core (Mutez(..), mkMutez) import Unsafe qualified (unsafeM) printAsString :: (PrettyShow a, Show a) => a -> Aeson.Value printAsString a = Aeson.String $ show a parseAsString :: forall a. (Read a, Typeable a) => Aeson.Value -> Aeson.Parser a parseAsString = Aeson.withText (T.show $ typeRep (Proxy :: Proxy a)) $ \txt -> maybe (fail "Failed to parse string") pure $ readMaybe (toString txt) parseStringEncodedIntegral :: (Read a, Typeable a) => Aeson.Value -> Aeson.Parser (StringEncode a) parseStringEncodedIntegral x = StringEncode <$> parseAsString x newtype StringEncode a = StringEncode { unStringEncode :: a } deriving stock (Generic, Eq, Ord, Bounded, Read, Show) deriving newtype (Enum, Num, Integral, Bits, Real, NFData, Hashable) type instance IntBaseType (StringEncode a) = IntBaseType a type TezosBigNum = StringEncode Integer instance FromJSON TezosBigNum where parseJSON = parseStringEncodedIntegral instance ToJSON TezosBigNum where toJSON (StringEncode x) = Aeson.String $ show x toEncoding (StringEncode x) = AE.integerText x type TezosInt64 = StringEncode Int64 instance FromJSON TezosInt64 where parseJSON = parseStringEncodedIntegral instance Buildable TezosInt64 where build = show . unStringEncode instance ToJSON TezosInt64 where toJSON (StringEncode x) = Aeson.String $ show x toEncoding (StringEncode x) = AE.int64Text x newtype TezosMutez = TezosMutez { unTezosMutez :: Mutez } deriving stock (Show, Eq, Ord) instance ToJSON TezosMutez where toJSON = printAsString . unMutez . unTezosMutez instance FromJSON TezosMutez where parseJSON v = do i <- parseAsString @Int64 v mutez <- Unsafe.unsafeM $ mkMutez i pure $ TezosMutez mutez type TezosNat = StringEncode Natural instance Buildable TezosNat where build = show . unStringEncode instance ToJSON TezosNat where toJSON (StringEncode x) = Aeson.String $ show x toEncoding (StringEncode x) = AE.integerText $ fromIntegral x instance FromJSON TezosNat where parseJSON = parseStringEncodedIntegral