definition module iTasks.SDS.Definition
/**
* This module provides the types that define a shared data source
*/

from StdOverloaded import class <, class ==, class toString

from iTasks.WF.Definition import :: TaskException, class iTask, :: TaskId, :: InstanceNo
from iTasks.Internal.IWorld import :: IWorld, :: ConnectionId

import iTasks.Internal.Generic.Visualization
import iTasks.Internal.Generic.Defaults
import iTasks.UI.Editor.Generic
import Data.GenEq, Internet.HTTP, Data.Maybe.Ord
from Data.GenHash import generic gHash
from Text.GenJSON import :: JSONNode, generic JSONEncode, generic JSONDecode

from Data.Either import :: Either
from Data.Error import :: MaybeError
from Data.Set import :: Set

//* This contains all notify requests for a single SDS.
:: SdsNotifyRequests (=: SdsNotifyRequests (Map PossiblyRemoteTaskId (Map SDSNotifyRequest Timespec)))

//* Empty notify requests.
emptyNotifyRequests :: SdsNotifyRequests

/**
 * notifyRequestWithRequestFor taskId request timespec ?None = requests:
 *     `requests` is the collection with the single registration `request` for `taskId` and `timespec`.
 * notifyRequestWithRequestFor taskId request timespec (?Just requests) = requests2:
 *     `requests2` is the collection `requests` with the additional registration `request` for `taskId` and `timespec`.
 *     If there is already a registration `request` for `taskId` with a different `timespec`,
 *     this registration is not included in `requests2`.
 */
notifyRequestsWithRequestFor ::
	!PossiblyRemoteTaskId !SDSNotifyRequest !Timespec !(?SdsNotifyRequests) -> SdsNotifyRequests

/**
 * withoutRequestsFor taskIds requests = requests2:
 *     `requests2` are the registrations `requests` with such for local tasks `taskIds`.
 */
withoutRequestsFor :: !(Set TaskId) !SdsNotifyRequests -> SdsNotifyRequests

//* The notify requests do not contain any requests.
isEmptyNotifyRequests :: !SdsNotifyRequests -> Bool

/**
 * foldedRequestsIn withRequest requests st = st2:
 *     `st2` is `st` updated with all registrations in `requests` according to `withRequest`.
 *     Folding happens in order of ascending task ID.
 */
foldedRequestsIn ::
	!(PossiblyRemoteTaskId SDSNotifyRequest Timespec .st -> .st) !SdsNotifyRequests !.st -> .st

/**
 * foldedRequestsFor withRequest taskId requests st = st2:
 *     `st2` is `st` updated with all registrations for `taskId` in `requests` according to `withRequest`.
 */
foldedRequestsFor ::
	!(SDSNotifyRequest Timespec .st -> .st) !PossiblyRemoteTaskId !SdsNotifyRequests !.st -> .st

//* All tasks for which requests are present.
tasksWithRequests :: !SdsNotifyRequests -> Set PossiblyRemoteTaskId

/**
 * withRequestInfoFor sdsIdHash requests acc = acc2:
 *    `acc2` contains the debug info of `acc` with additionally the info for SDS with identify hash `sdsIdHash`
 *    in `requests`.
 */
withRequestInfoFor ::
	!SDSIdentityHash !SdsNotifyRequests !(Map InstanceNo [(TaskId,SDSIdentityHash)])
	-> Map InstanceNo [(TaskId,SDSIdentityHash)]

derive gText SDSNotifyRequest, RemoteNotifyOptions

/**
 * This type is for internal purposes only.
 *
 * This hash allows for fast `Map`s from SDSs to other values in the `IWorld`.
 * Previously, these were indexed using
 *
 * 1. The `gText` representation. This is not a good idea, because when `gText`
 *   is specialized not all parts of the value may be taken into account. (Also
 *   this is very slow and requires a lot of memory to create and store the
 *   string representations.)
 * 2. A hash of the GraphCopy representation. This can however give a different
 *   hash for the same value. In particular this is the case for strings: for
 *   example, the last 7 bytes of a string of length 1
 *   are unused, and unspecified in the GraphCopy representation.
 *
 * For this reason we now use the dedicated hashing function `gHash`.
 */
:: SDSIdentityHash :== Int

