-- SPDX-FileCopyrightText: 2021 Oxhead Alpha
-- SPDX-License-Identifier: LicenseRef-MIT-OA

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

import Fmt (Buildable(..), Builder, listF)

import Morley.Michelson.Printer.Util (Prettier(..), RenderDoc(..), buildRenderDocExtended)
import Morley.Michelson.Untyped.Annotation qualified as Un
import Morley.Michelson.Untyped.Type qualified as Un
import Morley.Util.MismatchError
import Morley.Util.Peano qualified as Peano

-- | Michelson language type with annotations stripped off.
data T =
    TKey
  | TUnit
  | TSignature
  | TChainId
  | TOption T
  | TList T
  | TSet T
  | TOperation
  | TContract T
  | TTicket T
  | TPair T T
  | TOr T T
  | TLambda T T
  | TMap T T
  | TBigMap T T
  | TInt
  | TNat
  | TString
  | TBytes
  | TMutez
  | TBool
  | TKeyHash
  | TBls12381Fr
  | TBls12381G1
  | TBls12381G2
  | TTimestamp
  | TAddress
  | TChest
  | TChestKey
  | TSaplingState Peano.Peano
  | TSaplingTransaction Peano.Peano
  | TNever
  deriving stock (Eq, Show, Generic)

instance NFData T

-- | Converts from 'T' to 'Un.Ty'.
toUType :: T -> Un.Ty
toUType t = Un.Ty (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 TBls12381Fr = Un.TBls12381Fr
    convert TBls12381G1 = Un.TBls12381G1
    convert TBls12381G2 = Un.TBls12381G2
    convert TUnit = Un.TUnit
    convert TSignature = Un.TSignature
    convert TChainId = Un.TChainId
    convert TChest = Un.TChest
    convert TChestKey = Un.TChestKey
    convert TNever = Un.TNever
    convert (TSaplingState n) = Un.TSaplingState (Peano.toNatural n)
    convert (TSaplingTransaction n) = Un.TSaplingTransaction (Peano.toNatural n)
    convert (TOption a) = Un.TOption (toUType a)
    convert (TList a) = Un.TList (toUType a)
    convert (TSet a) = Un.TSet $ Un.Ty (Un.unwrapT $ toUType a) Un.noAnn
    convert (TOperation) = Un.TOperation
    convert (TContract a) = Un.TContract (toUType a)
    convert (TTicket a) = Un.TTicket (toUType a)
    convert (TPair a b) =
      Un.TPair Un.noAnn Un.noAnn 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.Ty (Un.unwrapT $ toUType a) Un.noAnn) (toUType b)
    convert (TBigMap a b) =
      Un.TBigMap (Un.Ty (Un.unwrapT $ toUType a) Un.noAnn) (toUType b)

instance Buildable T where
  build = build . toUType

instance Buildable (MismatchError T) where
  build = buildRenderDocExtended

instance Buildable (MismatchError [T]) where
  build = buildRenderDocExtended

instance RenderDoc T where
  renderDoc context = renderDoc context . toUType

instance RenderDoc (Prettier T) where
  renderDoc context = renderDoc context . fmap toUType

instance RenderDoc (MismatchError T) where
  renderDoc ctx = renderDocDiff ctx . fmap Prettier

instance RenderDoc (MismatchError [T]) where
  renderDoc ctx = renderDocDiffList ctx . (fmap . fmap) Prettier

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