Json.hs

-- 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