implementation module iTasks.SDS.Definition

import StdEnv

import Data.GenEq
import Data.Either
import Data.Error
import Data.Func
import Data.GenHash
import Data.List
import Data.Maybe
import qualified Data.Map as Map
import qualified Data.Foldable as DF
from Data.Set import instance Foldable Set
import Internet.HTTP
import Text.GenJSON

import dynamic_string

import iTasks.Internal.IWorld
import iTasks.Internal.Task
import iTasks.Internal.Util

import iTasks.Internal.Generic.Visualization
import iTasks.Internal.Generic.Defaults
import iTasks.UI.Editor.Generic
import iTasks.WF.Derives

/**
 * Requests are organised by task, to allow efficient filtering of notified tasks by SDS combinators.
 * For each request only the point in time of the last notification request has to be known.
 * The type therefore enforces a single `Timespec` per request.
 */
:: SdsNotifyRequests =: SdsNotifyRequests (Map PossiblyRemoteTaskId (Map SDSNotifyRequest Timespec))

emptyNotifyRequests :: SdsNotifyRequests
emptyNotifyRequests =: SdsNotifyRequests 'Map'.newMap

notifyRequestsWithRequestFor ::
	!PossiblyRemoteTaskId !SDSNotifyRequest !Timespec !(?SdsNotifyRequests) -> SdsNotifyRequests
notifyRequestsWithRequestFor taskId req timespec ?None =
	SdsNotifyRequests ('Map'.singleton taskId $ 'Map'.singleton req timespec)
notifyRequestsWithRequestFor taskId req timespec (?Just (SdsNotifyRequests requests)) =
	SdsNotifyRequests
		('Map'.alter (?Just o maybe ('Map'.singleton req timespec) ('Map'.put req timespec)) taskId requests)

