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 Data.Tuple
import Data.List
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) deviceStoreNP
	where reset d = {d & deviceTask=Nothing, deviceTasks=[], deviceError=Nothing}

withDevice :: (MTaskDevice -> Task a) String -> Task a | iTask a
withDevice f s = get deviceStoreNP
	>>= \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
		,deviceState=zero
		,deviceData=res
		,deviceSpec=Nothing
		,deviceShares=[]}

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

addDevice :: (MTaskDevice (Shared Channels) -> Task ()) -> Task String
addDevice 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->traceValue "make device done"
			>>| upd (\l->[dev:l]) deviceStoreNP
			>>| traceValue "update deviceslist"
			>>| connectDevice processFun dev
			>>| traceValue "device connected"
			@! ""
	where
		deviceSettings "SerialDevice" = getmTaskSerialDevice
		deviceSettings "TCPDevice" = getmTaskTCPDevice

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

import StdDebug
connectDevice :: (MTaskDevice (Shared Channels) -> Task ()) MTaskDevice -> Task Channels
connectDevice procFun device = let ch = channels device
	in traceValue "connectDevice" >>| appendTopLevelTask 'DM'.newMap True
		(	procFun device ch -||- catchAll (getSynFun device.deviceData ch) errHdl)
		>>= \tid->upd (\d->{d&deviceTask=Just tid,deviceError=Nothing}) (deviceShare device)
		>>| upd (\(r,s,ss)->(r,s++[MTSpec],ss)) ch
	where
		errHdl e
		| not (trace_tn "error") = undef
		= upd (\d->{d & deviceTask=Nothing, deviceError=Just e}) (deviceShare device) @! ()

manageDevices :: (MTaskDevice (Shared Channels) -> Task ()) -> Task ()
manageDevices processFun = whileUnchanged deviceStoreNP $ \ds->anyTask [
		addDevice 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" [ViewAs noShares] 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
		noShares d = {d & deviceShares=[], deviceTasks=[]}
		dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)

deleteDevice :: MTaskDevice -> Task ()
deleteDevice d = sendMessages [MTShutdown] d
	>>| wait "Waiting for the channels to empty" (\(r,s,ss)->isEmpty s) (channels d)
	>>| upd (\(r,s,ss)->(r,s,True)) (channels d)
	>>| maybe (treturn ()) (flip removeTask topLevelTasks) d.deviceTask
	>>| upd (filter ((<>)d)) deviceStoreNP
//	>>| cleanSharesDevice d.deviceName
	@! ()

sendMessages :: [MTaskMSGSend] MTaskDevice -> Task Channels
sendMessages msgs dev = upd (realMessageSend msgs) $ channels dev

sendMessagesIW :: [MTaskMSGSend] MTaskDevice *IWorld -> *(MaybeError TaskException (), *IWorld)
sendMessagesIW msgs dev iworld 
	= modify (tuple () o realMessageSend msgs) (channels dev) iworld

realMessageSend :: [MTaskMSGSend] Channels -> Channels
realMessageSend msgs (r,s,ss) = (r,msgs++s,ss)

deviceTaskAcked :: MTaskDevice Int Int -> Task MTaskDevice
deviceTaskAcked dev i mem
	= upd (\d->{d
			& deviceTasks=ackFirst d.deviceTasks
			, deviceSpec=Just {fromJust d.deviceSpec & bytesMemory=mem}})
		$ deviceShare dev
	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 MTaskDevice
deviceTaskDeleteAcked d i = cleanSharesTask i d
	>>| upd deleteTask (deviceShare d)
	where deleteTask d = {d & deviceTasks=[s\\s<-d.deviceTasks | i <> s.ident]}

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

deviceShare :: MTaskDevice -> Shared MTaskDevice
deviceShare d = mapReadWriteError 
	( \ds->mb2error (exception "Device lost") $ find ((==)d) ds
	, \w ds->case splitWith ((==)d) ds of
		([], _) = Error $ exception "Device lost"
		([_], ds) = Ok $ Just [w:ds]
	) $ sdsFocus (Just (d, -1)) deviceStore