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