T.hs

{-# LANGUAGE DataKinds #-}

-- | 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 (Eq, Show, Generic)

instance NFData T

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

instance Buildable T where
  build = build . toUType

-- | Format type stack in a pretty way.
buildStack :: [T] -> Builder
buildStack = listF