//* This type is for internal purposes only.
:: SDSIdentity =
	{ id_name    :: !String
	, id_child_a :: !?SDSIdentity
	, id_child_b :: !?SDSIdentity
	, id_hash    :: !SDSIdentityHash
	}

instance < SDSIdentity
instance toString SDSIdentity
derive JSONEncode SDSIdentity
derive JSONDecode SDSIdentity

createSDSIdentity :: !String !(?SDSIdentity) !(?SDSIdentity) -> SDSIdentity

:: TaskContext = EmptyContext // Used in the internals of the iTasks system
               | TaskContext !TaskId // Used when a local task is reading from a share
               // Used when a remote task is reading from a share locally
               | RemoteTaskContext !TaskId  // The id of the original task reading the share
                                   !TaskId // The id of the current task handling the request
                                   !SDSIdentity // The id of the share on the remote server
                                   !String // The host to which to send a refresh notification
                                   !Int  // The port to which to send a refresh notification

/**
 * The ID of a task, which is possibly a remote one.
 * `remoteNotifyOptions` is `?None` for local tasks,
 * for remote tasks information is provided about the host the task runs on.
 */
:: PossiblyRemoteTaskId = !
	{ taskId              :: !TaskId
	, remoteNotifyOptions :: !?RemoteNotifyOptions
	}

instance == PossiblyRemoteTaskId

derive gText PossiblyRemoteTaskId

:: ReadResult p r w
	/**
	 * Reading from the share has yielded a result. Where applicable, all asynchronous operations have finished.
	 */
	= E.sds: ReadResult !r !(sds p r w) & RWShared sds
	/**
	 * Reading from the share has not yet yielded a result because some asynchronous operation has not finished.
	 * We return a new version of the share, which MUST be used for the next read operation.
	 */
	| E. sds: AsyncRead !(sds p r w) & RWShared sds & TC r & TC w
	| ReadException !TaskException

:: WriteResult p r w
	/**
	 * Writing to the share has succeeded. Where applicable, all asynchronous operations have finished.
	 */
	= E.sds: WriteResult !(Set PossiblyRemoteTaskId) !(sds p r w) & RWShared sds
	/**
	 * Denotes that writing to a SDS had lead to some asynchronous action.
	 * We return a new version of the share, which MUST be used for the next write operation.
	 * The SDS is required to be a Readable AND Writeable, because writing to a SDS may require reading from another.
	 */
	| E. sds: AsyncWrite !(sds p r w) & RWShared sds & TC r & TC w
	| WriteException !TaskException

:: ModifyResult p r w
	/**
	 * Modifying the share has succeeded, all asynchronous operations have finished.
	 */
	= E.sds: ModifyResult !(Set PossiblyRemoteTaskId) !r !w !(sds p r w) & RWShared sds
	/**
	 * Modifying has not yet succeeded because some asynchronous operation has not finished.
	 * We return a new version of the share, which MUST be used for the next modify operation.
	 */
	| E. sds: AsyncModify !(sds p r w) !(r -> MaybeError TaskException w) & RWShared sds
	| ModifyException !TaskException

//Notification requests are stored in the IWorld
:: SDSNotifyRequest =
	{ reqSDSId      :: !SDSIdentity  //* Id of the actual SDS used to create this request (may be a derived one)
	, cmpParam      :: !Dynamic      //* Parameter we are saving for comparison
	, cmpParamHash  :: !Int          //* A hash of the `cmpParam` for fast comparison
	}

instance < SDSNotifyRequest, RemoteNotifyOptions, PossiblyRemoteTaskId

//* This contains all information required to notify a remote host about an SDS change.
:: RemoteNotifyOptions =
	{ hostToNotify :: !String
	, portToNotify :: !Int
	, remoteSdsId  :: !SDSIdentity
	}

instance == RemoteNotifyOptions

class Identifiable sds
where
	sdsIdentity :: !(sds p r w) -> SDSIdentity

class Readable sds | Identifiable sds
where
	/**
	 * Read from a sds
	 * @param sds to read from.
	 * @param parameter used for reading
	 * @param context in which to read. Async sdss use the context to retrieve the task id.
	 */
	readSDS :: !(sds p r w) !p !TaskContext !*IWorld
	        -> *(!ReadResult p r w, !*IWorld) | TC p & TC r & TC w

