implementation module Devices.mTaskDevice

from StdFunc import flip
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

instance == MTaskDevice where
	(==) a b = a.deviceChannels == b.deviceChannels

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 = forever $ anyTask 
		[viewInformation "Device settings" [] d @! ()
		,viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
		,forever $ 
			enterChoice "Delete task on device" [ChooseFromGrid id] d.deviceTasks
			>>* [OnAction (Action "Delete") $ ifValue (\t->t.ident <> -1) (deviceTaskDelete d)]
			@! ()
		] <<@ ArrangeHorizontal
		>>* [OnAction (Action "Delete Device") (always $ deleteDevice d)]
	where
		dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)

deleteDevice :: MTaskDevice -> Task ()
deleteDevice d = upd (\(r,s,ss)->(r,s,True)) (channels d)
	>>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask
	>>| upd (filter ((==)d)) deviceStore
	@! ()

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

		addTask :: MTaskTask MTaskDevice -> MTaskDevice
		addTask task device = {device & deviceTasks=[task: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 \b->if (b == a) (trans b) b) deviceStore @! ()

deviceTaskAcked :: MTaskDevice Int -> Task ()
deviceTaskAcked dev i 
	= withDevices dev (\d->{d&deviceTasks=ackFirst d.deviceTasks})
	where
		ackFirst :: [MTaskTask] -> [MTaskTask]
		ackFirst [] = []
		ackFirst [t:ts] = if (t.ident == -1)
			[{t & ident=i}:ts] [t:ackFirst ts]

deviceTaskDelete :: MTaskDevice MTaskTask -> Task ()
deviceTaskDelete dev task = sendMessage dev [MTTaskDel task.ident]

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