From ae814c24e1afadbb853afa8ce7cccfd8a98bcfe5 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sat, 2 May 2020 20:50:10 +0100
Subject: [PATCH 1/2] Update to PureScript v0.13.6

---
 server/Main.hs      | 6 ++++--
 stack.yaml          | 2 +-
 stack.yaml.lock     | 8 ++++----
 trypurescript.cabal | 4 ++--
 4 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/server/Main.hs b/server/Main.hs
index a04eef1b..8d24a79c 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -7,7 +7,7 @@
 
 module Main (main) where
 
-import           Control.Monad (unless, (>=>))
+import           Control.Monad (unless, (>=>), foldM)
 import           Control.Monad.Error.Class (throwError)
 import           Control.Monad.IO.Class (liftIO)
 import           Control.Monad.Logger (runLogger')
@@ -16,6 +16,7 @@ import qualified Control.Monad.State as State
 import           Control.Monad.Trans (lift)
 import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)
 import           Control.Monad.Trans.Reader (runReaderT)
+import           Control.Monad.Writer.Strict (runWriterT)
 import qualified Data.Aeson as A
 import           Data.Aeson ((.=))
 import           Data.Bifunctor (first, second)
@@ -72,7 +73,8 @@ server externs initEnv port = do
             Right m | P.getModuleName m == P.ModuleName [P.ProperName "Main"] -> do
               (resultMay, ws) <- runLogger' . runExceptT . flip runReaderT P.defaultOptions $ do
                 ((P.Module ss coms moduleName elaborated exps, env), nextVar) <- P.runSupplyT 0 $ do
-                  desugared <- P.desugar externs [P.importPrim m] >>= \case
+                  env <- fmap fst . runWriterT $ foldM P.externsEnv P.primEnv externs
+                  desugared <- P.desugar env externs [P.importPrim m] >>= \case
                     [d] -> pure d
                     _ -> error "desugaring did not produce one module"
                   P.runCheck' (P.emptyCheckState initEnv) $ P.typeCheckModule desugared
diff --git a/stack.yaml b/stack.yaml
index 64a5e58f..22a9a09f 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -8,7 +8,7 @@ flags:
 packages:
 - '.'
 extra-deps:
-- purescript-0.13.5
+- purescript-0.13.6
 - happy-1.19.9
 - language-javascript-0.7.0.0
 - network-3.0.1.1
diff --git a/stack.yaml.lock b/stack.yaml.lock
index 3f6fc1a3..320edef0 100644
--- a/stack.yaml.lock
+++ b/stack.yaml.lock
@@ -5,12 +5,12 @@
 
 packages:
 - completed:
-    hackage: purescript-0.13.5@sha256:1e54e144cf2271fae7149734bdae2c79e215c204782d867f68f557a2c3c2472c,62027
+    hackage: purescript-0.13.6@sha256:4c17cdc0e8d51bb79f6fd3dd2beeda30dcf7297a76bbe3a37a49924e95d2b4fc,62060
     pantry-tree:
-      size: 95425
-      sha256: af427d485cd2a6d99008aa8f877ce19bc06e97bbe78ff4122b3e0843caf19e49
+      size: 95494
+      sha256: afbab4292ca1243d0d52fd32ec48f8261ffb7f91c40922dd637688a700df88e9
   original:
-    hackage: purescript-0.13.5
+    hackage: purescript-0.13.6
 - completed:
     hackage: happy-1.19.9@sha256:f8c774230735a390c287b2980cfcd2703d24d8dde85a01ea721b7b4b4c82944f,4667
     pantry-tree:
diff --git a/trypurescript.cabal b/trypurescript.cabal
index 8ba73a44..803084ae 100644
--- a/trypurescript.cabal
+++ b/trypurescript.cabal
@@ -1,5 +1,5 @@
 name: trypurescript
-version: 0.13.5
+version: 0.13.6
 cabal-version: >=1.8
 build-type: Simple
 license: BSD3
@@ -20,7 +20,7 @@ executable trypurescript
                    filepath -any,
                    Glob -any,
                    scotty -any,
-                   purescript ==0.13.5,
+                   purescript ==0.13.6,
                    containers -any,
                    http-types >= 0.8.5,
                    transformers ==0.5.*,

From 0fdc72db214b22603fbd0b069cf34ced106744c8 Mon Sep 17 00:00:00 2001
From: Harry Garrood <harry@garrood.me>
Date: Sat, 2 May 2020 21:27:37 +0100
Subject: [PATCH 2/2] Build the names env once, before starting the server

---
 server/Main.hs | 13 +++++++------
 1 file changed, 7 insertions(+), 6 deletions(-)

diff --git a/server/Main.hs b/server/Main.hs
index 8d24a79c..44eb94d7 100644
--- a/server/Main.hs
+++ b/server/Main.hs
@@ -60,8 +60,8 @@ data Error
 
 instance A.ToJSON Error
 
-server :: [P.ExternsFile] -> P.Environment -> Int -> IO ()
-server externs initEnv port = do
+server :: [P.ExternsFile] -> P.Env -> P.Environment -> Int -> IO ()
+server externs initNamesEnv initEnv port = do
   let compile :: Text -> IO (Either Error ([P.JSONError], JS))
       compile input
         | T.length input > 20000 = return (Left (OtherError "Please limit your input to 20000 characters"))
@@ -73,8 +73,7 @@ server externs initEnv port = do
             Right m | P.getModuleName m == P.ModuleName [P.ProperName "Main"] -> do
               (resultMay, ws) <- runLogger' . runExceptT . flip runReaderT P.defaultOptions $ do
                 ((P.Module ss coms moduleName elaborated exps, env), nextVar) <- P.runSupplyT 0 $ do
-                  env <- fmap fst . runWriterT $ foldM P.externsEnv P.primEnv externs
-                  desugared <- P.desugar env externs [P.importPrim m] >>= \case
+                  desugared <- P.desugar initNamesEnv externs [P.importPrim m] >>= \case
                     [d] -> pure d
                     _ -> error "desugaring did not produce one module"
                   P.runCheck' (P.emptyCheckState initEnv) $ P.typeCheckModule desugared
@@ -169,7 +168,9 @@ main = do
   let onError f = either (Left . f) Right
   e <- runExceptT $ do
     modules <- ExceptT $ I.loadAllModules inputFiles
-    ExceptT . I.runMake . I.make $ map (second CST.pureResult) modules
+    (exts, env) <- ExceptT . I.runMake . I.make $ map (second CST.pureResult) modules
+    namesEnv <- fmap fst . runWriterT $ foldM P.externsEnv P.primEnv exts
+    pure (exts, namesEnv, env)
   case e of
     Left err -> print err >> exitFailure
-    Right (exts, env) -> server exts env port
+    Right (exts, namesEnv, env) -> server exts namesEnv env port