class Registrable sds | Readable sds
where
	/**
	 * Register to a sds. Reads the value and registers the task to get a refresh event when the sds is changed.
	 * @param sds to read from and register to.
	 * @param parameter used for reading
	 * @param context in which to read. Async sds's use the context to retrieve the task id.
	 * @param taskId which registers itself for changes to the sds.
	 * @param Identity of the sds to read at the top of the tree, can be different from the sds given as parameter.
	 */
	readRegisterSDS :: !(sds p r w) !p !TaskContext !TaskId !SDSIdentity !*IWorld
	                -> *(!ReadResult p r w, !*IWorld) | TC p & TC r & TC w

class Writeable sds | Identifiable sds
where
	/**
	 * Write a value directly to a sds.
	 * @param sds to write to.
	 * @param parameter used for writing
	 * @param context in which to write. Async sdss use the context to retrieve the task id.
	 * @param value which to write to the sds.
	 */
	writeSDS :: !(sds p r w) !p !TaskContext !w !*IWorld
	         -> *(!WriteResult p r w, !*IWorld) | TC p & TC r & TC w

class Modifiable sds | Readable, Writeable sds
where
	/**
	 * Modify the SDS with the given function
	 * @param Function to apply to the SDS value
	 * @param the sds to modify
	 * @param parameter
	 * @param The context in which to read/write to the SDS
	 */
	modifySDS :: !(r -> MaybeError TaskException w) !(sds p r w) !p !TaskContext !*IWorld
	          -> *(!ModifyResult p r w, !*IWorld) | TC p & TC r & TC w

class RWShared sds | Modifiable, Registrable sds

/**
 * An SDS with no parameters and equal read and write types.
 */
:: Shared sds a :== sds () a a

/**
 * A predicate that determines whether some registered parameter of type p at a given point in time
 * needs to be notified.
 */
:: SDSNotifyPred p :== Timespec p -> Bool

/**
 * An SDSSource with no parameter and equal read and write type.
 */
:: SimpleSDSSource a :== SDSSource () a a

//Sources provide direct access to a data source
:: SDSSource p r w
	= SDSSource !(SDSSourceOptions p r w) & gHash{|*|} p

	// Allows for some keeping of local state. Writing to a SDS may require reading from that SDS.
	// In the case that this reading is asynchronous, writing could also be asynchronous. This
	// option allows to temporarily store the read result, so that we can start rewriting in order
	//  to write to the SDS, using the stored read value.
	| E. sds: SDSValue !Bool !r !(sds p r w) & RWShared sds & TC p & TC r & TC w

:: SDSSourceOptions p r w =
	{ name  :: !String
	, read  :: !p *IWorld -> *(MaybeError TaskException r, *IWorld)
	, write :: !p w *IWorld -> *(MaybeError TaskException (SDSNotifyPred p), *IWorld)
	}

/**
 * An SDSLens with no parameter and equal read and write type.
 */
:: SimpleSDSLens a :== SDSLens () a a

//Lenses select and transform data
:: SDSLens p r w
	= E.ps rs ws sds: SDSLens !(sds ps rs ws) !(SDSLensOptions p r w ps rs ws)
		& RWShared sds & TC ps & TC rs & TC ws & gHash{|*|} p

:: SDSLensOptions p r w ps rs ws = !
	{ id      :: SDSIdentity
	, name    :: String
	, param   :: !p -> ps
	, read    :: !SDSLensRead p r rs
	, write   :: !SDSLensWrite p w rs ws
	, notify  :: !SDSLensNotify p p w rs
	, reducer :: !?(SDSReducer p ws w)
	}
/**
An SDSLens may possibly have a reducer. ONLY when a reducer is present is it possible to atomically
modify an underlying asynchronous share when modifying the lens.

A reducer is needed because we can no longer read the value first, apply the modification function,
and write the value. The underlying share may not be a local share and when this is the case anyone
else could change the share between reading and writing. To deal with this we need to transform the
modification function from r -> w to rs -> ws. This can be done using the existing read and write
functions. However, modifying the underlying share yield a value of type ws which is not of the
required type w. The reducer has the job to turn this ws into w.

*/
:: SDSReducer p ws w :== p ws -> MaybeError TaskException w

