{-# LANGUAGE Safe #-}

-- | Combinators to deal with streams carrying structs.
module Copilot.Language.Operators.Struct
  ( (#)
  ) where

import Copilot.Core.Type
import Copilot.Core.Operators
import Copilot.Language.Stream  (Stream (..))

import GHC.TypeLits             (KnownSymbol)

--------------------------------------------------------------------------------

-- | Create a stream that carries a field of a struct in another stream.
--
-- This function implements a projection of a field of a struct over time. For
-- example, if a struct of type @T@ has two fields, @t1@ of type @Int@ and @t2@
-- of type @Word8@, and @s@ is a stream of type @Stream T@, then @s # t2@ has
-- type @Stream Word8@ and contains the values of the @t2@ field of the structs
-- in @s@ at any point in time.
(#) :: (KnownSymbol s, Typed t, Typed a, Struct a)
      => Stream a -> (a -> Field s t) -> Stream t
# :: Stream a -> (a -> Field s t) -> Stream t
(#) Stream a
s a -> Field s t
f = Op1 a t -> Stream a -> Stream t
forall a b. (Typed a, Typed b) => Op1 a b -> Stream a -> Stream b
Op1 (Type a -> Type t -> (a -> Field s t) -> Op1 a t
forall (s :: Symbol) a b.
KnownSymbol s =>
Type a -> Type b -> (a -> Field s b) -> Op1 a b
GetField Type a
forall a. Typed a => Type a
typeOf Type t
forall a. Typed a => Type a
typeOf a -> Field s t
f) Stream a
s

--------------------------------------------------------------------------------