-- FIXME: Introduce hyperlinks to type operators once this is supported by Haddock.
{-|
    This module provides records of signals and signal-related data.

    A record has a type of the following form:

    @
    (X :& /name_1/ ::: /signal_1/ `'Of'` /val_1/ :& ... :& /name_n/ ::: /signal_n/ `'Of'` /val_n/) /style/
    @

    A value of such a type is a list of /fields/ where the /i/th field has type @(/name_i/ :::
    /signal_i/ `'Of'` /val_i/) /style/@.

    @(:::)@ is a data family. Its @/style/@ parameter is a phantom type which selects the instance
    of the family. For a concrete @/style/@ type, the type @(/name/ ::: /signal/ `'Of'`
    /val/) /style/@ covers name-value pairs where the type of the values depends on @/signal/@ and
    @/val/@. For example, if @/style/@ is of the form @'SignalStyle' /era/@, the values have type
    @/signal/ /era/ /val/@. This leads to records of signals with identical era. With the styles
    @'Connector' 'Consumer'@ and @'Connector' 'Producer'@, it is possible to form records of
    consumers and producers.

    Field names are represented by types which are declared as follows:

    @
    data /Name/ = /Name/
    @

    This makes it possible to use names as types (allowing the use of names in compile-time checks)
    but also as expressions and patterns.
-}
module Data.Record.Signal (

    -- * Signal kind
    SignalKind,
    Forall (SignalForall),

    -- * Signal records
    SignalRecord,
    SignalStyle,
    -- (:::) ((::=)),

    -- * Connector records
    ConsumerRecord,
    ProducerRecord,
    ConnectorRecord,
    ConnectorStyle,
    -- (:::) ((::~)),
    consume,
    produce

) where

    -- Control
    import Control.Arrow as Arrow

    -- Data
    import Data.Record as Record

    -- FRP.Grapefruit
    import           FRP.Grapefruit.Circuit as Circuit
    import           FRP.Grapefruit.Signal  as Signal (Of, Consumer, Producer)
    import qualified FRP.Grapefruit.Signal  as Signal

    -- * Signal kind
    data SignalKind

    instance Kind SignalKind where

        data Forall SignalKind func = SignalForall (forall signal val. func (signal `Of` val))

        encase piece = SignalForall piece

    instance Sort SignalKind (signal `Of` val) where

        specialize (SignalForall piece) = piece

    -- * Signal records
    -- |Records which contain signals of a common era as values.
    type SignalRecord era record = record (SignalStyle era)

    {-|
        The style of signal records of a specific era.

        Fields of signal style records have the form @/name/ ::= /signal/@.
    -}
    data SignalStyle era

    instance Style (SignalStyle era) where

        type K (SignalStyle era) = SignalKind

    type instance Value (SignalStyle era) (signal `Of` val) = signal era val

    -- * Connector records
    -- ** Records
    -- |Records which contain signal consumers as values.
    type ConsumerRecord record = ConnectorRecord Consumer record

    -- |Records which contain signal producers as values.
    type ProducerRecord record = ConnectorRecord Producer record

    -- |Records which which contain signal connectors (producers or consumers) as values.
    type ConnectorRecord connector record = record (ConnectorStyle connector)

    {-|
        The consumer and producer record styles.

        @ConnectorStyle 'Consumer'@ is the style of consumer records and @ConnectorStyle 'Producer'@
        is the style of producer records. Fields of connector style records have the form @/name/
        ::~ /connector/@.
    -}
    data ConnectorStyle (connector :: (* -> * -> *) -> * -> *)

    instance Style (ConnectorStyle connector) where

        type K (ConnectorStyle connector) = SignalKind

    type instance Value (ConnectorStyle connector) (signal `Of` val) = connector signal val

    -- ** Consumption
    {-|
        Converts a record of consumers into a circuit that consumes a corresponding record of
        signals.
    -}
    consume :: (Record SignalKind record) =>
               ConsumerRecord record -> Circuit era (SignalRecord era record) ()
    consume = case build nilConsumeThing consumeExtender of ConsumeThing result -> result

    newtype ConsumeThing era record = ConsumeThing (ConsumerRecord record ->
                                                    Circuit era (SignalRecord era record) ())

    nilConsumeThing :: ConsumeThing era X
    nilConsumeThing = ConsumeThing $ \X -> arr (\X -> ())

    consumeExtender :: Forall SignalKind (ExtenderPiece (ConsumeThing era) record name)
    consumeExtender = SignalForall (ExtenderPiece consConsumeThing)

    {-FIXME:
        The explicit type signature for the local function consume' (and therefore also the use of
        scoped type variables) is currently necessary. If it is left out, GHC 6.10.1 panics with
        the message “initC: srt_lbl”. Analogous for consProduceThing. Note that GHC doesn’t panic if
        consume and produce are not exported. It also doesn’t panic if Signal.consume consumer and
        Signal.produce producer are replaced by undefined.
    -}
    consConsumeThing :: forall era record name signal val.
                        ConsumeThing era record
                     -> ConsumeThing era (record :& name ::: signal `Of` val)
    consConsumeThing (ConsumeThing consume) = ConsumeThing consume' where

        consume' :: ConsumerRecord (record :& name ::: signal `Of` val)
                 -> Circuit era (SignalRecord era (record :& name ::: signal `Of` val)) ()
        consume' (consumerRecord :& _ := consumer) = proc (signalRecord :& _ := signal) -> do
            consume consumerRecord  -< signalRecord
            Signal.consume consumer -< signal

    -- ** Production
    {-|
        Converts a record of producers into a circuit that produces a corresponding record of
        signals.
    -}
    produce :: (Record SignalKind record) =>
               ProducerRecord record -> Circuit era () (SignalRecord era record)
    produce = case build nilProduceThing produceExtender of ProduceThing result -> result

    newtype ProduceThing era record = ProduceThing (ProducerRecord record ->
                                                    Circuit era () (SignalRecord era record))

    nilProduceThing :: ProduceThing era X
    nilProduceThing = ProduceThing $ \X -> arr (const X)

    produceExtender :: Forall SignalKind (ExtenderPiece (ProduceThing era) record name)
    produceExtender = SignalForall (ExtenderPiece consProduceThing)

    consProduceThing :: forall era record name signal val.
                        ProduceThing era record
                     -> ProduceThing era (record :& name ::: signal `Of` val)
    consProduceThing (ProduceThing produce) = ProduceThing produce' where

        produce' :: ProducerRecord (record :& name ::: signal `Of` val)
                 -> Circuit era () (SignalRecord era (record :& name ::: signal `Of` val))
        produce' (producerRecord :& name := producer) = proc _ -> do
            signalRecord <- produce producerRecord  -< ()
            signal       <- Signal.produce producer -< ()
            returnA -< signalRecord :& name := signal