git.iko.soy/rowtype-yoga/psfp
on 191a78d help sign in
rowtype-yoga/psfp/server/src/PscIdeClient.purs
170 lines 5.7 kB history raw
1module PscIdeClient where
3import Prelude
4import Data.Either (Either(..), either)
5import Data.Maybe (Maybe(..))
6import Data.Newtype (class Newtype, un, unwrap)
7import Data.Posix.Signal (Signal(..))
8import Data.String.Utils (endsWith)
9import Effect.Aff (Aff, Canceler, effectCanceler, makeAff)
10import Effect.Class (liftEffect)
11import Effect.Class.Console (log)
12import Effect.Ref (Ref)
13import Effect.Ref as Ref
14import Node.Buffer as Buf
15import Node.ChildProcess (ChildProcess)
16import Node.ChildProcess as CP
17import Node.Encoding (Encoding(..))
18import Node.FS.Aff (writeTextFile)
19import Node.Net.Socket (Socket)
20import Node.Net.Socket as Socket
21import Playground.Playground (Folder(..))
22import Simple.JSON (writeJSON)
24type BuildCommand
25 = { command ∷ String
26 , params ∷
27 { file ∷ String
28 }
29 }
31loadCommand ∷
32 { command ∷ String
33 }
34loadCommand =
35 { command: "load"
36 }
38buildCommand ∷ BuildCommand
39buildCommand =
40 { "command": "rebuild"
41 , "params": { "file": "src/Main.purs" }
42 }
44closeSocketCanceller ∷ Socket -> Canceler
45closeSocketCanceller s =
46 effectCanceler
47 $ unlessM
48 (Socket.destroyed s) do
49 -- Socket.end s (pure unit)
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) }
94 childProcess <- CP.spawn command args options
95 callback (Right childProcess)
96 pure $ effectCanceler ((log $ "Killing " <> show (CP.pid childProcess)) *> CP.kill SIGKILL childProcess)
98newtype PscIdeConnection
99 = PscIdeConnection
100 { serverProcessRef ∷ Ref ChildProcess
101 , port ∷ Int
102 , folder ∷ Folder
103 }
105derive instance ntPscIdeConnection :: Newtype PscIdeConnection _
106instance eqPscIdeConnection :: Eq PscIdeConnection where
107 eq c1 c2 = (unwrap c1).port == (unwrap c2).port
109saveMainFile ∷ Folder -> String -> Aff Unit
110saveMainFile folder code = writeTextFile UTF8 (un Folder folder <> "/src/Main.purs") code
112getFolder ∷ PscIdeConnection -> Folder
113getFolder (PscIdeConnection { folder }) = folder
115loadPscIde ∷ Folder -> Int -> Aff Unit
116loadPscIde folder port = do
117 makeAff \affCb -> do
118 socket <- Socket.createConnectionTCP port "localhost" mempty
119 -- maybe timeout?
120 Socket.onError socket (affCb <<< Left)
121 void
122 $ Socket.writeString socket (writeJSON loadCommand <> "\n") UTF8 (affCb (Right unit))
123 liftEffect
124 $ Socket.onClose socket case _ of
125 true -> mempty -- should be covered in onError
126 false -> do
127 affCb (Right unit)
128 let
129 command = writeJSON buildCommand <> "\n"
130 Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
131 pure (closeSocketCanceller socket)
133compileCode ∷ String -> PscIdeConnection -> Aff String
134compileCode code (PscIdeConnection { port, folder, serverProcessRef }) = do
135 serverProcess :: ChildProcess <- Ref.read serverProcessRef # liftEffect
136 saveMainFile folder code
137 makeAff \affCb -> do
138 socket <- Socket.createConnectionTCP port "localhost" mempty
139 -- maybe timeout?
140 Socket.onError socket (affCb <<< Left)
141 resultRef <- Ref.new ""
142 Socket.onData socket \dataFromServer -> do
143 str <- dataFromServer # either (Buf.toString UTF8) pure
144 newStr <- resultRef # Ref.modify (_ <> str)
145 when (newStr # endsWith "\n") do
146 Socket.endString socket "" UTF8 mempty
147 liftEffect
148 $ Socket.onClose socket case _ of
149 true -> mempty -- should be covered in onError
150 false -> do
151 res <- Ref.read resultRef
152 affCb (Right res)
153 let
154 command = writeJSON buildCommand <> "\n"
155 Socket.onReady socket (void $ Socket.writeString socket command UTF8 mempty)
156 pure (closeSocketCanceller socket)
158mkConnection ∷ Folder -> Int -> Aff PscIdeConnection
159mkConnection folder port = do
160 serverProcess <- startIdeServer folder port
161 serverProcessRef <- Ref.new serverProcess # liftEffect
162 liftEffect
163 $ CP.onError serverProcess \e ->
164 log $ "Server process on port " <> show port <> " got error " <> show e
165 pure
166 $ PscIdeConnection
167 { serverProcessRef
168 , port
169 , folder
170 }