module miTask

import StdDebug, StdMisc
from StdFunc import flip

import iTasks
import mTask
import Devices.mTaskDevice

from Text import class Text(startsWith,concat,split,join), instance Text String

import qualified Data.Map as DM

from Data.Func import $
import Data.Tuple
import Data.List
import System.Directory

import iTasks._Framework.Store

import TTY, iTasksTTY

derive class iTask UserLED

:: MTaskShare = {
		initValue :: Int,
		withTask :: String,
		identifier :: Int,
		realShare :: String
	}

Start :: *World -> *World
Start world = startEngine (mTaskManager
	>>* [OnAction (Action "Shutdown") (always $ shutDown)]) world

memoryShare :: String a -> Shared a | iTask a
memoryShare s d = sdsFocus s $ memoryStore "" $ Just d

deviceStore :: Shared [MTaskDevice]
deviceStore = sharedStore "mTaskDevices" []

sdsStore :: Shared [MTaskShare]
sdsStore = memoryShare "mTaskShares" []

bcStateStore :: Shared BCState
bcStateStore = memoryShare "mTaskBCState" zero

mTaskTaskStore :: Shared [String]
mTaskTaskStore = memoryShare "mTaskTasks" ["count", "ledon", "ledoff"]

mTaskMap :: Map String (Main (ByteCode () Stmt))
mTaskMap = 'DM'.fromList [("count", bc), ("ledon", bc2 LED1), ("ledoff", bc3 LED3)]

bc :: Main (ByteCode () Stmt)
bc = sds \x=1 In sds \pinnetje=1 In {main =
		IF (digitalRead D3) (
			x =. x +. lit 1 :.
			pub x
		) (
			noOp
		) :.
		IF (pinnetje ==. lit 1) (
			ledOn LED1
		) (
			IF (pinnetje ==. lit 2) (
				ledOn LED2
			) (
				ledOn LED3
			)
		)}

bc2 :: UserLED -> Main (ByteCode () Stmt)
bc2 d = {main = ledOn d}

bc3 :: UserLED -> Main (ByteCode () Stmt)
bc3 d = {main = ledOff d}

:: MTaskDeviceStatus = {connected :: Bool, name :: String, tasks :: [String]}
derive class iTask MTaskDeviceStatus, MTaskShare, BCState

mTaskManager :: Task ()
mTaskManager = anyTask 
		[ viewmTasks @! ()
		, whileUnchanged sdsStore viewShares
		, whileUnchanged deviceStore viewDevices
		] <<@ ApplyLayout layout
	where
		layout = sequenceLayouts
			[ arrangeWithSideBar 0 LeftSide 260 True
			, arrangeSplit Vertical True
			]

		viewmTasks = listmTasks
			>&^ \sh->whileUnchanged sh $ \mi->forever (case mi of
				Nothing = viewInformation "No task selected" [] ()
				Just mTaskTask = get deviceStore
					>>= \devices->case devices of
						[] = viewInformation "No devices yet" [] ()
						ds = sendmTask mTaskTask ds @! ())
			where
				listmTasks :: Task String
				listmTasks = enterChoiceWithShared "Available mTasks" [ChooseFromList id] mTaskTaskStore

				sendmTask mTaskId ds = 
						(enterChoice "Choose Device" [ChooseFromDropdown \t->t.deviceName] ds
						-&&- enterInformation "Timeout, 0 for one-shot" [])
					>>* [OnAction (Action "Send") (withValue $ Just o sendToDevice mTaskId)]

				sendToDevice :: String (MTaskDevice, Int) -> Task ()
				sendToDevice mTask (device, timeout) =
						get bcStateStore @ createBytecode
					>>= \(msgs, st1)->set st1 bcStateStore @ toSDSRecords
					>>= \sdss->upd ((++)sdss) sdsStore//MTaskShareaddToSDSShare
					>>| makeShares sdss
					>>| upd (\(r,s,ss)->(r,s++msgs,ss)) (channels device)
					@! ()
					where
						createBytecode st = toMessages timeout $ toRealByteCode (unMain $ fromJust ('DM'.get mTask mTaskMap)) 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 ())

		getSDSStore :: MTaskShare -> Shared Int
		getSDSStore sh = memoryShare sh.realShare 0

		getSDSRecord :: Int -> Task MTaskShare
		getSDSRecord i = get sdsStore @ \l->hd [s\\s<-l | s.identifier == i]

		viewShares :: [MTaskShare] -> Task ()
		viewShares st = anyTask $ map viewer st
			where
				viewer :: MTaskShare -> Task ()
				viewer m = viewSharedInformation "" [] (getSDSStore m)
					<<@ Title ("SDS: " +++ toString m.identifier) @! ()