:: SDSLensRead p r rs
	= SDSRead      !(p rs -> MaybeError TaskException r) //* Read original source and transform
	| SDSReadConst !(p -> r)                             //* No need to read the original source

:: SDSLensWrite p w rs ws
	= SDSWrite      !(p rs w  -> MaybeError TaskException (?ws)) //* Read original source, and write updated version
	| SDSWriteConst !(p w     -> MaybeError TaskException (?ws)) //* No need to read the original source

/**
 * This predicate is used to filter notification of child SDS.
 * If the predicate does not hold notifications of children have no effect.
 */
:: SDSLensNotify pw pq w rs
	= SDSNotify      !(pw rs w -> SDSNotifyPred pq)
	| SDSNotifyConst !(pw w    -> SDSNotifyPred pq)

/**
 * An SDSSelect with no parameter and equal read and write type.
 */
:: SimpleSDSSelect a :== SDSSelect () a a

//Merge two sources by selecting one based on the parameter
:: SDSSelect p r w
	= E.p1 p2 sds1 sds2: SDSSelect !(sds1 p1 r w) !(sds2 p2 r w) !(SDSSelectOptions p r w p1 p2)
		& gHash{|*|} p & RWShared sds1 & RWShared sds2 & TC p1 & TC p2 & TC r & TC w

:: SDSSelectOptions p r w p1 p2 = !
	{ id      :: SDSIdentity
	, name    :: String
	, select  :: !p -> Either p1 p2
	}

/**
 * An SDSParallel with no parameter and equal read and write type.
 */
:: SimpleSDSParallel a :== SDSParallel () a a

//Read from and write to two independent SDS's
:: SDSParallel p r w
	= E.p1 r1 w1 p2 r2 w2 sds1 sds2:
		SDSParallel !(sds1 p1 r1 w1) !(sds2 p2 r2 w2) !(SDSParallelOptions p1 r1 w1 p2 r2 w2 p r w)
		& gHash{|*|} p & RWShared sds1 & RWShared sds2 & TC, gHash{|*|} p1 & TC, gHash{|*|} p2 & TC r1 & TC r2 & TC w1 & TC w2
	| E.p1 r1 p2 r2 w2 sds1 sds2:
		SDSParallelWriteLeft !(sds1 p1 r1 w) !(sds2 p2 r2 w2) !(SDSParallelOptions p1 r1 w p2 r2 w2 p r w)
		& gHash{|*|} p & RWShared sds1 & Registrable sds2 & TC, gHash{|*|} p1 & TC, gHash{|*|} p2 & TC r1 & TC r2 & TC w2 & TC w
	| E.p1 r1 w1 p2 r2 sds1 sds2:
		SDSParallelWriteRight !(sds1 p1 r1 w1) !(sds2 p2 r2 w) !(SDSParallelOptions p1 r1 w1 p2 r2 w p r w)
		& gHash{|*|} p & Registrable sds1 & RWShared sds2 & TC, gHash{|*|} p1 & TC, gHash{|*|} p2 & TC r1 & TC r2 & TC w1 & TC w
	| E.p1 r1 w1 p2 r2 w2 sds1 sds2:
		SDSParallelWriteNone !(sds1 p1 r1 w1) !(sds2 p2 r2 w2) !(SDSParallelOptions p1 r1 w1 p2 r2 w2 p r w)
		& gHash{|*|} p & Registrable sds1 & Registrable sds2 & TC, gHash{|*|} p1 & TC, gHash{|*|} p2 & TC r1 & TC r2 & TC w1 & TC w2

:: SDSParallelOptions p1 r1 w1 p2 r2 w2 p r w = !
	{ id     :: SDSIdentity
	, name   :: String
	, param  :: !p -> (p1, p2)
	, read   :: !(!r1, !r2) -> r
	, writel :: !SDSLensWrite p w r1 w1
	, writer :: !SDSLensWrite p w r2 w2
	}

/**
 * An SDSSequence with no parameter and equal read and write type.
 */
:: SimpleSDSSequence a :== SDSSequence () a a

