git.iko.soy/rowtype-yoga/psfp
on dc3b89e help sign in
rowtype-yoga/psfp/server/src/PscIdeClient.purs
171 lines 5.8 kB history raw
1module PscIdeClient where
3import Prelude
5import Data.Either (Either(..), either)
6import Data.Maybe (Maybe(..))
7import Data.Newtype (class Newtype, un, unwrap)
8import Data.Posix.Signal (Signal(..))
9import Data.String.Utils (endsWith)
10import Effect.Aff (Aff, Canceler, effectCanceler, makeAff)
11import Effect.Class (liftEffect)
12import Effect.Class.Console (log)
13import Effect.Ref (Ref)
14import Effect.Ref as Ref
15import Node.Buffer as Buf
16import Node.ChildProcess (ChildProcess, StdIOBehaviour(..))
17import Node.ChildProcess as CP
18import Node.Encoding (Encoding(..))
19import Node.FS.Aff (writeTextFile)
20import Node.Net.Socket (Socket)
21import Node.Net.Socket as Socket
22import Playground.Playground (Folder(..))
23import Simple.JSON (writeJSON)
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 -- liftEffect $ onDataString (CP.stdout cp) UTF8 \str -> do
58 -- log $ "--------" <> infoString <> "\n----------\n" <> str <> "\n----------\n"
59 log $ "Spawned ide server" <> infoString
60 -- building once
61 { error, stderr, stdout } <- execCommand folder "npx spago build"
62 stderrStr <- liftEffect $ Buf.toString UTF8 stderr
63 log $ "Built: " <> stderrStr
64 log $ "Loading modules" <> infoString
65 loadPscIde folder port
66 pure cp
67 where
68 infoString =
69 " in folder "
70 <> un Folder folder
71 <> " on port "
72 <> show port
74execCommand ∷ Folder -> String -> Aff CP.ExecResult
75execCommand folder command =
76 makeAff \callback -> do
77 let
78 options = CP.defaultExecOptions { cwd = Just (un Folder folder) }
79 childProcess <- CP.exec command options (callback <<< Right)
80 pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
82restartIdeServer ∷ Folder -> Int -> Ref ChildProcess -> Aff Unit
83restartIdeServer folder port processRef = do
84 cp <- Ref.read processRef # liftEffect
85 CP.kill SIGKILL cp # liftEffect
86 newCp <- startIdeServer folder port
87 Ref.write newCp processRef # liftEffect
89spawnProcess ∷ Folder -> String -> Array String -> Aff ChildProcess
90spawnProcess folder command args =
91 makeAff \callback -> do
92 let
93 options = CP.defaultSpawnOptions { cwd = Just (un Folder folder), stdio = Just <$> [Ignore, Ignore, Ignore] }
94 childProcess <- CP.spawn command args options
95 callback (Right childProcess)
96 pure $ effectCanceler
97 $ (log $ "Killing " <> show (CP.pid childProcess))
98 *> CP.kill SIGKILL childProcess
100newtype PscIdeConnection
101 = PscIdeConnection
102 { serverProcessRef ∷ Ref ChildProcess
103 , port ∷ Int
104 , folder ∷ Folder
105 }
107derive instance ntPscIdeConnection ∷ Newtype PscIdeConnection _
108instance eqPscIdeConnection ∷ Eq PscIdeConnection where
109 eq c1 c2 = (unwrap c1).port == (unwrap c2).port
111saveMainFile ∷ Folder -> String -> Aff Unit
112saveMainFile folder code = writeTextFile UTF8 (un Folder folder <> "/src/Main.purs") code
114getFolder ∷ PscIdeConnection -> Folder
115getFolder (PscIdeConnection { folder }) = folder
117loadPscIde ∷ Folder -> Int -> Aff Unit
118loadPscIde folder port = do
119 makeAff \affCb -> do
120 socket <- Socket.createConnectionTCP port "localhost" mempty
121 -- maybe timeout?
122 Socket.onError socket (affCb <<< Left)
123 void
124 $ Socket.writeString socket (writeJSON loadCommand <> "\n") UTF8 (affCb (Right unit))
125 liftEffect
126 $ Socket.onClose socket case _ of
127 true -> mempty -- should be covered in onError
128 false -> do
129 affCb (Right unit)
130 let
131 command = writeJSON buildCommand <> "\n"
132 Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
133 pure (closeSocketCanceller socket)
135compileCode ∷ String -> PscIdeConnection -> Aff String
136compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
137 serverProcess <- Ref.read serverProcessRef # liftEffect
138 saveMainFile folder code
139 makeAff \affCb -> do
140 log $ "Compiling on " <> show port
141 socket <- Socket.createConnectionTCP port "localhost" mempty
142 -- Socket.onError socket (affCb <<< Left)
143 resultRef <- Ref.new ""
144 Socket.onData socket \dataFromServer -> do
145 log $ "Data on port " <> show port
146 str <- dataFromServer # either (Buf.toString UTF8) pure
147 newStr <- resultRef # Ref.modify (_ <> str)
148 when (newStr # endsWith "\n") do
149 log $ "Enough data on " <> show port <> " ending socket\n"
150 void $ Socket.endString socket "" UTF8 mempty
151 affCb (Right newStr)
152 let
153 command = writeJSON buildCommand
154 Socket.onReady socket do
155 log $ "Socket " <> show port <> " ready"
156 void $ Socket.writeString socket (command <> "\n") UTF8 mempty
157 pure (closeSocketCanceller socket)
159mkConnection ∷ Folder -> Int -> Aff PscIdeConnection
160mkConnection folder port = do
161 serverProcess <- startIdeServer folder port
162 serverProcessRef <- Ref.new serverProcess # liftEffect
163 liftEffect
164 $ CP.onError serverProcess \e ->
165 log $ "Server process on port " <> show port <> " got error " <> show e
166 pure
167 $ PscIdeConnection
168 { serverProcessRef
169 , port
170 , folder
171 }