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

{-# OPTIONS_GHC -Wno-redundant-constraints #-}

-- | Contract that call on-chain views and keep the result in storage.
--
-- This is like 'Test.Clevelad.Lorentz.Consumer.contractConsumer', but it is
-- _active_ - you call it, not the contract containing the view, in order to
-- access the view.
--
-- TODO [#708]: mention that calling views directly should be preferred.
module Test.Cleveland.Lorentz.Requester
  ( contractRequester
  ) where

import Lorentz
import Prelude hiding (swap, view)

import Morley.Util.TypeLits
import Test.Cleveland.Lorentz.Types

-- | Allows calling a view multiple times, remembering results in
-- last-goes-first order.
--
-- > contractRequester @"viewName" contractWithView
contractRequester
  :: forall name arg ret vd cp st.
     ( NiceParameterFull cp, NiceStorage cp
     , NiceParameterFull arg, NiceStorageFull [ret]
     , NiceViewable arg, NiceViewable ret, HasView vd name arg ret
     , Typeable vd, KnownSymbol name
     )
  => ContractHandle cp st vd -> Contract arg [ret] ()
contractRequester :: ContractHandle cp st vd -> Contract arg [ret] ()
contractRequester ContractHandle cp st vd
target = ContractCode arg [ret] -> Contract arg [ret] ()
forall cp st.
(NiceParameterFull cp, NiceStorageFull st) =>
ContractCode cp st -> Contract cp st ()
defaultContract (ContractCode arg [ret] -> Contract arg [ret] ())
-> ContractCode arg [ret] -> Contract arg [ret] ()
forall a b. (a -> b) -> a -> b
$
  '[(arg, [ret])] :-> '[arg, [ret]]
forall a b (s :: [*]). ((a, b) : s) :-> (a : b : s)
unpair ('[(arg, [ret])] :-> '[arg, [ret]])
-> ('[arg, [ret]] :-> '[TAddress cp vd, arg, [ret]])
-> '[(arg, [ret])] :-> '[TAddress cp vd, arg, [ret]]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  TAddress cp vd -> '[arg, [ret]] :-> '[TAddress cp vd, arg, [ret]]
forall t (s :: [*]). NiceConstant t => t -> s :-> (t : s)
push (ContractHandle cp st vd -> TAddress cp vd
forall cp vd a. ToTAddress cp vd a => a -> TAddress cp vd
toTAddress ContractHandle cp st vd
target) ('[(arg, [ret])] :-> '[TAddress cp vd, arg, [ret]])
-> ('[TAddress cp vd, arg, [ret]]
    :-> '[arg, TAddress cp vd, [ret]])
-> '[(arg, [ret])] :-> '[arg, TAddress cp vd, [ret]]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[TAddress cp vd, arg, [ret]] :-> '[arg, TAddress cp vd, [ret]]
forall a b (s :: [*]). (a : b : s) :-> (b : a : s)
swap ('[(arg, [ret])] :-> '[arg, TAddress cp vd, [ret]])
-> ('[arg, TAddress cp vd, [ret]] :-> '[ret, [ret]])
-> '[(arg, [ret])] :-> '[ret, [ret]]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# forall arg ret p vd (s :: [*]).
(HasCallStack, KnownSymbol name, KnownValue arg, NiceViewable ret,
 HasView vd name arg ret) =>
(arg : TAddress p vd : s) :-> (ret : s)
forall (name :: Symbol) arg ret p vd (s :: [*]).
(HasCallStack, KnownSymbol name, KnownValue arg, NiceViewable ret,
 HasView vd name arg ret) =>
(arg : TAddress p vd : s) :-> (ret : s)
view @name ('[(arg, [ret])] :-> '[ret, [ret]])
-> ('[ret, [ret]] :-> '[[ret]]) -> '[(arg, [ret])] :-> '[[ret]]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[ret, [ret]] :-> '[[ret]]
forall a (s :: [*]). (a : List a : s) :-> (List a : s)
cons ('[(arg, [ret])] :-> '[[ret]])
-> ('[[ret]] :-> '[List Operation, [ret]])
-> '[(arg, [ret])] :-> '[List Operation, [ret]]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
#
  '[[ret]] :-> '[List Operation, [ret]]
forall p (s :: [*]). KnownValue p => s :-> (List p : s)
nil ('[(arg, [ret])] :-> '[List Operation, [ret]])
-> ('[List Operation, [ret]] :-> '[(List Operation, [ret])])
-> ContractCode arg [ret]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[List Operation, [ret]] :-> '[(List Operation, [ret])]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair