Update server to 0.13

Author: hdgarrood

server/Main.hs

@@ -18,9 +18,11 @@ import           Control.Monad.Trans.Except (ExceptT(..), runExceptT)
 import           Control.Monad.Trans.Reader (runReaderT)
 import qualified Data.Aeson as A
 import           Data.Aeson ((.=))
+import           Data.Bifunctor (first, second)
 import qualified Data.ByteString.Lazy as BL
 import           Data.Function (on)
 import           Data.List (foldl', nubBy)
+import qualified Data.List.NonEmpty as NE
 import qualified Data.Map as M
 import           Data.String (fromString)
 import           Data.Text (Text)
@@ -30,6 +32,8 @@ import qualified Data.Text.Lazy as TL
 import           Data.Traversable (for)
 import           GHC.Generics (Generic)
 import qualified Language.PureScript as P
+import qualified Language.PureScript.CST as CST
+import qualified Language.PureScript.CST.Monad as CSTM
 import qualified Language.PureScript.Bundle as Bundle
 import qualified Language.PureScript.CodeGen.JS as J
 import qualified Language.PureScript.CodeGen.JS.Printer as P
@@ -63,13 +67,15 @@ server bundled externs initEnv port = do
         | T.length input > 20000 = return (Left (OtherError "Please limit your input to 20000 characters"))
         | otherwise = do
           let printErrors = P.prettyPrintMultipleErrors (P.defaultPPEOptions { P.ppeCodeColor = Nothing })
-          case P.parseModuleFromFile (const "<file>") (undefined, input) of
+          case CST.parseModuleFromFile "<file>" input >>= CST.resFull of
             Left parseError ->
-              return . Left . CompilerErrors . pure . P.toJSONError False P.Error . P.toPositionedError $ parseError
-            Right (_, m) | P.getModuleName m == P.ModuleName [P.ProperName "Main"] -> do
+              return . Left . CompilerErrors . P.toJSONErrors False P.Error $ CST.toMultipleErrors "<file>" parseError
+            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]
+                  desugared <- P.desugar externs [P.importPrim m] >>= \case
+                    [d] -> pure d
+                    _ -> error "desugaring did not produce one module"
                   P.runCheck' (P.emptyCheckState initEnv) $ P.typeCheckModule desugared
                 regrouped <- P.createBindingGroups moduleName . P.collapseBindingGroups $ elaborated
                 let mod' = P.Module ss coms moduleName regrouped exps
@@ -80,7 +86,8 @@ server bundled externs initEnv port = do
               case resultMay of
                 Left errs -> (return . Left . CompilerErrors . P.toJSONErrors False P.Error) errs
                 Right js -> (return . Right) (P.toJSONErrors False P.Error ws, js)
-            Right _ -> (return . Left. OtherError) "The name of the main module should be Main."
+            Right _ ->
+              (return . Left . OtherError) "The name of the main module should be Main."
 
   scotty port $ do
     get "/" $
