module Ribosome.Host.Interpreter.Process.Socket where

import Data.Serialize (Serialize)
import qualified Network.Socket as Socket
import Network.Socket (socketToHandle)
import Path (toFilePath)
import Polysemy.Process (Process, ProcessOptions, interpretProcessHandles)
import Polysemy.Process.Data.ProcessError (ProcessError)
import System.IO (Handle, IOMode (ReadWriteMode))

import Ribosome.Host.Data.BootError (BootError (BootError))
import Ribosome.Host.Data.NvimSocket (NvimSocket (NvimSocket))
import Ribosome.Host.Interpreter.Process.Cereal (interpretProcessInputCereal, interpretProcessOutputCereal)

withSocket ::
  Members [Reader NvimSocket, Resource, Error BootError, Embed IO] r =>
  (Handle -> Sem r a) ->
  Sem r a
withSocket :: forall (r :: EffectRow) a.
Members
  '[Reader NvimSocket, Resource, Error BootError, Embed IO] r =>
(Handle -> Sem r a) -> Sem r a
withSocket Handle -> Sem r a
use =
  Sem r Socket
-> (Socket -> Sem r ()) -> (Socket -> Sem r a) -> Sem r a
forall (r :: EffectRow) a c b.
Member Resource r =>
Sem r a -> (a -> Sem r c) -> (a -> Sem r b) -> Sem r b
bracket Sem r Socket
acquire Socket -> Sem r ()
release \ Socket
socket ->
    Handle -> Sem r a
use (Handle -> Sem r a) -> Sem r Handle -> Sem r a
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Handle -> Sem r Handle
forall (m :: * -> *) (r :: EffectRow) a.
Member (Embed m) r =>
m a -> Sem r a
embed (Socket -> IOMode -> IO Handle
socketToHandle Socket
socket IOMode
ReadWriteMode)
  where
    acquire :: Sem r Socket
acquire = do
      NvimSocket Path Abs File
path <- Sem r NvimSocket
forall i (r :: EffectRow). Member (Reader i) r => Sem r i
ask
      Either BootError Socket -> Sem r Socket
forall e (r :: EffectRow) a.
Member (Error e) r =>
Either e a -> Sem r a
fromEither (Either BootError Socket -> Sem r Socket)
-> (Either Text Socket -> Either BootError Socket)
-> Either Text Socket
-> Sem r Socket
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> BootError)
-> Either Text Socket -> Either BootError Socket
forall (p :: * -> * -> *) a b c.
Bifunctor p =>
(a -> b) -> p a c -> p b c
first Text -> BootError
BootError (Either Text Socket -> Sem r Socket)
-> Sem r (Either Text Socket) -> Sem r Socket
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< IO Socket -> Sem r (Either Text Socket)
forall (r :: EffectRow) a.
Member (Embed IO) r =>
IO a -> Sem r (Either Text a)
tryAny do
        Socket
socket <- Family -> SocketType -> ProtocolNumber -> IO Socket
Socket.socket Family
Socket.AF_UNIX SocketType
Socket.Stream ProtocolNumber
0
        Socket
socket Socket -> IO () -> IO Socket
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Socket -> SockAddr -> IO ()
Socket.connect Socket
socket (String -> SockAddr
Socket.SockAddrUnix (Path Abs File -> String
forall b t. Path b t -> String
toFilePath Path Abs File
path))
    release :: Socket -> Sem r ()
release =
      IO () -> Sem r ()
forall (r :: EffectRow). Member (Embed IO) r => IO () -> Sem r ()
tryAny_ (IO () -> Sem r ()) -> (Socket -> IO ()) -> Socket -> Sem r ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Socket -> IO ()
Socket.close

interpretProcessCerealSocket ::
  ∀ a r .
  Serialize a =>
  Members [Reader NvimSocket, Error BootError, Log, Resource, Race, Async, Embed IO] r =>
  ProcessOptions ->
  InterpreterFor (Process a (Either Text a) !! ProcessError) r
interpretProcessCerealSocket :: forall a (r :: EffectRow).
(Serialize a,
 Members
   '[Reader NvimSocket, Error BootError, Log, Resource, Race, Async,
     Embed IO]
   r) =>
ProcessOptions
-> InterpreterFor (Process a (Either Text a) !! ProcessError) r
interpretProcessCerealSocket ProcessOptions
options Sem ((Process a (Either Text a) !! ProcessError) : r) a
sem =
  (Handle -> Sem r a) -> Sem r a
forall (r :: EffectRow) a.
Members
  '[Reader NvimSocket, Resource, Error BootError, Embed IO] r =>
(Handle -> Sem r a) -> Sem r a
withSocket \ Handle
handle ->
    Sem (ProcessOutput 'Stdout (Either Text a) : r) a -> Sem r a
forall a (r :: EffectRow).
Serialize a =>
InterpreterFor (ProcessOutput 'Stdout (Either Text a)) r
interpretProcessOutputCereal (Sem (ProcessOutput 'Stdout (Either Text a) : r) a -> Sem r a)
-> Sem (ProcessOutput 'Stdout (Either Text a) : r) a -> Sem r a
forall a b. (a -> b) -> a -> b
$
    Sem (ProcessInput a : ProcessOutput 'Stdout (Either Text a) : r) a
-> Sem (ProcessOutput 'Stdout (Either Text a) : r) a
forall a (r :: EffectRow).
Serialize a =>
InterpreterFor (ProcessInput a) r
interpretProcessInputCereal (Sem (ProcessInput a : ProcessOutput 'Stdout (Either Text a) : r) a
 -> Sem (ProcessOutput 'Stdout (Either Text a) : r) a)
-> Sem
     (ProcessInput a : ProcessOutput 'Stdout (Either Text a) : r) a
-> Sem (ProcessOutput 'Stdout (Either Text a) : r) a
forall a b. (a -> b) -> a -> b
$
    ProcessOptions
-> Handle
-> Handle
-> InterpreterFor
     (Process a (Either Text a) !! ProcessError)
     (ProcessInput a : ProcessOutput 'Stdout (Either Text a) : r)
forall i o (r :: EffectRow).
Members
  '[ProcessInput i, ProcessOutput 'Stdout o, Resource, Race, Async,
    Embed IO]
  r =>
ProcessOptions
-> Handle
-> Handle
-> InterpreterFor (Process i o !! ProcessError) r
interpretProcessHandles ProcessOptions
options Handle
handle Handle
handle (Sem ((Process a (Either Text a) !! ProcessError) : r) a
-> Sem
     ((Process a (Either Text a) !! ProcessError)
        : ProcessInput a : ProcessOutput 'Stdout (Either Text a) : r)
     a
forall (e2 :: (* -> *) -> * -> *) (e3 :: (* -> *) -> * -> *)
       (e1 :: (* -> *) -> * -> *) (r :: EffectRow) a.
Sem (e1 : r) a -> Sem (e1 : e2 : e3 : r) a
raiseUnder2 Sem ((Process a (Either Text a) !! ProcessError) : r) a
sem)