withoutRequestsFor :: !(Set TaskId) !SdsNotifyRequests -> SdsNotifyRequests
withoutRequestsFor taskIds (SdsNotifyRequests reqs) =
	SdsNotifyRequests
		('DF'.foldl` (\reqs taskId -> 'Map'.del {taskId = taskId, remoteNotifyOptions = ?None} reqs) reqs taskIds)

isEmptyNotifyRequests :: !SdsNotifyRequests -> Bool
isEmptyNotifyRequests (SdsNotifyRequests reqs) = 'Map'.null reqs

foldedRequestsIn ::
	!(PossiblyRemoteTaskId SDSNotifyRequest Timespec .st -> .st) !SdsNotifyRequests !.st -> .st
foldedRequestsIn withRequest (SdsNotifyRequests requests) st =
	'Map'.foldlWithKey`
		(\st taskId requests -> 'Map'.foldlWithKey` (\st req time -> withRequest taskId req time st) st requests)
		st
		requests

foldedRequestsFor ::
	!(SDSNotifyRequest Timespec .st -> .st) !PossiblyRemoteTaskId !SdsNotifyRequests !.st -> .st
foldedRequestsFor withRequest taskId (SdsNotifyRequests requests) st =
	case 'Map'.get taskId requests of
		?None
			= st
		?Just requests
			= 'Map'.foldlWithKey` (\st req time -> withRequest req time st) st requests

tasksWithRequests :: !SdsNotifyRequests -> Set PossiblyRemoteTaskId
tasksWithRequests (SdsNotifyRequests requests) = 'Map'.keysSet requests

withRequestInfoFor ::
	!SDSIdentityHash !SdsNotifyRequests !(Map InstanceNo [(TaskId,SDSIdentityHash)])
	-> Map InstanceNo [(TaskId,SDSIdentityHash)]
withRequestInfoFor cmpSDSId (SdsNotifyRequests requests) acc = 'Map'.foldrWithKey` addRegsForTask acc requests
where
	addRegsForTask ::
		!PossiblyRemoteTaskId x !(Map InstanceNo [(TaskId,SDSIdentityHash)])
		-> Map InstanceNo [(TaskId,SDSIdentityHash)]
	addRegsForTask {PossiblyRemoteTaskId| taskId = taskId =: (TaskId taskInstance _)} _ list =
		'Map'.put taskInstance [(taskId,cmpSDSId):fromMaybe [] ('Map'.get taskInstance list)] list

derive gText SDSNotifyRequest, RemoteNotifyOptions

gText{|SDSIdentity|} _ ?None = []
gText{|SDSIdentity|} f (?Just id) =
	[ id.id_name
	: case id.id_child_a of
		?None -> []
		?Just a ->
			[ "("
			: gText{|*|} f (?Just a) ++ case id.id_child_b of
				?None -> [")"]
				?Just b -> [",":gText{|*|} f (?Just b) ++ [")"]]
			]
	]

instance < SDSIdentity where (<) a b = a.id_hash < b.id_hash

instance toString SDSIdentity where toString sdsId = toSingleLineText sdsId

JSONEncode{|SDSIdentity|} _ id = [JSONObject
	[ ("name",JSONString id.id_name)
	: case id.id_child_a of
		?None -> []
		?Just a ->
			[ ("child_a",hd (JSONEncode{|*|} True a))
			: case id.id_child_b of
				?None -> []
				?Just b -> [("child_b",hd (JSONEncode{|*|} True b))]
			]
	]]
JSONDecode{|SDSIdentity|} _ org=:[JSONObject obj:rest] = case lookup "name" obj of
	?Just (JSONString name) = case lookup "child_a" obj of
		?Just child_a = case JSONDecode{|*|} True [child_a] of
			(?Just a,[]) = case lookup "child_b" obj of
				?Just child_b = case JSONDecode{|*|} True [child_b] of
					(?Just b,[]) = if (length obj==3)
						(?Just (createSDSIdentity name (?Just a) (?Just b)),rest)
						(?None, org)
					_ = (?None, org)
				_ = if (length obj==2)
					(?Just (createSDSIdentity name (?Just a) ?None),rest)
					(?None, org)
			_ = (?None, org)
		_ = if (length obj==1)
			(?Just (createSDSIdentity name ?None ?None),rest)
			(?None, org)
	_ = (?None, org)

createSDSIdentity :: !String !(?SDSIdentity) !(?SDSIdentity) -> SDSIdentity
createSDSIdentity name a b =
	{ id_name    = name
	, id_child_a = a
	, id_child_b = b
	, id_hash    = (murmurHash name) bitxor (hash a) bitxor (hash b)
	}
where
	hash ?None     = 0
	hash (?Just c) = c.id_hash

derive class iTask SDSShareOptions

instance toString (WebServiceShareOptions p r w)
where
	toString (HTTPShareOptions {HTTPHandlers|host, port}) = "http://" +++ host +++ ":" +++ toString port
	toString (TCPShareOptions {TCPHandlers|host, port}) = "tcp://" +++ host +++ ":" +++ toString port

// some efficient order to be able to put notify requests in sets
instance < SDSNotifyRequest where
	(<) x y
		| x.cmpParamHash < y.cmpParamHash = True
		| x.cmpParamHash > y.cmpParamHash = False
		| otherwise                       = x.reqSDSId < y.reqSDSId

derive gEq RemoteNotifyOptions
derive gEq SDSIdentity

instance == RemoteNotifyOptions where
	(==) left right = left === right

instance < RemoteNotifyOptions where
	(<) left right = (left.hostToNotify, left.portToNotify, left.remoteSdsId) <
	                 (right.hostToNotify, right.portToNotify, right.remoteSdsId)

instance == PossiblyRemoteTaskId
where
	(==) a=:{taskId=id_a,remoteNotifyOptions=opts_a} b=:{taskId=id_b,remoteNotifyOptions=opts_b}
		= id_a == id_b && opts_a == opts_b

instance < PossiblyRemoteTaskId
where
	(<) a=:{taskId=id_a,remoteNotifyOptions=opts_a} b=:{taskId=id_b,remoteNotifyOptions=opts_b}
		| id_a < id_b
			= True
		| id_b < id_a
			= False
		| isNone opts_a
			= isJust opts_b
		| isNone opts_b
			= False
			= fromJust opts_a < fromJust opts_b

derive gText PossiblyRemoteTaskId

instance < SDSCacheKey
where
	(<) a b
		| a.sdsIdHash < b.sdsIdHash = True
		| a.sdsIdHash > b.sdsIdHash = False
		| otherwise                 = a.cacheParamHash < b.cacheParamHash
