module miTask

import StdDebug, StdMisc
from StdFunc import flip

import iTasks
import mTask

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

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

import iTasks.UI.Definition

import iTasks._Framework.TaskState
import iTasks._Framework.TaskServer
import iTasks._Framework.IWorld
import iTasks._Framework.Store


import TTY

derive class iTask Queue, TTYSettings, Parity, BaudRate, ByteSize
derive class iTask MTaskMSGRecv, MTaskMSGSend, SerTCP, UserLED

:: *Resource | TTYd !*TTY
:: Channels :== ([MTaskMSGRecv], [MTaskMSGSend], Bool)

:: SerTCP = SerialDevice | TCPDevice
:: MTaskDevice = {
		deviceConnected :: Maybe String,
		deviceName :: String
	}

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

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}
derive class iTask MTaskDeviceStatus, MTaskDevice

mTaskManager :: Task ()
mTaskManager = anyTask 
		[ viewmTasks @! ()
		, viewShares
		, whileUnchanged deviceStore viewDevices
		] <<@ ApplyLayout layout
	where
		isValue (Value _ _) = True
		isValue _			= False

		viewmTasks = enterChoice "Available mTasks" [ChooseFromList id] ["ledder", "ledon", "ledoff"]
			>>= viewInformation "" []

		layout = sequenceLayouts
			[ arrangeWithSideBar 0 LeftSide 260 True
			, arrangeSplit Vertical True
			]

		viewShares :: Task ()
		viewShares = viewInformation () [] ()

		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 
				||- (case d.deviceConnected of
					Just s = viewSharedInformation "Channels" [] (channels d.deviceName) @! ()
					Nothing = viewInformation "No channels yet" [] "" @! ()
				)) <<@ ArrangeHorizontal

		channels :: String -> Shared Channels
		channels s = sdsFocus s $ memoryStore "" $ Just ([], [], False)

		addDevice :: (Shared [MTaskDevice]) -> Task ()
		addDevice devices = enterInformation "Device type and name" []
			>>= \(name, ty)->get randomInt @ ((+++) name o toString)
			>>= \realname->let ch = channels realname in case ty of
				TCPDevice = enterInformation "Hostname and port" []
					>>= \(host, port)->cont realname name ||- syncNetworkChannel host port ch
				SerialDevice = accWorld getDevices
					>>= \dl->(enterChoice "Device" [] dl -&&- updateInformation "Settings" [] zero)
					>>= \(device, settings)->cont realname name ||- syncSerialChannel device settings ch
			where
				cont rn nm = (upd (\l->[dev rn nm:l]) devices >>| addDevice devices)
				dev rn nm = {deviceConnected=Just rn,deviceName=nm}

				getDevices :: !*World -> *(![String], !*World)
				getDevices w = case readDirectory "/dev" w of
					(Error (errcode, errmsg), w) = abort errmsg
					(Ok entries, w) = (map ((+++) "/dev/") (filter isTTY entries), w)

				isTTY s = not (isEmpty (filter (flip startsWith s) prefixes))
				prefixes = ["ttyS", "ttyACM", "ttyUSB", "tty.usbserial"]

//		connectDevice :: [MTaskDevice] -> Task ()
//		connectDevice [] = treturn ()
//		connectDevice [d:ds] = (case d.deviceConnected of
//			(Just sh) = viewSharedInformation "Buffers" [] sh @! ()
//			Nothing = viewInformation ("Connect " +++ d.deviceName) [] "" >>* [
//				OnAction (Action "connect") (const $ Just $ connect d)]
//			) -|| connectDevice ds

		deviceviewer :: [MTaskDevice] -> [MTaskDeviceStatus]
		deviceviewer ds = [{MTaskDeviceStatus | name = d.deviceName,
			connected = if (isNothing d.deviceConnected) False True}\\d<-ds]
	
		deviceStore :: Shared [MTaskDevice]
		deviceStore = sdsFocus "mTaskDevices" $ memoryStore "" (Just [])

//		showTabbed :: [MTaskDevice] -> Task ()
//		showTabbed [] = viewInformation "" [] "No devices yet" @! ()
//		showTabbed [l:ls] = foldr (\e es->manageDevice e ||- es) (manageDevice l) ls
//
//		manageDevice :: MTaskDevice -> Task ()
//		manageDevice md = 
//				either viewTCP viewSer md.deviceSettings
//			||- maybe
//				(treturn () >>* [OnAction (Action "Connect") (always shutDown)] @! ())
//				(\b->viewSharedInformation "Buffers" [] b @! ())
//				md.deviceConnected
//			<<@ ArrangeVertical

		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 (||-)