//				enterChoiceWithShared "Shares" [ChooseFromList id] sdsStore
//			>>* [OnValue $ withValue $ Just o updateShare]
//			>>* [OnAction (Action "Back") (const $ Just $ treturn ())]
//			where
//				sdsvw (k, v) = concat ["SDS ", toString k, ": ", toString v]
//				updateShare s = viewInformation "" [] ()
//				updateShare (k, v) = (viewInformation "Key" [] k
//					||- updateInformation "Value" [] v)
					

		viewDevices :: [MTaskDevice] -> Task ()
		viewDevices ds = anyTask [
				addDevice deviceStore <<@ Title "Add new device" @! ():
					[viewDevice d <<@ Title d.deviceName\\d<-ds]]
			<<@ ArrangeWithTabs @! ()
		
		viewDevice :: MTaskDevice -> Task ()
		viewDevice d = (viewInformation "Device settings" [] d 
				||- viewSharedInformation "Channels" [ViewAs dropEmpty] (channels d) @! ()
				) <<@ ArrangeHorizontal
			where
				dropEmpty (r,s,ss) = (filter ((=!=)MTEmpty) r,s,ss)


//		addDevice :: (Shared [MTaskDevice]) -> Task SerTCP
//		addDevice devices = enterInformation "Device type" []
//			>&^ \sh->whileUnchanged sh $ \mty->case mty of
//				Nothing = viewInformation "No type selected yet" [] "" @! ()
//				Just ty = case ty of
//					TCPDevice = (enterInformation "Name" [] -&&- enterInformation "Hostname" [] -&&- enterInformation "Port" [])
//						>>= \(name, (host, port))->cont name (syncNetworkChannel host port)
//					SerialDevice = (enterInformation "Name" [] -&&- enterTTYSettings)
//						>>= \(name, set)->cont name (syncSerialChannel set encode decode)
//			where
//				cont :: String ((Shared Channels) -> Task ()) -> Task ()
//				cont name synfun = get randomInt 
//					@ (\randint->{deviceChannels=name +++ toString randint, deviceName=name, deviceTasks=[], deviceTask=Nothing})
//					>>= \dev->appendTopLevelTask 'DM'.newMap True (let ch = channels dev in process ch -||- synfun ch)
//					>>= \tid->upd (\l->[{dev & deviceTask=Just tid}:l]) devices
//					@! ()

		process :: (Shared Channels) -> Task ()
		process ch = forever (watch ch >>* [OnValue (
				ifValue (not o isEmpty o fst3)
				(\t->upd (appFst3 (const [])) ch >>| process (fst3 t)))])
 			where
				process :: [MTaskMSGRecv] -> Task ()
 				process [] = treturn ()
				process [m:ms] = (case m of
					MTTaskAck i = traceValue (toString m) @! ()
					MTTaskDelAck i = traceValue (toString m) @! ()
					MTSDSAck i = traceValue (toString m) @! ()
					MTSDSDelAck i = traceValue (toString m) @! ()
					MTPub i val = getSDSRecord i >>= set (toInt val.[0]*256 + toInt val.[1]) o getSDSStore @! ()
					MTMessage val = traceValue (toString m) @! ()
					MTEmpty = treturn ()
					) >>| process ms

		deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
		deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
			connected = if (isNothing d.deviceTask) False True,
			tasks = [s +++ toString i\\(s, i)<-d.deviceTasks]}\\d<-ds]

		mapPar :: (a -> Task a) [a] -> Task ()
		mapPar f l = foldr1 (\x y->f x ||- y) l <<@ ArrangeWithTabs @! ()
		allAtOnce t = foldr1 (||-) t @! ()
		//allAtOnce = (flip (@!) ()) o foldr1 (||-)

sendMsg :: [MTaskMSGSend] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
sendMsg m ch = upd (\(r,s,ss)->(r,s ++ m,True)) ch @! ()

syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
syncNetworkChannel server port channel = catchAll
		(tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ())
		(\v->traceValue v @! ())
	where
		onConnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
		onConnect _ (msgs,send,sendStopped)
			= (Ok "", Just (msgs,[],sendStopped), map encode send, False)

		whileConnected :: (Maybe String) String ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool), [String], Bool)
		
		//whileConnected Nothing acc (msgs,send,sendStopped)
		//= (Ok acc, Just (msgs,[],sendStopped), map encode send, False)
		whileConnected mnewData acc (msgs,send,sendStopped)
		= (Ok acc, Just (msgs ++ map decode (maybeToList mnewData),[],sendStopped), map encode send, False)
		//| sendStopped = (Ok acc, Just (msgs ++ [decode newData],[],False), map encode send, False)
//		= (Ok acc, Just (msgs ++ [decode newData],[],False), [], False)
		
		onDisconnect :: String ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> (MaybeErrorString String, Maybe ([MTaskMSGRecv],[MTaskMSGSend],Bool))
		onDisconnect l (msgs,send,sendStopped) = (Ok l, Nothing)