-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | Module, providing 'T' data type, representing Michelson
-- language types without annotations.
module Michelson.Typed.T
  ( T (..)
  , toUType
  , buildStack
  ) where

import Fmt (Buildable(..), Builder, listF)
import qualified Michelson.Untyped.Annotation as Un
import qualified Michelson.Untyped.Type as Un

-- | Michelson language type with annotations stripped off.
data T =
    TKey
  | TUnit
  | TSignature
  | TChainId
  | TOption T
  | TList T
  | TSet T
  | TOperation
  | TContract T
  | TPair T T
  | TOr T T
  | TLambda T T
  | TMap T T
  | TBigMap T T
  | TInt
  | TNat
  | TString
  | TBytes
  | TMutez
  | TBool
  | TKeyHash
  | TTimestamp
  | TAddress
  deriving stock (T -> T -> Bool
(T -> T -> Bool) -> (T -> T -> Bool) -> Eq T
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: T -> T -> Bool
$c/= :: T -> T -> Bool
== :: T -> T -> Bool
$c== :: T -> T -> Bool
Eq, Int -> T -> ShowS
[T] -> ShowS
T -> String
(Int -> T -> ShowS) -> (T -> String) -> ([T] -> ShowS) -> Show T
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [T] -> ShowS
$cshowList :: [T] -> ShowS
show :: T -> String
$cshow :: T -> String
showsPrec :: Int -> T -> ShowS
$cshowsPrec :: Int -> T -> ShowS
Show, (forall x. T -> Rep T x) -> (forall x. Rep T x -> T) -> Generic T
forall x. Rep T x -> T
forall x. T -> Rep T x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep T x -> T
$cfrom :: forall x. T -> Rep T x
Generic)

instance NFData T

-- | Converts from 'T' to 'Michelson.Type.Type'.
toUType :: T -> Un.Type
toUType :: T -> Type
toUType t :: T
t = T -> TypeAnn -> Type
Un.Type (T -> T
convert T
t) TypeAnn
forall k (a :: k). Annotation a
Un.noAnn
  where
    convert :: T -> Un.T
    convert :: T -> T
convert TInt = T
Un.TInt
    convert TNat = T
Un.TNat
    convert TString = T
Un.TString
    convert TBytes = T
Un.TBytes
    convert TMutez = T
Un.TMutez
    convert TBool = T
Un.TBool
    convert TKeyHash = T
Un.TKeyHash
    convert TTimestamp = T
Un.TTimestamp
    convert TAddress = T
Un.TAddress
    convert TKey = T
Un.TKey
    convert TUnit = T
Un.TUnit
    convert TSignature = T
Un.TSignature
    convert TChainId = T
Un.TChainId
    convert (TOption a :: T
a) = Type -> T
Un.TOption (T -> Type
toUType T
a)
    convert (TList a :: T
a) = Type -> T
Un.TList (T -> Type
toUType T
a)
    convert (TSet a :: T
a) = Type -> T
Un.TSet (Type -> T) -> Type -> T
forall a b. (a -> b) -> a -> b
$ T -> TypeAnn -> Type
Un.Type (Type -> T
Un.unwrapT (Type -> T) -> Type -> T
forall a b. (a -> b) -> a -> b
$ T -> Type
toUType T
a) TypeAnn
forall k (a :: k). Annotation a
Un.noAnn
    convert (T
TOperation) = T
Un.TOperation
    convert (TContract a :: T
a) = Type -> T
Un.TContract (T -> Type
toUType T
a)
    convert (TPair a :: T
a b :: T
b) =
      FieldAnn -> FieldAnn -> Type -> Type -> T
Un.TPair FieldAnn
forall k (a :: k). Annotation a
Un.noAnn FieldAnn
forall k (a :: k). Annotation a
Un.noAnn (T -> Type
toUType T
a) (T -> Type
toUType T
b)
    convert (TOr a :: T
a b :: T
b) =
      FieldAnn -> FieldAnn -> Type -> Type -> T
Un.TOr FieldAnn
forall k (a :: k). Annotation a
Un.noAnn FieldAnn
forall k (a :: k). Annotation a
Un.noAnn (T -> Type
toUType T
a) (T -> Type
toUType T
b)
    convert (TLambda a :: T
a b :: T
b) =
      Type -> Type -> T
Un.TLambda (T -> Type
toUType T
a) (T -> Type
toUType T
b)
    convert (TMap a :: T
a b :: T
b) =
      Type -> Type -> T
Un.TMap (T -> TypeAnn -> Type
Un.Type (Type -> T
Un.unwrapT (Type -> T) -> Type -> T
forall a b. (a -> b) -> a -> b
$ T -> Type
toUType T
a) TypeAnn
forall k (a :: k). Annotation a
Un.noAnn) (T -> Type
toUType T
b)
    convert (TBigMap a :: T
a b :: T
b) =
      Type -> Type -> T
Un.TBigMap (T -> TypeAnn -> Type
Un.Type (Type -> T
Un.unwrapT (Type -> T) -> Type -> T
forall a b. (a -> b) -> a -> b
$ T -> Type
toUType T
a) TypeAnn
forall k (a :: k). Annotation a
Un.noAnn) (T -> Type
toUType T
b)

instance Buildable T where
  build :: T -> Builder
build = Type -> Builder
forall p. Buildable p => p -> Builder
build (Type -> Builder) -> (T -> Type) -> T -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. T -> Type
toUType

-- | Format type stack in a pretty way.
buildStack :: [T] -> Builder
buildStack :: [T] -> Builder
buildStack = [T] -> Builder
forall (f :: * -> *) a. (Foldable f, Buildable a) => f a -> Builder
listF