Show.hs

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

-- | Tests of `Show` and `RenderDoc` instances of Michelson types.
module Test.Michelson.Show
  ( unit_AnnTagsShow
  , unit_AnnTagsRenderDoc
  , unit_AnnotationSetShow
  , unit_AnnotationSetRenderDoc
  , unit_NotesShow
  , unit_NotesRenderDoc
  , unit_InstrAbstractShow
  , unit_InstrAbstractRenderDoc
  ) where

import Debug qualified (show)

import Test.HUnit (Assertion, assertEqual)

import Morley.Michelson.Printer.Util (RenderDoc(..), doesntNeedParens, printDoc)
import Morley.Michelson.Typed (Notes(..), T(..))
import Morley.Michelson.Untyped qualified as U

render :: RenderDoc a => a -> LText
render = printDoc True . renderDoc doesntNeedParens

-- * Annotation

typeAnn :: U.TypeAnn
typeAnn = U.UnsafeAnnotation @U.TypeTag "type"

fieldAnn :: U.FieldAnn
fieldAnn = U.UnsafeAnnotation @U.FieldTag "field"

varAnn :: U.VarAnn
varAnn = U.UnsafeAnnotation @U.VarTag "var"

unit_AnnTagsShow :: Assertion
unit_AnnTagsShow =
  zipWithM_ (assertEqual @Text "Annotations' `show` produces type tags")
    [Debug.show typeAnn, Debug.show fieldAnn, Debug.show varAnn]
    [ "UnsafeAnnotation @TypeTag \"type\""
    , "UnsafeAnnotation @FieldTag \"field\""
    , "UnsafeAnnotation @VarTag \"var\""
    ]

unit_AnnTagsRenderDoc :: Assertion
unit_AnnTagsRenderDoc =
  zipWithM_ (assertEqual "Annotations' `renderDoc` produces Michelson annotations")
    [render typeAnn, render fieldAnn, render varAnn]
    [":type", "%field", "@var"]

-- * AnnotationSet

annSet :: U.AnnotationSet
annSet = U.AnnotationSet [typeAnn] [fieldAnn] [varAnn]

unit_AnnotationSetShow :: Assertion
unit_AnnotationSetShow =
  assertEqual @Text "AnnotationSet's `show` is stock"
    (Debug.show annSet)
    "AnnotationSet {asTypes = [UnsafeAnnotation @TypeTag \"type\"], asFields = [UnsafeAnnotation @FieldTag \"field\"], asVars = [UnsafeAnnotation @VarTag \"var\"]}"

unit_AnnotationSetRenderDoc :: Assertion
unit_AnnotationSetRenderDoc =
  assertEqual "AnnotationSet's `renderDoc` produces a list of annotations"
    (render annSet)
    ":type %field @var"

-- * Notes

pair :: Notes ('TPair 'TUnit 'TUnit)
pair = NTPair typeAnn fieldAnn U.noAnn varAnn U.noAnn (NTUnit U.noAnn) (NTUnit U.noAnn)

unit_NotesShow :: Assertion
unit_NotesShow =
  assertEqual @Text "Notes' `show` is stock"
    (Debug.show pair)
    "NTPair (UnsafeAnnotation @TypeTag \"type\") (UnsafeAnnotation @FieldTag \"field\") (UnsafeAnnotation @FieldTag \"\") (UnsafeAnnotation @VarTag \"var\") (UnsafeAnnotation @VarTag \"\") (NTUnit (UnsafeAnnotation @TypeTag \"\")) (NTUnit (UnsafeAnnotation @TypeTag \"\"))"

unit_NotesRenderDoc :: Assertion
unit_NotesRenderDoc =
  assertEqual "Notes' `renderDoc` produces a Michelson annotated type"
    (render pair)
    "pair :type (unit %field @var) unit"

-- * InstrAbstract

instr :: U.InstrAbstract U.ExpandedOp
instr = U.PAIR typeAnn varAnn fieldAnn U.noAnn

unit_InstrAbstractShow :: Assertion
unit_InstrAbstractShow =
  assertEqual @Text "InstrAbstract's `show` is stock"
    (Debug.show instr)
    "PAIR (UnsafeAnnotation @TypeTag \"type\") (UnsafeAnnotation @VarTag \"var\") (UnsafeAnnotation @FieldTag \"field\") (UnsafeAnnotation @FieldTag \"\")"

unit_InstrAbstractRenderDoc :: Assertion
unit_InstrAbstractRenderDoc =
  assertEqual "InstrAbstract's `renderDoc` produces an annotated Michelson instruction"
    (render instr)
    "PAIR :type %field @var"