git.iko.soy/rowtype-yoga/psfp
on da9406d help sign in
rowtype-yoga/psfp/server/src/PscIdeClient.purs
165 lines 5.7 kB history raw
1module PscIdeClient where
3import Prelude
4import Data.Argonaut.Encode
5import Data.Argonaut.Core
6import Data.Either (Either(..), either)
7import Data.Maybe (Maybe(..))
8import Data.Newtype (class Newtype, un, unwrap)
9import Data.Posix.Signal (Signal(..))
10import Data.String.Utils (endsWith)
11import Effect.Aff (Aff, Canceler, effectCanceler, makeAff)
12import Effect.Class (liftEffect)
13import Effect.Class.Console (log)
14import Effect.Ref (Ref)
15import Effect.Ref as Ref
16import Node.Buffer as Buf
17import Node.ChildProcess (ChildProcess, StdIOBehaviour(..))
18import Node.ChildProcess as CP
19import Node.Encoding (Encoding(..))
20import Node.FS.Aff (writeTextFile)
21import Node.Net.Socket (Socket)
22import Node.Net.Socket as Socket
23import Playground.Playground (Folder(..))
25type BuildCommand =
26 { command ∷ String
27 , params ∷
28 { file ∷ String
29 }
30 }
32loadCommand ∷
33 { command ∷ String
34 }
35loadCommand =
36 { command: "load"
37 }
39buildCommand ∷ BuildCommand
40buildCommand =
41 { "command": "rebuild"
42 , "params": { "file": "src/Main.purs" }
43 }
45closeSocketCanceller ∷ Socket -> Canceler
46closeSocketCanceller s =
47 effectCanceler
48 $ unlessM
49 (Socket.destroyed s) do
50 log $ "Destroying socket..."
51 Socket.destroy s Nothing
53startIdeServer ∷ Folder -> Int -> Aff ChildProcess
54startIdeServer folder port = do
55 log $ "Spawning ide server" <> infoString
56 cp <- spawnProcess folder "npx" [ "purs", "ide", "server", "-p", show port, "--editor-mode", "--no-watch" ]
57 log $ "Spawned ide server" <> infoString
58 -- building once
59 { error, stderr, stdout } <- execCommand folder "npx spago build"
60 stderrStr <- liftEffect $ Buf.toString UTF8 stderr
61 log $ "Built: " <> stderrStr
62 log $ "Loading modules: " <> infoString
63 loadPscIde folder port
64 pure cp
65 where
66 infoString =
67 " in folder "
68 <> un Folder folder
69 <> " on port "
70 <> show port
72execCommand ∷ Folder -> String -> Aff CP.ExecResult
73execCommand folder command =
74 makeAff \callback -> do
75 let options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
76 childProcess <- CP.exec command options (callback <<< Right)
77 pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
79restartIdeServer ∷ Folder -> Int -> Ref ChildProcess -> Aff Unit
80restartIdeServer folder port processRef = do
81 cp <- Ref.read processRef # liftEffect
82 CP.kill SIGKILL cp # liftEffect
83 newCp <- startIdeServer folder port
84 Ref.write newCp processRef # liftEffect
86spawnProcess ∷ Folder -> String -> Array String -> Aff ChildProcess
87spawnProcess folder command args =
88 makeAff \callback -> do
89 let options = CP.defaultSpawnOptions { cwd = Just (un Folder folder), stdio = Just <$> [ Ignore, Ignore, Ignore ] }
90 childProcess <- CP.spawn command args options
91 callback (Right childProcess)
92 pure $ effectCanceler
93 $ (log $ "Killing " <> show (CP.pid childProcess))
94 *> CP.kill SIGKILL childProcess
96newtype PscIdeConnection = PscIdeConnection
97 { serverProcessRef ∷ Ref ChildProcess
98 , port ∷ Int
99 , folder ∷ Folder
100 }
102derive instance ntPscIdeConnection ∷ Newtype PscIdeConnection _
104instance eqPscIdeConnection ∷ Eq PscIdeConnection where
105 eq c1 c2 = (unwrap c1).port == (unwrap c2).port
107saveMainFile ∷ Folder -> String -> Aff Unit
108saveMainFile folder code = writeTextFile UTF8 (un Folder folder <> "/src/Main.purs") code
110getFolder ∷ PscIdeConnection -> Folder
111getFolder (PscIdeConnection { folder }) = folder
113loadPscIde ∷ Folder -> Int -> Aff Unit
114loadPscIde folder port = do
115 makeAff \affCb -> do
116 socket <- Socket.createConnectionTCP port "localhost" mempty
117 -- maybe timeout?
118 Socket.onError socket (affCb <<< Left)
119 void
120 $ Socket.writeString socket ((stringify <<< encodeJson) loadCommand <> "\n") UTF8 (affCb (Right unit))
121 liftEffect
122 $ Socket.onClose socket case _ of
123 true -> mempty -- should be covered in onError
124 false -> do
125 affCb (Right unit)
126 let command = (stringify <<< encodeJson) buildCommand <> "\n"
127 Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
128 pure (closeSocketCanceller socket)
130compileCode ∷ String -> PscIdeConnection -> Aff String
131compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
132 serverProcess <- Ref.read serverProcessRef # liftEffect
133 saveMainFile folder code
134 makeAff \affCb -> do
135 log $ "Compiling on " <> show port
136 socket <- Socket.createConnectionTCP port "localhost" mempty
137 -- Socket.onError socket (affCb <<< Left)
138 resultRef <- Ref.new ""
139 Socket.onData socket \dataFromServer -> do
140 log $ "Data on port " <> show port
141 str <- dataFromServer # either (Buf.toString UTF8) pure
142 newStr <- resultRef # Ref.modify (_ <> str)
143 when (newStr # endsWith "\n") do
144 log $ "Enough data on " <> show port <> " ending socket\n"
145 void $ Socket.endString socket "" UTF8 mempty
146 affCb (Right newStr)
147 let command = (stringify <<< encodeJson) buildCommand
148 Socket.onReady socket do
149 log $ "Socket " <> show port <> " ready"
150 void $ Socket.writeString socket (command <> "\n") UTF8 mempty
151 pure (closeSocketCanceller socket)
153mkConnection ∷ Folder -> Int -> Aff PscIdeConnection
154mkConnection folder port = do
155 serverProcess <- startIdeServer folder port
156 serverProcessRef <- Ref.new serverProcess # liftEffect
157 liftEffect
158 $ CP.onError serverProcess \e ->
159 log $ "Server process on port " <> show port <> " got error " <> show e
160 pure
161 $ PscIdeConnection
162 { serverProcessRef
163 , port
164 , folder
165 }