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

-- 'newtype Container' deriving produced some fake warnings
{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Module, containing on-chain views declarations.
module Morley.Michelson.Typed.View
  ( -- * View
    ViewName (ViewName, ..)
  , BadViewNameError (..)
  , mkViewName
  , viewNameToMText

  , ViewCode'
  , View' (..)
  , SomeView' (..)
  , someViewName

    -- * Views set
  , ViewsSet' (.., ViewsList)
  , VS.ViewsSetError (..)
  , mkViewsSet
  , emptyViewsSet
  , addViewToSet
  , lookupView
  , viewsSetNames
  , SomeViewsSet' (..)
  ) where

import Data.Coerce (coerce)
import Data.Default (Default(..))

import Morley.Michelson.Internal.ViewName
import Morley.Michelson.Internal.ViewsSet qualified as VS
import Morley.Michelson.Typed.Annotation
import Morley.Michelson.Typed.Scope
import Morley.Michelson.Typed.T (T(..))
import Morley.Util.Sing

type ViewCode' instr arg st ret = instr '[ 'TPair arg st] '[ret]

-- | Contract view.
data View' instr arg st ret = (ViewableScope arg, SingI st, ViewableScope ret) => View
  { vName :: ViewName
    -- ^ Name of the view.
  , vArgument :: Notes arg
    -- ^ Argument type annotations.
  , vReturn :: Notes ret
    -- ^ Return type annotations.
  , vCode :: ViewCode' instr arg st ret
    -- ^ View code.
  }

deriving stock instance Show (ViewCode' instr arg st ret) => Show (View' instr arg st ret)
deriving stock instance Eq (ViewCode' instr arg st ret) => Eq (View' instr arg st ret)
instance NFData (ViewCode' instr arg st ret) => NFData (View' instr arg st ret) where
  rnf (View a b c d) = rnf (a, b, c, d)

data SomeView' instr st where
  SomeView :: View' instr arg st ret -> SomeView' instr st

deriving stock instance
  (forall arg ret. Show (ViewCode' instr arg st ret)) =>
  Show (SomeView' instr st)
instance
  (forall arg ret. Eq (ViewCode' instr arg st ret)) =>
  Eq (SomeView' instr st) where
    SomeView v1@View{} == SomeView v2@View{} = v1 `eqParamSing3` v2
instance
  (forall arg ret. NFData (ViewCode' instr arg st ret)) =>
  NFData (SomeView' instr st) where
    rnf (SomeView v) = rnf v

-- | Obtain the name of the view.
someViewName :: SomeView' instr st -> ViewName
someViewName (SomeView v) = vName v

-- View sets
----------------------------------------------------------------------------

-- | Views that belong to one contract.
newtype ViewsSet' instr st = ViewsSet { unViewsSet :: Map ViewName (SomeView' instr st) }
  deriving newtype (Default, Container)

deriving stock instance
  (forall i o. Show (instr i o)) =>
  Show (ViewsSet' instr st)
deriving stock instance
  (forall i o. Eq (instr i o)) =>
  Eq (ViewsSet' instr st)
instance
  (forall i o. NFData (instr i o)) =>
  NFData (ViewsSet' instr st) where
    rnf (ViewsSet vs) = rnf vs

pattern ViewsList :: [SomeView' instr st] -> ViewsSet' instr st
pattern ViewsList views <- ViewsSet (toList -> views)
{-# COMPLETE ViewsList #-}

-- | Construct views set.
mkViewsSet :: [SomeView' instr st] -> Either VS.ViewsSetError (ViewsSet' instr st)
mkViewsSet = coerce ... VS.mkViewsSet someViewName

-- | No views.
emptyViewsSet :: forall instr st. ViewsSet' instr st
emptyViewsSet = coerce $ VS.emptyViewsSet @(SomeView' instr st)

-- | Add a view to set.
addViewToSet
  :: View' instr arg st ret
  -> ViewsSet' instr st
  -> Either VS.ViewsSetError (ViewsSet' instr st)
addViewToSet = coerce . VS.addViewToSet someViewName . SomeView

-- | Find a view in the set.
lookupView :: forall instr st. ViewName -> ViewsSet' instr st -> Maybe (SomeView' instr st)
lookupView = coerce . VS.lookupView @(SomeView' instr st)

-- | Get all taken names in views set.
viewsSetNames :: forall instr st. ViewsSet' instr st -> Set ViewName
viewsSetNames = VS.viewsSetNames @(SomeView' instr st) . coerce

data SomeViewsSet' instr where
  SomeViewsSet :: SingI st => ViewsSet' instr st -> SomeViewsSet' instr

deriving stock instance
  (forall i o. Show (instr i o)) =>
  Show (SomeViewsSet' instr)
instance
  (forall i o. Eq (instr i o)) =>
  Eq (SomeViewsSet' instr) where
    SomeViewsSet vs1 == SomeViewsSet vs2 = eqParamSing vs1 vs2
instance
  (forall i o. NFData (instr i o)) =>
  NFData (SomeViewsSet' instr) where
    rnf (SomeViewsSet vs) = rnf vs