{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      :  Network.Polkadot.Metadata.Type.Parser
-- Copyright   :  Aleksandr Krupenkin 2016-2024
-- License     :  Apache-2.0
--
-- Maintainer  :  mail@akru.me
-- Stability   :  experimental
-- Portability :  portable
--
-- This module parse and cleanup raw types given from runtime,
-- drop traits, generics, etc.
--

module Network.Polkadot.Metadata.Type.Parser
  ( fromText
  , fromTextM
  , toText
  , sanitize
  , sanitizeM
  ) where

import           Control.Monad.Fail                               (MonadFail)
import           Data.Text                                        (Text,
                                                                   intercalate,
                                                                   pack,
                                                                   replace,
                                                                   strip)
import           Text.Parsec                                      (ParseError,
                                                                   parse)

import           Network.Polkadot.Metadata.Type.Ast
import           Network.Polkadot.Metadata.Type.ParserCombinators (type')

allowed_boxes :: [Text]
allowed_boxes :: [Text]
allowed_boxes =
  [ Text
"BTreeMap"
  , Text
"BTreeSet"
  , Text
"Compact"
  , Text
"DoNotConstruct"
  , Text
"HashMap"
  , Text
"Int"
  , Text
"Linkage"
  , Text
"Result"
  , Text
"Option"
  , Text
"UInt"
  , Text
"Vec"
  ]

render_box :: Text -> Maybe [TypeAst] -> Text
render_box :: Text -> Maybe [TypeAst] -> Text
render_box Text
name Maybe [TypeAst]
Nothing = Text
name
render_box Text
name (Just [TypeAst]
args)
  | (Text -> Bool) -> [Text] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
name) [Text]
allowed_boxes = Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (TypeAst -> Text
toText (TypeAst -> Text) -> [TypeAst] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeAst]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
  | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"BoundedVec" = Text
"Vec<" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (TypeAst -> Text
toText (TypeAst -> Text) -> [TypeAst] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeAst]
args) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
">"
  | Text
name Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
"Box" = TypeAst -> Text
toText ([TypeAst] -> TypeAst
forall a. HasCallStack => [a] -> a
head [TypeAst]
args)
  | Bool
otherwise = Text
name

aliases :: Maybe QSelf -> PathSegment -> Text -> Text
aliases :: Maybe QSelf -> PathSegment -> Text -> Text
aliases Maybe QSelf
_ PathSegment
_ Text
"Vec<u8>"            = Text
"Bytes"
aliases Maybe QSelf
_ PathSegment
_ Text
"Announcement"       = Text
"ProxyAnnouncement"
aliases Maybe QSelf
_ PathSegment
_ Text
"Status"             = Text
"BalanceStatus"
aliases (Just (TypeAst
q, TypeAst
_)) PathSegment
_ Text
"Source" = TypeAst -> Text
toText TypeAst
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Source"
aliases (Just (TypeAst
q, TypeAst
_)) PathSegment
_ Text
"Target" = TypeAst -> Text
toText TypeAst
q Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"Target"
aliases Maybe QSelf
_ PathSegment
_ Text
a                    = Text
a

-- | Render Metadata type to text.
--
-- This function strongly sanitize type identifiers and paths,
-- removes generics and other Rust related staff.
toText :: TypeAst -> Text
toText :: TypeAst -> Text
toText (Slice (Path Maybe QSelf
Nothing [(Text
"u8", Maybe [TypeAst]
Nothing)])) = Text
"Bytes"
toText (Slice TypeAst
t) = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeAst -> Text
toText TypeAst
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
toText (Tuple [TypeAst
t]) = TypeAst -> Text
toText TypeAst
t
toText (Tuple [TypeAst]
ts)  = Text
"(" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," (TypeAst -> Text
toText (TypeAst -> Text) -> [TypeAst] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [TypeAst]
ts) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
toText (Array TypeAst
t Int
n) = Text
"[" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> TypeAst -> Text
toText TypeAst
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
";" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
pack (Int -> String
forall a. Show a => a -> String
show Int
n) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
toText (Path Maybe QSelf
_ []) = Text
"()"
toText (Path Maybe QSelf
q [PathSegment]
xs) = Maybe QSelf -> PathSegment -> Text -> Text
aliases Maybe QSelf
q ([PathSegment] -> PathSegment
forall a. HasCallStack => [a] -> a
last [PathSegment]
xs) (Text -> Text) -> Text -> Text
forall a b. (a -> b) -> a -> b
$ Text -> Maybe [TypeAst] -> Text
render_box Text
name Maybe [TypeAst]
args
  where name :: Text
