-- SPDX-FileCopyrightText: 2020 Tocqueville Group
--
-- SPDX-License-Identifier: LicenseRef-MIT-TQ

-- | 'SomeIndigoState' existential and utilities to work with it.
module Indigo.Common.SIS
  ( SomeIndigoState (..)
  , SomeGenCode (..)
  , toSIS
  , runSIS
  , thenSIS
  , overSIS
  ) where

import Indigo.Prelude

import Indigo.Common.State

-- | 'GenCode' with hidden output stack
data SomeGenCode inp where
  SomeGenCode :: GenCode inp out -> SomeGenCode inp

-- | 'IndigoState' with hidden output stack,
-- necessary to generate typed Lorentz code from untyped Indigo frontend.
newtype SomeIndigoState inp = SomeIndigoState
  { forall (inp :: [*]).
SomeIndigoState inp -> MetaData inp -> SomeGenCode inp
unSIS :: MetaData inp -> SomeGenCode inp
  }

-- | To run 'SomeIndigoState' you need to pass an handler of 'GenCode' with any
-- output stack and initial 'MetaData'.
runSIS :: SomeIndigoState inp -> MetaData inp -> (forall out . GenCode inp out -> r) -> r
runSIS :: forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS (SomeIndigoState MetaData inp -> SomeGenCode inp
act) MetaData inp
md forall (out :: [*]). GenCode inp out -> r
f = case MetaData inp -> SomeGenCode inp
act MetaData inp
md of
  SomeGenCode GenCode inp out
gc -> GenCode inp out -> r
forall (out :: [*]). GenCode inp out -> r
f GenCode inp out
gc

-- | Convert 'IndigoState' to 'SomeIndigoState'
toSIS :: IndigoState inp out -> SomeIndigoState inp
toSIS :: forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> SomeIndigoState inp
toSIS IndigoState inp out
is = (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall (inp :: [*]).
(MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
SomeIndigoState ((MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp)
-> (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md -> GenCode inp out -> SomeGenCode inp
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (GenCode inp out -> SomeGenCode inp)
-> GenCode inp out -> SomeGenCode inp
forall a b. (a -> b) -> a -> b
$ IndigoState inp out -> MetaData inp -> GenCode inp out
forall (inp :: [*]) (out :: [*]).
IndigoState inp out -> MetaData inp -> GenCode inp out
runIndigoState IndigoState inp out
is MetaData inp
md

-- | Similar to a @>>@ for 'SomeIndigoState'.
thenSIS :: SomeIndigoState inp -> (forall out . SomeIndigoState out) -> SomeIndigoState inp
thenSIS :: forall (inp :: [*]).
SomeIndigoState inp
-> (forall (out :: [*]). SomeIndigoState out)
-> SomeIndigoState inp
thenSIS SomeIndigoState inp
m forall (out :: [*]). SomeIndigoState out
f = (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall (inp :: [*]).
(MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
SomeIndigoState ((MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp)
-> (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md ->
  case SomeIndigoState inp -> MetaData inp -> SomeGenCode inp
forall (inp :: [*]).
SomeIndigoState inp -> MetaData inp -> SomeGenCode inp
unSIS SomeIndigoState inp
m MetaData inp
md of
    (SomeGenCode (GenCode StackVars out
st1 inp :-> out
cd1 out :-> inp
cl1 :: GenCode inp out)) ->
      case SomeIndigoState out -> MetaData out -> SomeGenCode out
forall (inp :: [*]).
SomeIndigoState inp -> MetaData inp -> SomeGenCode inp
unSIS (forall (out :: [*]). SomeIndigoState out
f @out) (MetaData inp -> StackVars out -> MetaData out
forall (inp :: [*]) (inp1 :: [*]).
MetaData inp -> StackVars inp1 -> MetaData inp1
replStkMd MetaData inp
md StackVars out
st1) of
        SomeGenCode (GenCode StackVars out
st2 out :-> out
cd2 out :-> out
cl2) ->
          GenCode inp out -> SomeGenCode inp
forall (inp :: [*]) (out :: [*]).
GenCode inp out -> SomeGenCode inp
SomeGenCode (StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
forall (inp :: [*]) (out :: [*]).
StackVars out -> (inp :-> out) -> (out :-> inp) -> GenCode inp out
GenCode StackVars out
st2 (inp :-> out
cd1 (inp :-> out) -> (out :-> out) -> inp :-> out
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
## out :-> out
cd2) (out :-> out
cl2 (out :-> out) -> (out :-> inp) -> out :-> inp
forall (a :: [*]) (b :: [*]) (c :: [*]).
(a :-> b) -> (b :-> c) -> a :-> c
## out :-> inp
cl1))

-- | Modify the 'GenCode' inside a 'SomeIndigoState' by passing an handler of
-- 'GenCode' that returns a 'SomeGenCode'.
-- Useful in some cases to "wrap" or update and exising 'SomeGenCode'.
overSIS
  :: (forall out. GenCode inp out -> SomeGenCode inp)
  -> SomeIndigoState inp
  -> SomeIndigoState inp
overSIS :: forall (inp :: [*]).
(forall (out :: [*]). GenCode inp out -> SomeGenCode inp)
-> SomeIndigoState inp -> SomeIndigoState inp
overSIS forall (out :: [*]). GenCode inp out -> SomeGenCode inp
f SomeIndigoState inp
si = (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall (inp :: [*]).
(MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
SomeIndigoState ((MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp)
-> (MetaData inp -> SomeGenCode inp) -> SomeIndigoState inp
forall a b. (a -> b) -> a -> b
$ \MetaData inp
md -> SomeIndigoState inp
-> MetaData inp
-> (forall (out :: [*]). GenCode inp out -> SomeGenCode inp)
-> SomeGenCode inp
forall (inp :: [*]) r.
SomeIndigoState inp
-> MetaData inp -> (forall (out :: [*]). GenCode inp out -> r) -> r
runSIS SomeIndigoState inp
si MetaData inp
md forall (out :: [*]). GenCode inp out -> SomeGenCode inp
f