module Language.Haskell.Tools.Daemon.Mode where
import Control.Concurrent.Chan
import qualified Data.Aeson as A ()
import Data.Aeson hiding ((.=))
import Data.ByteString.Lazy.Char8 (ByteString)
import Data.ByteString.Lazy.Char8 (unpack)
import qualified Data.ByteString.Lazy.Char8 as BS
import Data.Maybe (Maybe(..), catMaybes)
import Network.Socket hiding (send, sendTo, recv, recvFrom, KeepAlive)
import Network.Socket.ByteString.Lazy (sendAll, recv)
import Language.Haskell.Tools.Daemon.Protocol (ResponseMsg, ClientMessage)
data WorkingMode a = WorkingMode { daemonConnect :: Int -> IO a
, daemonDisconnect :: a -> IO ()
, daemonSend :: a -> ResponseMsg -> IO ()
, daemonReceive :: a -> IO [Either String ClientMessage]
}
socketMode :: WorkingMode (Socket,Socket)
socketMode = WorkingMode sockConn sockDisconnect sockSend sockReceive
where
sockConn portNumber = do
sock <- socket AF_INET Stream 0
setSocketOption sock ReuseAddr 1
bind sock (SockAddrInet (read $ show portNumber) iNADDR_ANY)
listen sock 1
(conn, _) <- accept sock
return (sock,conn)
sockDisconnect (sock,conn) = close conn >> close sock
sockSend (_,conn) = sendAll conn . (`BS.snoc` '\n') . encode
sockReceive (_,conn) = do
msg <- recv conn 2048
if not $ BS.null msg
then do
let msgs = BS.split '\n' msg
in return $ catMaybes $ map decodeMsg msgs
else return []
where decodeMsg :: ByteString -> Maybe (Either String ClientMessage)
decodeMsg mess
| BS.null mess = Nothing
| otherwise = case decode mess of
Nothing -> Just $ Left $ "MALFORMED MESSAGE: " ++ unpack mess
Just req -> Just $ Right req
channelMode :: WorkingMode (Chan ResponseMsg, Chan ClientMessage)
channelMode = WorkingMode chanConn chanDisconnect chanSend chanReceive
where
chanConn _ = (,) <$> newChan <*> newChan
chanDisconnect _ = return ()
chanSend (send,_) resp = writeChan send resp
chanReceive (_,recv) = (:[]) . Right <$> readChan recv