-- | Many serial devices allow multiple commands to run at once, and-- | return their results as they finish. To make use of this,-- | multiple commands needs to read and write to the serial port at-- | once, and the return values must somehow be sorted and returned-- | back to the callers.moduleSystem.Serial.Manager(serialManager,closeSerialManager,wrapCommand,wrapCommandWithCallback,SerialManager,SerialCommand,wrapDeafCommand)whereimportSystem.IOimportControl.ConcurrentimportControl.Concurrent.MVarimportControl.MonadimportData.List(isPrefixOf)dataSerialCommand=SerialCommand{cmd::String,predicate::(String->Bool),returnPtr::MVarString}|DeafCommand{cmd::String}isDeaf::SerialCommand->BoolisDeaf(DeafCommand_)=TrueisDeaf_=FalsetoMemory::SerialCommand->[SerialMemory]toMemory(DeafCommand_)=[]toMemory(SerialCommandcprres)=[(c,pr,res)]typeSerialMemory=(String,String->Bool,MVarString)dataSerialManager=SerialManager{managedHandle::Handle,storage::MVar(EitherSerialCommandString),inputTerminator,outputTerminator::String,portMonitorThread::ThreadId}-- | 'serialManager' takes produces a structure around a 'Handle' to-- | handle multiple callers to the serial port. The return value is-- | the channel to which all commands will flow. Users should use-- | the 'wrapCommand' function to access it instead of trying to-- | access its details directly.serialManager::Handle-- ^ the handle to wrap->String-- ^ the termination string for commands received from the port->String-- ^ the termination string for command send to the port->IOSerialManagerserialManagerhinToutT=domv<-newEmptyMVar-- I use lists to hold the waiting commands, because I-- don't anticipate there being that many at once.thr<-portWatcherhinTmvletst=SerialManagerhmvinToutTthrthreadDelay1000forkIO(foldM_(processst)[](repeat()))returnst-- | Having multiple serial managers running on the same port is a disaster waiting-- to happen. When you're done with a 'SerialManager', run 'closeSerialManager' on-- it to shut it down.closeSerialManager::SerialManager->IO()closeSerialManagerm=killThread$portMonitorThreadm-- Fetch from mvar, operate on it, recurse with updated ws listprocess::SerialManager->[SerialMemory]->()->IO[SerialMemory]processstws_=dov<-takeMVar(storagest)process'vwhereprocess'(Leftc)=dohPutStr(managedHandlest)((cmdc)++outputTerminatorst)-- putStrLn $ "Sending command: " ++ cmdreturn$ws++toMemorycprocess'(Rightstr)=case(isolateWhere(\(_,pr,_)->prstr)ws)of(Nothing,ws')->do-- putStrLn ("Unmatched return: " ++ str)returnws'(Just(_,_,res),ws')->do-- putStrLn $ "Matched return: " ++ strputMVarresstrreturnws'isolateWhere::(a->Bool)->[a]->(Maybea,[a])isolateWhere_[]=(Nothing,[])isolateWherep(l:ls)|pl=(Justl,ls)|otherwise=(l',l:ls')where(l',ls')=isolateWhereplsportWatcher::Handle->String->MVar(EitherSerialCommandString)->IOThreadIdportWatcherhinTstor=forkIOportWatcher'whereportWatcher'=dos<-takeUntilhinT-- putStrLn $ "Read " ++ sputMVarstor(Rights)portWatcher'takeUntil::Handle->String->IOStringtakeUntilhterm=takeUntil'""wheretakeUntil's=ifrterm`isPrefixOf`sthenreturn(reverses)elsehGetCharh>>=\c->takeUntil'(c:s)rterm=reverseterm-- portWatcher :: SerialManager -> IO ThreadId-- portWatcher m = forkIO portWatcher'-- where portWatcher' = do l <- hGetLine (managedHandle m)-- putMVar (storage m) (Right l)-- portWatcher'-- | All the commands to operate a 'SerialManager' should be-- specializations of 'wrapCommand', created by applying it to the-- first three arguments, then using that thereafter as the command to-- the serial port.-- -- For example, the Olympus IX-81 requires a login command from the-- user (@2LOG IN@) followed by @\r\n@ as an end of line. The-- response will be @2LOG +@ followed by @\r@. So a login command-- would look like-- -- > p = ("2LOG" `isPrefixOf`)-- -- > login mgr = wrapCommand "\r\n" "2LOG IN" p-- -- 'wrapCommand' uses functions of type 'String -> Bool' users can choose-- whether or not to match any given command based upon its contents,-- rather than just blindly saying whether it matches or not.wrapCommand::String-- ^ The command to send->(String->Bool)-- ^ The predicate to recognize the returning value->SerialManager-- ^ The serial port to access->IOString-- ^ The response from the portwrapCommandcmdprmgr=domv<-newEmptyMVartryTakeMVarmv>>return()putMVar(storagemgr)(Left$SerialCommand(cmd++outputTerminatormgr)prmv)takeMVarmv-- | Some commands don't expect any response from the hardware on the far end.-- For these cases, use 'wrapDeafCommand'.wrapDeafCommand::String-- ^ The command to send->SerialManager-- ^ The serial port to access->IO()wrapDeafCommandcmdmgr=putMVar(storagemgr)(Left$DeafCommand(cmd++outputTerminatormgr))-- | Sometimes we don't want the current thread to block, but we still -- want some action when the a command returns from the serial port. To-- that end, 'wrapCommandWithCallback' lets us pass a function of type-- 'String -> IO ()' to be executed when a response is recognized-- by the predicate.wrapCommandWithCallback::String-- ^ The command to send->(String->Bool)-- ^ The predicate to recognize the returning value->(String->IO())-- ^ The callback to run when the command returns->SerialManager-- ^ The serial port to access->IOThreadId-- ^ The thread id in which the command is being runwrapCommandWithCallbackcmdprcallbackmgr=doforkIO$wrapCommandcmdprmgr>>=callback