module EmacsServer where

import SynCompInterface
  
import Network.Socket hiding (recv,send)
import Network.Socket.ByteString
import Data.ByteString.Char8
import Control.Monad
import Control.Exception

type ComputeCandidate = String -> String -> Bool -> {- Int -> -} IO [EmacsDataItem]

emacsServer :: ComputeCandidate -> IO ()
emacsServer :: ComputeCandidate -> IO ()
emacsServer ComputeCandidate
computeCand = do
    Socket
sock <- Family -> SocketType -> ProtocolNumber -> IO Socket
socket Family
AF_INET SocketType
Stream ProtocolNumber
defaultProtocol
    Socket -> SocketOption -> Int -> IO ()
setSocketOption Socket
sock SocketOption
ReuseAddr Int
1
    Socket -> SockAddr -> IO ()
bind Socket
sock (PortNumber -> HostAddress -> SockAddr
SockAddrInet PortNumber
50000 HostAddress
0)
    Socket -> Int -> IO ()
listen Socket
sock Int
5
    ComputeCandidate -> Socket -> IO ()
acceptLoop ComputeCandidate
computeCand Socket
sock IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Socket -> IO ()
close Socket
sock

acceptLoop :: ComputeCandidate -> Socket -> IO ()
acceptLoop :: ComputeCandidate -> Socket -> IO ()
acceptLoop ComputeCandidate
computeCand Socket
sock = IO () -> IO ()
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    (Socket
conn, SockAddr
_) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
    (Int
cursorPos, Bool
isSimple) <- Socket -> IO (Int, Bool)
getCursorPos_and_isSimple Socket
conn
    (Int, Bool) -> IO ()
forall a. Show a => a -> IO ()
print (Int
cursorPos, Bool
isSimple)
    Socket -> IO ()
close Socket
conn
    (Socket
conn, SockAddr
_) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
    String
str <- Socket -> IO String
getSource Socket
conn
    String -> IO ()
forall a. Show a => a -> IO ()
print String
str
    Socket -> IO ()
close Socket
conn
    (Socket
conn, SockAddr
_) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
    String
strAfterCursor <- Socket -> IO String
getSource Socket
conn
    String -> IO ()
forall a. Show a => a -> IO ()
print String
strAfterCursor
    [EmacsDataItem]
candidateList <- ComputeCandidate
computeCand String
str String
strAfterCursor Bool
isSimple
    [String] -> IO ()
forall a. Show a => a -> IO ()
print ((EmacsDataItem -> String) -> [EmacsDataItem] -> [String]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map EmacsDataItem -> String
forall a. Show a => a -> String
show [EmacsDataItem]
candidateList)
    Socket -> IO ()
close Socket
conn
    (Socket
conn, SockAddr
_) <- Socket -> IO (Socket, SockAddr)
accept Socket
sock
    Socket -> [EmacsDataItem] -> IO ()
sendCandidateList Socket
conn [EmacsDataItem]
candidateList
    Socket -> IO ()
close Socket
conn

str2cursorPos_and_isSimple :: String -> (Int,Bool)
str2cursorPos_and_isSimple :: String -> (Int, Bool)
str2cursorPos_and_isSimple String
str =
  let [String
s1,String
s2] = String -> [String]
Prelude.words String
str
  in (String -> Int
forall a. Read a => String -> a
read String
s1 :: Int, String -> Bool
forall a. Read a => String -> a
read String
s2 :: Bool)

getCursorPos_and_isSimple :: Socket -> IO (Int, Bool)
getCursorPos_and_isSimple :: Socket -> IO (Int, Bool)
getCursorPos_and_isSimple Socket
conn = do
    ByteString
str <- Socket -> Int -> IO ByteString
recv Socket
conn Int
64
    (Int, Bool) -> IO (Int, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> (Int, Bool)
str2cursorPos_and_isSimple (ByteString -> String
unpack ByteString
str))

getSource :: Socket -> IO String
getSource :: Socket -> IO String
getSource Socket
conn = do
    ByteString
str <- Socket -> Int -> IO ByteString
recv Socket
conn Int
64
    if ByteString -> Int
Data.ByteString.Char8.length ByteString
str Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then
      String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> String
unpack ByteString
str)
    else do
      String
aaa <- Socket -> IO String
getSource Socket
conn
      String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return ((ByteString -> String
unpack ByteString
str) String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
aaa)

sendCandidateList :: Socket -> [EmacsDataItem] -> IO ()
sendCandidateList :: Socket -> [EmacsDataItem] -> IO ()
sendCandidateList Socket
conn [EmacsDataItem]
xs = do
    let
      f :: [EmacsDataItem] -> String
f [] = String
""
      f ((Candidate String
x) : [EmacsDataItem]
xs)      = String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
x String -> String -> String
forall a. [a] -> [a] -> [a]
++ [EmacsDataItem] -> String
f [EmacsDataItem]
xs
      f (EmacsDataItem
LexError : [EmacsDataItem]
xs)           = String
"LexError" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [EmacsDataItem] -> String
f [EmacsDataItem]
xs
      f ((ParseError [String]
_) : [EmacsDataItem]
xs)     = String
"ParseError" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [EmacsDataItem] -> String
f [EmacsDataItem]
xs
      f (EmacsDataItem
SuccessfullyParsed : [EmacsDataItem]
xs) = String
"SuccessfullyParsed" String -> String -> String
forall a. [a] -> [a] -> [a]
++ [EmacsDataItem] -> String
f [EmacsDataItem]
xs
    let
      s :: String
s = [EmacsDataItem] -> String
f [EmacsDataItem]
xs
    do
      Int
_ <- Socket -> ByteString -> IO Int
send Socket
conn (String -> ByteString
pack String
s)
      String -> IO ()
forall a. Show a => a -> IO ()
print String
s