{-|
    This module provides context connector records.

    A context connector record is a record of connectors (consumers or producers) which depend on
    some data, called the context.
-}
module FRP.Grapefruit.Record.Context (

    -- * Context connector records
    ContextConsumerRecord,
    ContextProducerRecord,
    ContextConnectorRecord,
    ContextConnectorStyle,
    consume,
    produce,
    app,

    -- * Field family instance for context connector records
    (:::) ((::~~))

) where

    -- Control
    import Control.Arrow.Operations         as ArrowOperations
    import Control.Arrow.Transformer.Reader as ReaderArrow

    -- FRP.Grapefruit
    import           FRP.Grapefruit.Circuit as Circuit
    import           FRP.Grapefruit.Signal  as Signal  hiding (consume, produce)
    import           FRP.Grapefruit.Record  as Record  hiding (consume, produce)
    import qualified FRP.Grapefruit.Record  as Record

    -- Fixities
    infixr 0 `app`
    infix  3 ::~~

    -- |Records which contain functions from contexts to consumers as values.
    type ContextConsumerRecord context record = ContextConnectorRecord context Consumer record

    -- |Records which contain functions from contexts to producers as values.
    type ContextProducerRecord context record = ContextConnectorRecord context Producer record

    {-|
        Records which contain functions from contexts to connectors (consumers or producers) as
        values.
    -}
    type ContextConnectorRecord context connector record = record (ContextConnectorStyle context
                                                                                         connector)

    {-|
        The context consumer and context producer record styles.

        @ContextConnectorStyle /context/ 'Consumer'@ is the style of context consumer records with
        context @/context/@ and @ContextConnectorStyle /context/ 'Producer'@ is the style of context
        producer records with context @/context/@. Fields of context connector style records have
        the form @/name/ ::~~ /connectorGenerator/@.
    -}
    data ContextConnectorStyle context connector

    data instance (:::) name
                        (signal `Of` val)
                        (ContextConnectorStyle context
                                               connector) = (::~~) !name
                                                                   (context -> connector signal val)

    {-|
        Converts a record of context consumers into a reader arrow which consumes a corresponding
        record of signals. The concrete context has to be provided as the environment of the reader
        arrow.
    -}
    consume :: (Record record)
            => ContextConsumerRecord context record
            -> ReaderArrow context (Circuit era) (SignalRecord era record) ()
    consume = connect Record.consume

    {-|
        Converts a record of context producers into a reader arrow which produces a corresponding
        record of signals. The concrete context has to be provided as the environment of the reader
        arrow.
    -}
    produce :: (Record record)
            => ContextProducerRecord context record
            -> ReaderArrow context (Circuit era) () (SignalRecord era record)
    produce = connect Record.produce

    connect :: (Record record)
            => (ConnectorRecord connector record -> Circuit era i o)
            -> ContextConnectorRecord context connector record
            -> ReaderArrow context (Circuit era) i o
    connect signalRecordConnect contextConnectorRecord = arrow' where

        arrow' = proc i -> do
                     context <- readState -< ()
                     liftReader $ signalRecordConnect (contextConnectorRecord `app` context) -<< i

    {-|
        Applies all values of a context connector record to a given context to form an ordinary
        context record.
    -}
    app :: (Record record)
        => ContextConnectorRecord context connector record
        -> context
        -> ConnectorRecord connector record
    app = case build nilAppThing consAppThing of AppThing apply -> apply

    newtype AppThing context connector record = AppThing (ContextConnectorRecord context
                                                                                 connector
                                                                                 record ->
                                                          context ->
                                                          ConnectorRecord connector record)

    nilAppThing :: AppThing context connector X
    nilAppThing = AppThing $ \X _ -> X

    consAppThing :: AppThing context connector record
                 -> AppThing context connector (record :& name ::: signal `Of` val)
    consAppThing (AppThing apply) = AppThing apply' where

        apply' ((:&) contextConnectorRecord
                     (name ::~~ contextConnector))
               context                             = apply contextConnectorRecord context :&
                                                     name ::~ contextConnector context