//Read from and write to two dependent SDS's
//The read value from the first is used to compute the parameter for the second
:: SDSSequence p r w
	= E.p1 r1 w1 p2 r2 w2 sds1 sds2:
		SDSSequence !(sds1 p1 r1 w1) !(sds2 p2 r2 w2) !(SDSSequenceOptions p1 r1 w1 p2 r2 w2 p r w)
		& gHash{|*|} p & RWShared sds1 & RWShared sds2 & TC p1 & TC p2 & TC r1 & TC r2 & TC w1 & TC w2

:: SDSSequenceOptions p1 r1 w1 p2 r2 w2 p r w = !
	{ id     :: SDSIdentity
	, name   :: String
	, paraml :: !p -> p1
	, paramr :: !p r1 -> p2
	, read   :: !p r1 -> Either r ((r1,r2) -> r)
	, writel :: !SDSLensWrite p w r1 w1
	, writer :: !SDSLensWrite p w r2 w2
	}

/**
 * Boxes another SDS. This allows for exporting an SDS without exporting
 * information about its internal structure, which is in particular useful when
 * the SDS' type definition should not be exported.
 */
:: SDSBox p r w = E.sds: SDSBox !(sds p r w) & RWShared sds

/**
 * An SDSCache with no parameter and equal read and write type.
 */
:: SimpleSDSCache a :== SDSCache () a a

:: SDSCache p r w = SDSCache !(SDSSource p r w) !(SDSCacheOptions p r w) & TC, gHash{|*|} p & TC r & TC w
:: SDSCacheOptions p r w  =
	{ id    :: !SDSIdentity
	, write :: !p (?r) (?w) w -> (?r, SDSCacheWrite)
	}

:: SDSCacheWrite = WriteNow | WriteDelayed | NoWrite

//* Used in the `IWorld`.
:: SDSCacheKey =
	{ sdsIdHash      :: !SDSIdentityHash
	, cacheParamHash :: !Int
	}

instance < SDSCacheKey

/**
 * An SDSRemoteSource with no parameter and equal read and write type.
 */
:: SimpleSDSRemoteSource a :== SDSRemoteSource () a a

/**
 * An SDSRemoteSource is a share tree living on another system. Evaluating it will cause an
 * asynchronous message to be sent to the other server to retrieve the value for the
 * specified operation.
 */
:: SDSRemoteSource p r w
	= E.sds:
		SDSRemoteSource !(sds p r w) !(?ConnectionId) !SDSShareOptions
		& RWShared sds & gHash{|*|} p

:: SDSShareOptions =
	{ domain :: !String
	, port   :: !Int
	}

derive class iTask SDSShareOptions


:: WebServiceShareOptions p r w = HTTPShareOptions !(HTTPHandlers p r w)
                                | TCPShareOptions !(TCPHandlers p r w)

instance toString (WebServiceShareOptions p r w)

:: HTTPHandlers p r w =
	{ host          :: !String
	, port          :: !Int
	, createRequest :: !p -> HTTPRequest
	, fromResponse  :: !HTTPResponse p -> MaybeErrorString r
	, writeHandlers :: !?(!p w -> HTTPRequest, !p HTTPResponse -> MaybeErrorString (SDSNotifyPred p))
	}

:: TCPHandlers p r w =
	{ host                 :: !String
	, port                 :: !Int
	, createMessage        :: !p -> String
	, fromTextResponse     :: !String p Bool -> MaybeErrorString (?r, ?String)
	, writeMessageHandlers :: !?(!p w -> String, !p String -> MaybeErrorString (?(SDSNotifyPred p)))
	}

/**
 * An SDSRemoteService with no parameter and equal read and write type.
 */
:: SimpleSDSRemoteService a :== SDSRemoteService () a a

/**
 * An SDSRemoteService is a share which allows you to connect to the outside world.
 * For now it just allows you to send HTTP messages and receive responses asynchronously.
 */
:: SDSRemoteService p r w = SDSRemoteService !(?ConnectionId) !(WebServiceShareOptions p r w)

:: SDSDebug p r w = E. sds: SDSDebug !String !(sds p r w) & RWShared sds

:: SDSNoNotify p r w = E.sds: SDSNoNotify !(sds p r w) & RWShared sds