@@ -147,9 +154,15 @@ replaceTypeVariablesAndDesugar f ty = State.evalState (P.everywhereOnTypesM go t
     other -> pure other
 
 tryParseType :: Text -> Maybe P.SourceType
-tryParseType = hush (P.lex "") >=> hush (P.runTokenParser "" (P.parsePolyType <* Parsec.eof))
+tryParseType = hush . fmap (CST.convertType "<file>") . runParser CST.parseTypeP
   where
-    hush f = either (const Nothing) Just . f
+    hush = either (const Nothing) Just
+
+    runParser :: CST.Parser a -> Text -> Either String a
+    runParser p =
+       first (CST.prettyPrintError . NE.head)
+        . CST.runTokenParser (p <* CSTM.token CST.TokEof)
+        . CST.lexTopLevel
 
 bundle :: IO (Either Bundle.ErrorMessage String)
 bundle = runExceptT $ do
@@ -168,7 +181,7 @@ main = do
   let onError f = either (Left . f) Right
   e <- runExceptT $ do
     modules <- ExceptT (fmap (onError Right) (I.loadAllModules inputFiles))
-    (exts, env) <- ExceptT . fmap (onError Right) . I.runMake . I.make $ modules
+    (exts, env) <- ExceptT . fmap (onError Right) . I.runMake . I.make . map (second CST.pureResult) $ modules
     js <- ExceptT (fmap (onError Left) bundle)
     return (fromString js, exts, env)
   case e of

stack.yaml

@@ -1,7 +1,16 @@
-resolver: lts-12.0
-flags: {}
+resolver: lts-13.26
+flags:
+  aeson-pretty:
+    lib-only: true
+  these:
+    assoc: false
+    quickcheck: false
 packages:
 - '.'
 extra-deps:
-- purescript-0.12.3
-- pipes-http-1.0.5
+- purescript-0.13.5
+- happy-1.19.9
+- language-javascript-0.7.0.0
+- network-3.0.1.1
+- these-1.0.1
+- semialign-1

stack.yaml.lock

@@ -0,0 +1,54 @@
+# This file was autogenerated by Stack.
+# You should not edit this file by hand.
+# For more information, please see the documentation at:
+#   https://docs.haskellstack.org/en/stable/lock_files
+
+packages:
+- completed:
+    hackage: purescript-0.13.5@sha256:1e54e144cf2271fae7149734bdae2c79e215c204782d867f68f557a2c3c2472c,62027
+    pantry-tree:
+      size: 95425
+      sha256: af427d485cd2a6d99008aa8f877ce19bc06e97bbe78ff4122b3e0843caf19e49
+  original:
+    hackage: purescript-0.13.5
+- completed:
+    hackage: happy-1.19.9@sha256:f8c774230735a390c287b2980cfcd2703d24d8dde85a01ea721b7b4b4c82944f,4667
+    pantry-tree:
+      size: 7980
+      sha256: 1f1d622f6e773e7a674da6364b755714c76c3fbb3c7a4e65deaf07242fc15211
+  original:
+    hackage: happy-1.19.9
+- completed:
+    hackage: language-javascript-0.7.0.0@sha256:3eab0262b8ac5621936a4beab6a0f97d0e00a63455a8b0e3ac1547b4088dae7d,3898
+    pantry-tree:
+      size: 2244
+      sha256: b0f28d836cb3fbde203fd7318a896c3a20acd8653a905e1950ae2d9a64bccebf
+  original:
+    hackage: language-javascript-0.7.0.0
+- completed:
+    hackage: network-3.0.1.1@sha256:1a251b790ea98b6f7433f677958f921950780ba6f143d61ba8c0e3f7a9879097,4074
+    pantry-tree:
+      size: 3296
+      sha256: 78e378780c998faaf4e32a16b98880220f502d8ef005f24d7ee0c99fb50636e6
+  original:
+    hackage: network-3.0.1.1
+- completed:
+    hackage: these-1.0.1@sha256:7ff0f309978604015d978fb155ac4dc10a98e3d70a99aa2be8f755eb0cca4324,3191
+    pantry-tree:
+      size: 351
+      sha256: 3257ef64424e9a07e2ae750eff7affcd459811c4669cb67a5e4f43ab833c5aba
+  original:
+    hackage: these-1.0.1
+- completed:
+    hackage: semialign-1@sha256:f11b3d8d0f31a3556061ec0fb515575646d162f12c5b25a0f07c92679db7d862,2433
+    pantry-tree:
+      size: 466
+      sha256: e67b833b94b7fa23afbf7088833a38596cf35a2b93635604dd9e49d0389360fe
+  original:
+    hackage: semialign-1
+snapshots:
+- completed:
+    size: 499889
+    url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/26.yaml
+    sha256: ecb02ee16829df8d7219e7d7fe6c310819820bf335b0b9534bce84d3ea896684
+  original: lts-13.26

trypurescript.cabal

@@ -1,5 +1,5 @@
 name: trypurescript
-version: 0.12.3
+version: 0.13.5
 cabal-version: >=1.8
 build-type: Simple
 license: BSD3
@@ -20,7 +20,7 @@ executable trypurescript
                    filepath -any,
                    Glob -any,
                    scotty -any,
-                   purescript ==0.12.3,
+                   purescript ==0.13.5,
                    containers -any,
                    http-types >= 0.8.5,
                    transformers ==0.5.*,