implementation module Devices.mTaskDevice

import Generics.gCons
import mTaskInterpret
import iTasks
import iTasksTTY
import TTY
import qualified Data.Map as DM
import Utils.SDS

import GenBimap
import Devices.mTaskSerial
import Devices.mTaskTCP
import iTasks._Framework.Store

from Data.Func import $

derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend
derive conses MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings
derive consName MTaskResource, TTYSettings, BaudRate, Parity, ByteSize, TCPSettings

channels :: MTaskDevice -> Shared Channels
channels d = memoryShare d.deviceChannels ([], [], False)

makeDevice :: String MTaskResource -> Task MTaskDevice
makeDevice name res = get randomInt @ \rand->{MTaskDevice
		|deviceChannels=name +++ toString rand
		,deviceName=name
		,deviceTasks=[]
		,deviceTask=Nothing
		,deviceData=res}

getSynFun :: MTaskResource -> ((Shared Channels) -> Task ())
getSynFun (TCPDevice t) = synFun t
getSynFun (SerialDevice t) = synFun t

addDevice :: (Shared [MTaskDevice]) (MTaskDevice (Shared Channels) -> Task ()) -> Task String
addDevice devices processFun
	=   enterChoice "Device type" [] (map consName{|*|} deviceTypes)
	>&^ \sh->whileUnchanged sh $ \mty->case mty of
		Nothing = viewInformation "No type selected yet" [] ""
		Just ty = enterInformation "Name" [] -&&- deviceSettings ty
			>>= \(name, settings)->makeDevice name settings
			>>= \dev->appendTopLevelTask 'DM'.newMap True (tlt dev)
			>>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
			@! ""
	where
		tlt dev = let ch = channels dev in processFun dev ch -||- getSynFun dev.deviceData ch

		deviceSettings "SerialDevice" = getmTaskSerialDevice
		deviceSettings "TCPDevice" = getmTaskTCPDevice

		deviceTypes :: [MTaskResource]
		deviceTypes = conses{|*|}

manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) [MTaskDevice] -> Task ()
manageDevices processFun ds = anyTask [
		addDevice deviceStore processFun <<@ Title "Add new device" @! ():
			[viewDevice d <<@ Title d.deviceName\\d<-ds]]
	<<@ ArrangeWithTabs @! ()

viewDevice :: MTaskDevice -> Task ()
viewDevice d = anyTask 
		[viewInformation "Device settings" [] d @! ()
		,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
		,forever $ 
			enterChoice "Delete task on device" [ChooseFromList fst] d.deviceTasks
			>>* [OnAction (Action "Delete") $ ifValue (\(_,i)->i <> -1) (deviceTaskDelete d o snd)]
			@! ()
		] <<@ ArrangeHorizontal
	where
		dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)

sendToDevice :: (Map String (Main (ByteCode () Stmt))) String (MTaskDevice, Int) -> Task ()
sendToDevice tmap mTask (device, timeout) =
		get bcStateStore @ createBytecode
	>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
	>>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
	>>| makeShares sdss
	>>| sendMessage device msgs
	>>| withDevices device (addTask timeout)
	@! ()
	where
		createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask tmap)) st
		sharename i = device.deviceChannels +++ "-" +++ toString i
		toSDSRecords st = [{MTaskShare |
			initValue=toInt d1*265 + toInt d2,
			withTask=mTask,
			identifier=i,
			realShare="mTaskSDS-" +++ toString i}
				\\(i,[d1,d2])<-st.sdss]
		makeShares = foldr (\sh t->set sh.initValue (getSDSStore sh) >>| t) (treturn ())

		addTask :: Int MTaskDevice -> MTaskDevice
		addTask timeout device = {device & deviceTasks=[(mTask, -1):device.deviceTasks]}

sendMessage :: MTaskDevice [MTaskMSGSend] -> Task ()
sendMessage dev msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) (channels dev) @! ()

withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
withDevices a trans = upd (map withDevice) deviceStore @! ()
	where withDevice b = if (a.deviceChannels == b.deviceChannels) (trans b) b

deviceTaskAcked :: MTaskDevice Int -> Task ()
deviceTaskAcked dev i 
	= withDevices dev (\d->{d&deviceTasks=ackFirst i d.deviceTasks})
	where
		ackFirst :: Int [(String, Int)] -> [(String, Int)]
		ackFirst _ [] = []
		ackFirst a [(s,i):ts] = if (i == -1)  [(s,a):ts] [(s,i):ackFirst a ts]

deviceTaskDelete :: MTaskDevice Int -> Task ()
deviceTaskDelete dev tid = sendMessage dev [MTTaskDel tid]

deviceTaskDeleteAcked :: MTaskDevice Int -> Task ()
deviceTaskDeleteAcked d i = withDevices d $ deleteTask
	where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> snd s]}