SIS.hs

-- 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 {unSIS :: MetaData inp -> SomeGenCode inp a}
  deriving stock Functor

-- | 'return' for 'SomeIndigoState'
returnSIS :: a -> SomeIndigoState inp a
returnSIS a = SomeIndigoState $ \md -> SomeGenCode $ GenCode a md L.nop 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 m f = SomeIndigoState $ \md ->
  case unSIS m md of
    (SomeGenCode (GenCode a md1 cd1 cl1 :: GenCode inp out a)) ->
      case unSIS (f @out a) md1 of
        SomeGenCode (GenCode b md2 cd2 cl2) -> SomeGenCode (GenCode b md2 (cd1 ## cd2) (cl2 ## 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 act) md f =
  case act md of
    SomeGenCode gc -> f gc

-- | Convert 'IndigoState' to 'SomeIndigoState'
toSIS :: IndigoState inp out a -> SomeIndigoState inp a
toSIS is = SomeIndigoState $ SomeGenCode <$> runIndigoState 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 act) f = SomeIndigoState $ \md ->
  case act md of
    SomeGenCode gc -> unSIS (f (IndigoState $ \_ -> gc)) 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 act f = SomeIndigoState $ \md ->
  let (var, newMd) = pushRefMd md in
  case unSIS (act var) newMd of
    SomeGenCode gc -> unSIS (f (\_v -> IndigoState $ \_md -> gc)) 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 act f = SomeIndigoState $ \md ->
   let (var1, newMd1) = pushRefMd md in
   let (var2, newMd2) = pushRefMd newMd1 in
  case unSIS (act var2 var1) newMd2 of
    SomeGenCode gc -> unSIS (f (\_v _w -> IndigoState $ \_md -> gc)) md