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 qualified Data.List as DL
import Utils.SDS
import Utils.Devices

import GenBimap
import Devices.mTaskSerial
import Devices.mTaskTCP
import iTasks._Framework.Store
import iTasks.UI.Definition, iTasks.UI.Editor, iTasks.UI.Editor.Builtin, iTasks.UI.Editor.Common, iTasks.UI.Layout.Default, iTasks.UI.Layout.Common

from Data.Func import $

derive class iTask MTaskDevice, MTaskResource, MTaskMSGRecv, MTaskMSGSend, BCShare
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

startupDevices :: Task [MTaskDevice]
startupDevices = upd (map reset) deviceStore
	where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}

withDevice :: (MTaskDevice -> Task a) String -> Task a | iTask a
withDevice f s = get deviceStore
	>>= \ds->case 'DL'.find (\d->d.deviceName == s) ds of
		Nothing = throw "Device not available"
		Just d = f d

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

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->upd (\l->[dev:l]) devices
			>>| connectDevice processFun dev
			@! ""
	where
		deviceSettings "SerialDevice" = getmTaskSerialDevice
		deviceSettings "TCPDevice" = getmTaskTCPDevice

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

connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
connectDevice pf d = let ch = channels d in appendTopLevelTask 'DM'.newMap True
	(pf d ch -||- catchAll (getSynFun d.deviceData ch) errorHandle)
	>>= \tid->withDevices d (\d->{d&deviceTask=Just tid,deviceError=Nothing})
	>>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch
	@! ()
	where
		errorHandle e = withDevices d (\d->{d&deviceTask=Nothing,deviceError=Just e})

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

viewDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task ()
viewDevice pf d = forever $ traceValue "viewDevice" >>| 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):
				if (isJust d.deviceTask) []
				[OnAction (Action "Connect") (always $ connectDevice pf 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
//	>>| upd (removeShares d) sdsStore
	@! ()


sendMessages :: [MTaskMSGSend] -> (MTaskDevice -> Task Channels)
sendMessages msgs = upd (\(r,s,ss)->(r,msgs++s,ss)) o channels

withDevices :: MTaskDevice (MTaskDevice -> MTaskDevice) -> Task ()
withDevices a trans = upd (map \b->if (b == a) (trans b) b) deviceStore @! ()

deviceTaskAcked :: MTaskDevice Int Int -> Task ()
deviceTaskAcked dev i mem
	= withDevices dev (\d->{d
			&deviceTasks=ackFirst d.deviceTasks
			,deviceSpec=Just {fromJust d.deviceSpec & bytesMemory=mem}})
	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 = sendMessages [MTTaskDel task.ident] dev @! ()

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

deviceAddSpec :: MTaskDevice MTaskDeviceSpec -> Task ()
deviceAddSpec d s = withDevices d $ \r->{MTaskDevice | r & deviceSpec=Just s}