//mTaskTask :: Task ()
//mTaskTask = let (msgs, sdsShares) = makeMsgs 1000 bc in
//	withDevice \ch->
//			sendMsg msgs ch
//		||- processMessages ch messageShare sdsShares
//		||- forever (enterChoice "Choose led to enable" [] [LED1, LED2, LED3]
//				>>= \p->sendMsg (fst (makeMsgs 0 (bc2 p))) ch)
//		||- forever (enterChoice "Choose led to disable" [] [LED1, LED2, LED3]
//				>>= \p->sendMsg (fst (makeMsgs 0 (bc3 p))) ch)
//		||- viewSharedInformation "channels" [ViewAs lens] ch
//		||- viewSharedInformation "messages" [] messageShare
//		||- viewSh sdsShares ch
//		>>* [OnAction ActionFinish (always shutDown)]
//	where
//		messageShare :: Shared [String]
//		messageShare = sharedStore "mTaskMessagesRecv" []
//
//		processMessages ch msgs sdss = forever (watch ch
//			>>* [OnValue (ifValue (not o isEmpty o fst3) (process ch))])
//			where
//				process :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) ([MTaskMSGRecv],[MTaskMSGSend],Bool) -> Task ()
//				process ch (r,_,_) = upd (appFst3 (const [])) ch >>| process` r
//					where
//						process` = foldr (\r t->updateSDSs sdss msgs r >>| t) (return ())
//
//		makeMsgs :: Int (Main (ByteCode () Stmt)) -> ([MTaskMSGSend], [(Int, Shared Int)])
//		makeMsgs timeout bc
//		# (msgs, st) = toMessages timeout (toRealByteCode (unMain bc))
//		= (msgs, map f st.sdss)
//			where 
//				f (i,d) = (i, sharedStore ("mTaskSDS-" +++ toString i) (dd d))
//				dd [x,y] = toInt x*265 + toInt y
//
//		updateSDSs :: [(Int, Shared Int)] (Shared [String]) MTaskMSGRecv -> Task ()
//		updateSDSs [(id, sh):xs] m n=:(MTPub i d)
//		| id == i = set ((toInt d.[0])*265 + toInt d.[1]) sh @! ()
//		= updateSDSs xs m n
//		updateSDSs _ m mtm = case mtm of
//			MTMessage s = upd (\l->take 5 [s:l]) m @! ()
//			mta=:(MTTaskAck _) = upd (\l->take 5 [toString mta:l]) m @! ()
//			//TODO other recv msgs
//			_ = return ()
//
//		lens :: ([MTaskMSGRecv], [MTaskMSGSend],Bool) -> ([String], [String])
//		lens (r,s,_) = (map toString r, map toString s)
//
//		viewSh :: [(Int, Shared Int)] (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
//		viewSh [] ch = return ()
//		viewSh [(i, sh):xs] ch
//		# sharename = "SDS-" +++ toString i
//		= (
//				viewSharedInformation ("SDS-" +++ toString i) [] sh ||-
//				forever (
//					enterInformation sharename []
//					>>* [OnAction ActionOk 
//							(ifValue (\j->j>=1 && j <= 3) 
//							(\c->set c sh
//								>>= \_->sendMsg (toSDSUpdate i c) ch
//								@! ()
//							)
//						)]
//				)
//			) ||- viewSh xs ch

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

syncSerialChannel :: String TTYSettings (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) -> Task ()
syncSerialChannel dev opts rw = Task eval
	where
		eval event evalOpts tree=:(TCInit taskId ts) iworld=:{IWorld|world}
		= case TTYopen dev opts world of
			(False, _, world)
			# (err, world) = TTYerror world
			= (ExceptionResult (exception err), {iworld & world=world})
			(True, tty, world)
			# iworld = {iworld & world=world, resources=Just (TTYd tty)}
			= case addBackgroundTask 42 (BackgroundTask (serialDeviceBackgroundTask rw)) iworld of
				(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
				(Ok _, iworld) = (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=True} NoChange (TCBasic taskId ts JSONNull False), iworld)

		eval _ _ tree=:(TCBasic _ ts _ _) iworld
		= (ValueResult NoValue {TaskEvalInfo|lastEvent=ts,removedTasks=[],refreshSensitive=False} NoChange tree, iworld)

		eval event evalOpts tree=:(TCDestroy _) iworld=:{IWorld|resources,world}
		# (TTYd tty) = fromJust resources
		# (ok, world) = TTYclose tty world
		# iworld = {iworld & world=world,resources=Nothing}
		= case removeBackgroundTask 42 iworld of
			(Error e, iworld) = (ExceptionResult (exception "h"), iworld)
			(Ok _, iworld) = (DestroyedResult, iworld)

serialDeviceBackgroundTask :: (Shared ([MTaskMSGRecv],[MTaskMSGSend],Bool)) !*IWorld -> (MaybeError TaskException (), *IWorld)
serialDeviceBackgroundTask rw iworld
	= case read rw iworld of
		(Error e, iworld) = (Error $ exception "share couldn't be read", iworld)
		(Ok (r,s,ss), iworld)
		# (Just (TTYd tty)) = iworld.resources
		# tty = writet (map encode s) tty
		# (ml, tty) = case TTYavailable tty of
			(False, tty) = ([], tty)
			(_, tty)
			# (l, tty) = TTYreadline tty
			= ([decode l], tty)
		# iworld = {iworld & resources=Just (TTYd tty)}
		= case write (r++ml,[],False) rw iworld of
			(Error e, iworld) = (Error $ exception "share couldn't be written", iworld)
			(Ok _, iworld) = case notify rw iworld of
				(Error e, iworld) = (Error $ exception "share couldn't be notified", iworld)
				(Ok _, iworld) = (Ok (), iworld)
	where
		writet :: [String] -> (*TTY -> *TTY)
		writet [] = id
		writet [x:xs] = writet xs o TTYwrite x


syncNetworkChannel :: String Int (Shared ([MTaskMSGRecv], [MTaskMSGSend], Bool)) -> Task ()
syncNetworkChannel server port channel
	= tcpconnect server port channel {ConnectionHandlers|onConnect=onConnect,whileConnected=whileConnected,onDisconnect=onDisconnect} @! ()
	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, Nothing, [], False)

		whileConnected (Just newData) acc (msgs,send,sendStopped)
		| 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)