name = PathSegment -> Text
forall a b. (a, b) -> a
fst ([PathSegment] -> PathSegment
forall a. HasCallStack => [a] -> a
last [PathSegment]
xs)
        args :: Maybe [TypeAst]
args = PathSegment -> Maybe [TypeAst]
forall a b. (a, b) -> b
snd ([PathSegment] -> PathSegment
forall a. HasCallStack => [a] -> a
last [PathSegment]
xs)

-- | Parse metadata type (general Rust type) from text.
fromText :: Text -> Either ParseError TypeAst
fromText :: Text -> Either ParseError TypeAst
fromText = Parsec Text () TypeAst
-> String -> Text -> Either ParseError TypeAst
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () TypeAst
forall s. Stream s Identity Char => Parsec s () TypeAst
type' String
"Metadata Type"
         (Text -> Either ParseError TypeAst)
-> (Text -> Text) -> Text -> Either ParseError TypeAst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text
strip
         (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"\n" Text
""
         (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. HasCallStack => Text -> Text -> Text -> Text
Text -> Text -> Text -> Text
replace Text
"\n " Text
""

-- | This variant of `fromText` fails when error happens.
fromTextM :: MonadFail m => Text -> m TypeAst
fromTextM :: forall (m :: * -> *). MonadFail m => Text -> m TypeAst
fromTextM Text
t = (ParseError -> m TypeAst)
-> (TypeAst -> m TypeAst) -> Either ParseError TypeAst -> m TypeAst
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (String -> m TypeAst
forall a. String -> m a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> m TypeAst)
-> (ParseError -> String) -> ParseError -> m TypeAst
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> String
forall a. Show a => a -> String
show Text
t String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
": ") String -> String -> String
forall a. [a] -> [a] -> [a]
++) (String -> String)
-> (ParseError -> String) -> ParseError -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParseError -> String
forall a. Show a => a -> String
show) TypeAst -> m TypeAst
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either ParseError TypeAst -> m TypeAst)
-> Either ParseError TypeAst -> m TypeAst
forall a b. (a -> b) -> a -> b
$ Text -> Either ParseError TypeAst
fromText Text
t

-- | Cleanup type or return error when syntax failure.
sanitize :: Text -> Either ParseError Text
{-# INLINE sanitize #-}
sanitize :: Text -> Either ParseError Text
sanitize = (TypeAst -> Text)
-> Either ParseError TypeAst -> Either ParseError Text
forall a b. (a -> b) -> Either ParseError a -> Either ParseError b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeAst -> Text
toText (Either ParseError TypeAst -> Either ParseError Text)
-> (Text -> Either ParseError TypeAst)
-> Text
-> Either ParseError Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Either ParseError TypeAst
fromText

-- | Cleanup type or throw fail call when syntax failure.
sanitizeM :: MonadFail m => Text -> m Text
{-# INLINE sanitizeM #-}
sanitizeM :: forall (m :: * -> *). MonadFail m => Text -> m Text
sanitizeM = (TypeAst -> Text) -> m TypeAst -> m Text
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap TypeAst -> Text
toText (m TypeAst -> m Text) -> (Text -> m TypeAst) -> Text -> m Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> m TypeAst
forall (m :: * -> *). MonadFail m => Text -> m TypeAst
fromTextM