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

module Network.Polkadot.Metadata.Type.Ast where

import           Data.Text (Text)

-- | Qualified type parameter, e.g., <Vec<T> as SomeTrait>::SomeType.
type QSelf = (TypeAst, TypeAst)

-- | A segment of a path: an identifier and a set of argument types.
type PathSegment = (Text, Maybe [TypeAst])

-- | Simple Rust type AST is used for Metadata type representation.
data TypeAst
    = Slice !TypeAst
    -- ^ A variable-length slice ([T]).
    | Tuple ![TypeAst]
    -- ^ A tuple ((A, B, C, D,...)).
    | Array !TypeAst !Int
    -- ^ A fixed length array ([T; n]).
    | Path { TypeAst -> Maybe QSelf
qself    :: !(Maybe QSelf)
           -- ^ Two types of <Vec<T> as Trait>.
           , TypeAst -> [PathSegment]
segments :: ![PathSegment]
           -- ^ A segment of a path: an identifier and a set of types.
           }
    -- ^ A "Path" is essentially Rust's notion of a name. It's represented as a sequence of identifiers,
    -- along with a bunch of supporting information. A path (module::module::...::Type), optionally "qualified",
    -- e.g., <Vec<T> as SomeTrait>::SomeType.
    deriving (TypeAst -> TypeAst -> Bool
(TypeAst -> TypeAst -> Bool)
-> (TypeAst -> TypeAst -> Bool) -> Eq TypeAst
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: TypeAst -> TypeAst -> Bool
== :: TypeAst -> TypeAst -> Bool
$c/= :: TypeAst -> TypeAst -> Bool
/= :: TypeAst -> TypeAst -> Bool
Eq, Eq TypeAst
Eq TypeAst =>
(TypeAst -> TypeAst -> Ordering)
-> (TypeAst -> TypeAst -> Bool)
-> (TypeAst -> TypeAst -> Bool)
-> (TypeAst -> TypeAst -> Bool)
-> (TypeAst -> TypeAst -> Bool)
-> (TypeAst -> TypeAst -> TypeAst)
-> (TypeAst -> TypeAst -> TypeAst)
-> Ord TypeAst
TypeAst -> TypeAst -> Bool
TypeAst -> TypeAst -> Ordering
TypeAst -> TypeAst -> TypeAst
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 :: TypeAst -> TypeAst -> Ordering
compare :: TypeAst -> TypeAst -> Ordering
$c< :: TypeAst -> TypeAst -> Bool
< :: TypeAst -> TypeAst -> Bool
$c<= :: TypeAst -> TypeAst -> Bool
<= :: TypeAst -> TypeAst -> Bool
$c> :: TypeAst -> TypeAst -> Bool
> :: TypeAst -> TypeAst -> Bool
$c>= :: TypeAst -> TypeAst -> Bool
>= :: TypeAst -> TypeAst -> Bool
$cmax :: TypeAst -> TypeAst -> TypeAst
max :: TypeAst -> TypeAst -> TypeAst
$cmin :: TypeAst -> TypeAst -> TypeAst
min :: TypeAst -> TypeAst -> TypeAst
Ord, ReadPrec [TypeAst]
ReadPrec TypeAst
Int -> ReadS TypeAst
ReadS [TypeAst]
(Int -> ReadS TypeAst)
-> ReadS [TypeAst]
-> ReadPrec TypeAst
-> ReadPrec [TypeAst]
-> Read TypeAst
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
$creadsPrec :: Int -> ReadS TypeAst
readsPrec :: Int -> ReadS TypeAst
$creadList :: ReadS [TypeAst]
readList :: ReadS [TypeAst]
$creadPrec :: ReadPrec TypeAst
readPrec :: ReadPrec TypeAst
$creadListPrec :: ReadPrec [TypeAst]
readListPrec :: ReadPrec [TypeAst]
Read, Int -> TypeAst -> ShowS
[TypeAst] -> ShowS
TypeAst -> String
(Int -> TypeAst -> ShowS)
-> (TypeAst -> String) -> ([TypeAst] -> ShowS) -> Show TypeAst
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> TypeAst -> ShowS
showsPrec :: Int -> TypeAst -> ShowS
$cshow :: TypeAst -> String
show :: TypeAst -> String
$cshowList :: [TypeAst] -> ShowS
showList :: [TypeAst] -> ShowS
Show)