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

module Indigo.Internal.SIS
  ( SomeIndigoState (..)
  , SomeGenCode (..)
  , returnSIS
  , bindSIS
  , toSIS
  , runSIS
  , withSIS
  , withSIS1
  , withSIS2
  ) where


import Indigo.Lorentz
import Indigo.Prelude

import Indigo.Internal.State
import Indigo.Internal.Object
import qualified Lorentz.Instr as L

-- | Gen code with hidden output stack
data SomeGenCode inp a where
  SomeGenCode :: GenCode inp out a -> SomeGenCode inp a

deriving stock instance Functor (SomeGenCode inp)

-- | 'IndigoState' with hidden output stack,
-- necessary to generate typed Lorentz code from untyped Indigo frontend.
newtype SomeIndigoState inp a = SomeIndigoState {SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS :: MetaData inp -> SomeGenCode inp a}
  deriving stock a -> SomeIndigoState inp b -> SomeIndigoState inp a
(a -> b) -> SomeIndigoState inp a -> SomeIndigoState inp b
(forall a b.
 (a -> b) -> SomeIndigoState inp a -> SomeIndigoState inp b)
-> (forall a b.
    a -> SomeIndigoState inp b -> SomeIndigoState inp a)
-> Functor (SomeIndigoState inp)
forall (inp :: [*]) a b.
a -> SomeIndigoState inp b -> SomeIndigoState inp a
forall (inp :: [*]) a b.
(a -> b) -> SomeIndigoState inp a -> SomeIndigoState inp b
forall a b. a -> SomeIndigoState inp b -> SomeIndigoState inp a
forall a b.
(a -> b) -> SomeIndigoState inp a -> SomeIndigoState inp b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: a -> SomeIndigoState inp b -> SomeIndigoState inp a
$c<$ :: forall (inp :: [*]) a b.
a -> SomeIndigoState inp b -> SomeIndigoState inp a
fmap :: (a -> b) -> SomeIndigoState inp a -> SomeIndigoState inp b
$cfmap :: forall (inp :: [*]) a b.
(a -> b) -> SomeIndigoState inp a -> SomeIndigoState inp b
Functor

