-- 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.
--
-- Prefer using @callView@ or @unsafeCallView@.
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 :: forall (name :: Symbol) 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
target = (IsNotInView => '[(arg, [ret])] :-> ContractOut [ret])
-> Contract arg [ret] ()
forall cp st.
(NiceParameterFull cp, NiceStorageFull st) =>
(IsNotInView => '[(cp, st)] :-> ContractOut st)
-> Contract cp st ()
defaultContract ((IsNotInView => '[(arg, [ret])] :-> ContractOut [ret])
 -> Contract arg [ret] ())
-> (IsNotInView => '[(arg, [ret])] :-> ContractOut [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 (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]] :-> ContractOut [ret])
-> '[(arg, [ret])] :-> ContractOut [ret]
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
# '[List Operation, [ret]] :-> ContractOut [ret]
forall a b (s :: [*]). (a : b : s) :-> ((a, b) : s)
pair