-- |
-- Module      :  Network.Polkadot.Metadata.Type
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- Runtime metadata type and encoding.
--

module Network.Polkadot.Metadata.Type where

import           Codec.Scale.Class                     (Decode (..),
                                                        Encode (..))
import           Codec.Scale.Core                      ()
import           Data.Aeson                            (FromJSON (..),
                                                        ToJSON (..),
                                                        Value (String))
import           Data.Text                             (Text)

import           Network.Polkadot.Metadata.Type.Parser (sanitizeM)

-- | Sanitized name for metadata type.
newtype Type = Type { Type -> Text
unType :: Text }
    deriving (Type -> Type -> Bool
(Type -> Type -> Bool) -> (Type -> Type -> Bool) -> Eq Type
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Type -> Type -> Bool
== :: Type -> Type -> Bool
$c/= :: Type -> Type -> Bool
/= :: Type -> Type -> Bool
Eq, Eq Type
Eq Type =>
(Type -> Type -> Ordering)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Bool)
-> (Type -> Type -> Type)
-> (Type -> Type -> Type)
-> Ord Type
Type -> Type -> Bool
Type -> Type -> Ordering
Type -> Type -> Type
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
$ccompare :: Type -> Type -> Ordering
compare :: Type -> Type -> Ordering
$c< :: Type -> Type -> Bool
< :: Type -> Type -> Bool
$c<= :: Type -> Type -> Bool
<= :: Type -> Type -> Bool
$c> :: Type -> Type -> Bool
> :: Type -> Type -> Bool
$c>= :: Type -> Type -> Bool
>= :: Type -> Type -> Bool
$cmax :: Type -> Type -> Type
max :: Type -> Type -> Type
$cmin :: Type -> Type -> Type
min :: Type -> Type -> Type
Ord, Int -> Type -> ShowS
[Type] -> ShowS
Type -> String
(Int -> Type -> ShowS)
-> (Type -> String) -> ([Type] -> ShowS) -> Show Type
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Type -> ShowS
showsPrec :: Int -> Type -> ShowS
$cshow :: Type -> String
show :: Type -> String
$cshowList :: [Type] -> ShowS
showList :: [Type] -> ShowS
Show)

instance FromJSON Type where
    parseJSON :: Value -> Parser Type
parseJSON (String Text
s) = Type -> Parser Type
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Type
Type Text
s)
    parseJSON Value
_          = String -> Parser Type
forall a. String -> Parser a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Type should be a string"

instance ToJSON Type where
    toJSON :: Type -> Value
toJSON = Text -> Value
forall a. ToJSON a => a -> Value
toJSON (Text -> Value) -> (Type -> Text) -> Type -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Text
unType

instance Decode Type where
    get :: Get Type
get = (Text -> Type) -> Get Text -> Get Type
forall a b. (a -> b) -> Get a -> Get b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Type
Type (Text -> Get Text
forall (m :: * -> *). MonadFail m => Text -> m Text
sanitizeM (Text -> Get Text) -> Get Text -> Get Text
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Get Text
forall a. Decode a => Get a
get)

instance Encode Type where
    put :: Putter Type
put = Putter Text
forall a. Encode a => Putter a
put Putter Text -> (Type -> Text) -> Putter Type
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> Text
unType