-- | 'return' for 'SomeIndigoState'
returnSIS :: a -> SomeIndigoState inp a
returnSIS :: a -> SomeIndigoState inp a
returnSIS a :: a
a = (MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
forall (inp :: [*]) a.
(MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
SomeIndigoState ((MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a)
-> (MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md -> GenCode inp inp a -> SomeGenCode inp a
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> SomeGenCode inp a
SomeGenCode (GenCode inp inp a -> SomeGenCode inp a)
-> GenCode inp inp a -> SomeGenCode inp a
forall a b. (a -> b) -> a -> b
$ a
-> MetaData inp
-> (inp :-> inp)
-> (inp :-> inp)
-> GenCode inp inp a
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode a
a MetaData inp
md inp :-> inp
forall (s :: [*]). s :-> s
L.nop inp :-> inp
forall (s :: [*]). s :-> s
L.nop

-- | Like bind, but the input type of the second parameter is determined by the
-- output of the first one.
bindSIS :: SomeIndigoState inp a -> (forall someOut . a -> SomeIndigoState someOut b) -> SomeIndigoState inp b
bindSIS :: SomeIndigoState inp a
-> (forall (someOut :: [*]). a -> SomeIndigoState someOut b)
-> SomeIndigoState inp b
bindSIS m :: SomeIndigoState inp a
m f :: forall (someOut :: [*]). a -> SomeIndigoState someOut b
f = (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall (inp :: [*]) a.
(MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
SomeIndigoState ((MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b)
-> (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  case SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS SomeIndigoState inp a
m MetaData inp
md of
    (SomeGenCode (GenCode a :: a
a md1 :: MetaData out
md1 cd1 :: inp :-> out
cd1 cl1 :: out :-> inp
cl1 :: GenCode inp out a)) ->
      case SomeIndigoState out b -> MetaData out -> SomeGenCode out b
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS (a -> SomeIndigoState out b
forall (someOut :: [*]). a -> SomeIndigoState someOut b
f @out a
a) MetaData out
md1 of
        SomeGenCode (GenCode b :: b
b md2 :: MetaData out
md2 cd2 :: out :-> out
cd2 cl2 :: out :-> out
cl2) -> GenCode inp out b -> SomeGenCode inp b
forall (inp :: [*]) (out :: [*]) a.
GenCode inp out a -> SomeGenCode inp a
SomeGenCode (b
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out b
forall (inp :: [*]) (out :: [*]) a.
a
-> MetaData out
-> (inp :-> out)
-> (out :-> inp)
-> GenCode inp out a
GenCode b
b MetaData out
md2 (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))

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

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

-- | Call an action with 'IndigoState' stored in 'SomeIndigoState'.
--
-- This function is kinda dummy because it passes
-- IndigoState to the function which produces a GenCode independently
-- on passed MetaData to it. It has to be used with only functions
-- which pass MetaData in the same way.
-- This function is needed to pass SomeIndigoState in contravariant positions
-- of statements like @if@, @case@, @while@, @forEach@, etc.
-- Alternative solution would be abstracting out IndigoState and SomeIndigoState
-- with typeclass
-- class CodeGenerator m where
--   runCodeGen :: m inp a -> MetaData inp -> (forall out . GenCode inp out a -> r) -> r
-- and passing CodeGenerator m in contravariant positions instead of IndigoState.
withSIS
  :: SomeIndigoState inp a
  -> (forall out . IndigoState inp out a -> SomeIndigoState inp b)
  -> SomeIndigoState inp b
withSIS :: SomeIndigoState inp a
-> (forall (out :: [*]).
    IndigoState inp out a -> SomeIndigoState inp b)
-> SomeIndigoState inp b
withSIS (SomeIndigoState act :: MetaData inp -> SomeGenCode inp a
act) f :: forall (out :: [*]). IndigoState inp out a -> SomeIndigoState inp b
f = (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall (inp :: [*]) a.
(MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
SomeIndigoState ((MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b)
-> (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  case MetaData inp -> SomeGenCode inp a
act MetaData inp
md of
    SomeGenCode gc :: GenCode inp out a
gc -> SomeIndigoState inp b -> MetaData inp -> SomeGenCode inp b
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS (IndigoState inp out a -> SomeIndigoState inp b
forall (out :: [*]). IndigoState inp out a -> SomeIndigoState inp b
f ((MetaData inp -> GenCode inp out a) -> IndigoState inp out a
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData inp -> GenCode inp out a) -> IndigoState inp out a)
-> (MetaData inp -> GenCode inp out a) -> IndigoState inp out a
forall a b. (a -> b) -> a -> b
$ \_ -> GenCode inp out a
gc)) MetaData inp
md

-- | The same as 'withSIS' but converting a function with one argument, also dummy.
withSIS1
  :: KnownValue x
  => (Var x -> SomeIndigoState (x & inp) a)
  -> (forall out . (Var x -> IndigoState (x & inp) out a) -> SomeIndigoState inp b)
  -> SomeIndigoState inp b
withSIS1 :: (Var x -> SomeIndigoState (x & inp) a)
-> (forall (out :: [*]).
    (Var x -> IndigoState (x & inp) out a) -> SomeIndigoState inp b)
-> SomeIndigoState inp b
withSIS1 act :: Var x -> SomeIndigoState (x & inp) a
act f :: forall (out :: [*]).
(Var x -> IndigoState (x & inp) out a) -> SomeIndigoState inp b
f = (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall (inp :: [*]) a.
(MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
SomeIndigoState ((MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b)
-> (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
  let (var :: Var x
var, newMd :: MetaData (x & inp)
newMd) = MetaData inp -> (Var x, MetaData (x & inp))
forall x (stk :: [*]).
KnownValue x =>
MetaData stk -> (Var x, MetaData (x & stk))
pushRefMd MetaData inp
md in
  case SomeIndigoState (x & inp) a
-> MetaData (x & inp) -> SomeGenCode (x & inp) a
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS (Var x -> SomeIndigoState (x & inp) a
act Var x
var) MetaData (x & inp)
newMd of
    SomeGenCode gc :: GenCode (x & inp) out a
gc -> SomeIndigoState inp b -> MetaData inp -> SomeGenCode inp b
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS ((Var x -> IndigoState (x & inp) out a) -> SomeIndigoState inp b
forall (out :: [*]).
(Var x -> IndigoState (x & inp) out a) -> SomeIndigoState inp b
f (\_v :: Var x
_v -> (MetaData (x & inp) -> GenCode (x & inp) out a)
-> IndigoState (x & inp) out a
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData (x & inp) -> GenCode (x & inp) out a)
 -> IndigoState (x & inp) out a)
-> (MetaData (x & inp) -> GenCode (x & inp) out a)
-> IndigoState (x & inp) out a
forall a b. (a -> b) -> a -> b
$ \_md :: MetaData (x & inp)
_md -> GenCode (x & inp) out a
gc)) MetaData inp
md

-- | The same as 'withSIS1' but converting a function with 2 arguments, also dummy.
withSIS2
  :: (KnownValue x, KnownValue y)
  => (Var x -> Var y -> SomeIndigoState (x & y & inp) a)
  -> (forall out . (Var x -> Var y -> IndigoState (x & y & inp) out a) -> SomeIndigoState inp b)
  -> SomeIndigoState inp b
withSIS2 :: (Var x -> Var y -> SomeIndigoState (x & (y & inp)) a)
-> (forall (out :: [*]).
    (Var x -> Var y -> IndigoState (x & (y & inp)) out a)
    -> SomeIndigoState inp b)
-> SomeIndigoState inp b
withSIS2 act :: Var x -> Var y -> SomeIndigoState (x & (y & inp)) a
act f :: forall (out :: [*]).
(Var x -> Var y -> IndigoState (x & (y & inp)) out a)
-> SomeIndigoState inp b
f = (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall (inp :: [*]) a.
(MetaData inp -> SomeGenCode inp a) -> SomeIndigoState inp a
SomeIndigoState ((MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b)
-> (MetaData inp -> SomeGenCode inp b) -> SomeIndigoState inp b
forall a b. (a -> b) -> a -> b
$ \md :: MetaData inp
md ->
   let (var1 :: Var y
var1, newMd1 :: MetaData (y & inp)
newMd1) = MetaData inp -> (Var y, MetaData (y & inp))
forall x (stk :: [*]).
KnownValue x =>
MetaData stk -> (Var x, MetaData (x & stk))
pushRefMd MetaData inp
md in
   let (var2 :: Var x
var2, newMd2 :: MetaData (x & (y & inp))
newMd2) = MetaData (y & inp) -> (Var x, MetaData (x & (y & inp)))
forall x (stk :: [*]).
KnownValue x =>
MetaData stk -> (Var x, MetaData (x & stk))
pushRefMd MetaData (y & inp)
newMd1 in
  case SomeIndigoState (x & (y & inp)) a
-> MetaData (x & (y & inp)) -> SomeGenCode (x & (y & inp)) a
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS (Var x -> Var y -> SomeIndigoState (x & (y & inp)) a
act Var x
var2 Var y
var1) MetaData (x & (y & inp))
newMd2 of
    SomeGenCode gc :: GenCode (x & (y & inp)) out a
gc -> SomeIndigoState inp b -> MetaData inp -> SomeGenCode inp b
forall (inp :: [*]) a.
SomeIndigoState inp a -> MetaData inp -> SomeGenCode inp a
unSIS ((Var x -> Var y -> IndigoState (x & (y & inp)) out a)
-> SomeIndigoState inp b
forall (out :: [*]).
(Var x -> Var y -> IndigoState (x & (y & inp)) out a)
-> SomeIndigoState inp b
f (\_v :: Var x
_v _w :: Var y
_w -> (MetaData (x & (y & inp)) -> GenCode (x & (y & inp)) out a)
-> IndigoState (x & (y & inp)) out a
forall (inp :: [*]) (out :: [*]) a.
(MetaData inp -> GenCode inp out a) -> IndigoState inp out a
IndigoState ((MetaData (x & (y & inp)) -> GenCode (x & (y & inp)) out a)
 -> IndigoState (x & (y & inp)) out a)
-> (MetaData (x & (y & inp)) -> GenCode (x & (y & inp)) out a)
-> IndigoState (x & (y & inp)) out a
forall a b. (a -> b) -> a -> b
$ \_md :: MetaData (x & (y & inp))
_md -> GenCode (x & (y & inp)) out a
gc)) MetaData inp
md