Protocols.hs

{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE UndecidableInstances #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-|
    Module      :  Control.ERNet.Blocks.Real.Protocols
    Description :  protocols for communicating a real number
    Copyright   :  (c) Michal Konecny
    License     :  BSD3

    Maintainer  :  mik@konecny.aow.cz
    Stability   :  experimental
    Portability :  portable

    Basic protocol for transferring approximations of a single real number
    using intervals. 

-}
module Control.ERNet.Blocks.Real.Protocols where

import Control.ERNet.Foundations.Protocol
import Control.ERNet.Foundations.Protocol.StandardCombinators
import qualified Control.ERNet.Foundations.Channel as CH

import qualified Data.Number.ER.Real.Approx as RA
import qualified Data.Number.ER.Real.Approx.Elementary as RAEL

import Data.Number.ER.BasicTypes

import Data.Number.ER.ShowHTML
import qualified Text.Html as H

import Data.Typeable

{- protocol for real numbers based on RA intervals -}

instance (RAEL.ERApproxElementary ira, Typeable ira) => 
    (QAProtocol QARealQ (QARealA ira))
    where
    qaMatch _ _ = Nothing -- always matching

data QARealQ
    = QARealQ
    deriving (Eq, Ord, Show, Typeable)

data QARealA ra
    = QARealA ra
    deriving (Eq, Ord, Show, Typeable)

chTReal :: 
    (RAEL.ERApproxElementary ira, Typeable ira) =>
    ira -> ChannelType
chTReal sampleRA = ChannelType QARealQ (QARealA sampleRA)

instance H.HTML QARealQ 
    where
    toHtml = toHtmlDefault
    
instance (Show ra) => H.HTML (QARealA ra)
    where
    toHtml = toHtmlDefault 

{-| 
    Construct an answer to a query for a real number
    using the default real number protocol with an effort index.
-}
makeAnswerR ::
    (RAEL.ERApproxElementary ra) =>
    (EffortIndex -> ra) ->
    (QAIxQ (QARealQ)) ->
    (QAIxA (QARealA ra))
makeAnswerR val (QAIxQ ix q) =
    QAIxA $ makeAnswerRNoIx (val ix) q

{-| 
    Construct an answer to a query for a real number
    using the default real number protocol without any effort index.
-}
makeAnswerRNoIx ::
    (RAEL.ERApproxElementary ra) =>
    (ra) ->
    (QARealQ) ->
    (QARealA ra)
makeAnswerRNoIx val QARealQ =
    QARealA val

{-| 
    Construct an answer to a query for a list a real numbers
    using the list protocol with an effort index.
-}
makeAnswerRs ::
    (RAEL.ERApproxElementary ra) =>
    (EffortIndex -> [ra]) ->
    (QAIxQ (QAListQ QARealQ)) ->
    (QAIxA (QAListA (QARealA ra)))
makeAnswerRs vals (QAIxQ ix q) =
    QAIxA $ makeAnswerRsNoIx (vals ix) q

{-| 
    Construct an answer to a query for a list a real numbers
    using the list protocol without any effort index.
-}
makeAnswerRsNoIx ::
    (RAEL.ERApproxElementary ra) =>
    ([ra]) ->
    (QAListQ QARealQ) ->
    (QAListA (QARealA ra))
makeAnswerRsNoIx vals qry =
    case qry of
        (QAListQAllHomog (QARealQ)) ->
            QAListA $ map QARealA vals
        (QAListQPrefix qs) ->
            QAListA $ map QARealA $ take (length qs) vals
        (QAListQSingle n qs) ->
            QAListASingle $ QARealA $ vals !! n
        (QAListQLength) ->
            QAListALength $ length vals

{-|
    Make a query and wait for answer 
    on a real number input socket with the standard
    (index -> approx) protocol.
-}
querySyncR ::
    (CH.Channel sIn sOut sInAnyProt sOutAnyProt, 
     RAEL.ERApproxElementary ira, Typeable ira) =>
    sOut q2 a2 {-^ initiator query channel -} ->
    QueryId ->
    (sIn (QAIxQ QARealQ) (QAIxA (QARealA ira))) ->
    EffortIndex ->
    IO (ira)
querySyncR callingCH callingQryId channel ix =
    do
    qryId <- CH.makeQuery callingCH callingQryId channel (QAIxQ ix QARealQ)
    (QAIxA (QARealA ansRA)) <- 
        CH.waitForAnswer callingCH callingQryId channel qryId
    return ansRA