{-# LANGUAGE DataKinds #-}

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

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

-- | Michelson language type with annotations stripped off.
data T =
    Tc CT
  | TKey
  | TUnit
  | TSignature
  | TChainId
  | TOption T
  | TList T
  | TSet CT
  | TOperation
  | TContract T
  | TPair T T
  | TOr T T
  | TLambda T T
  | TMap CT T
  | TBigMap CT T
  deriving stock (Eq, Show)

-- | 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 (Tc a) = Un.Tc a
    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.Comparable 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.Comparable a Un.noAnn) (toUType b)
    convert (TBigMap a b) =
      Un.TBigMap (Un.Comparable a Un.noAnn) (toUType b)

instance Buildable T where
  build = build . toUType

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