@@ -58,7 +58,7 @@ instance A.ToJSON Error
58
58
59
59
server :: TL. Text -> [P. ExternsFile ] -> P. Environment -> Int -> IO ()
60
60
server bundled externs initEnv port = do
61
- let compile :: Text -> IO (Either Error JS )
61
+ let compile :: Text -> IO (Either Error ([ P. JSONError ], JS ) )
62
62
compile input
63
63
| T. length input > 20000 = return (Left (OtherError " Please limit your input to 20000 characters" ))
64
64
| otherwise = do
@@ -67,7 +67,7 @@ server bundled externs initEnv port = do
67
67
Left parseError ->
68
68
return . Left . CompilerErrors . pure . P. toJSONError False P. Error . P. toPositionedError $ parseError
69
69
Right (_, m) | P. getModuleName m == P. ModuleName [P. ProperName " Main" ] -> do
70
- (resultMay, _ ) <- runLogger' . runExceptT . flip runReaderT P. defaultOptions $ do
70
+ (resultMay, ws ) <- runLogger' . runExceptT . flip runReaderT P. defaultOptions $ do
71
71
((P. Module ss coms moduleName elaborated exps, env), nextVar) <- P. runSupplyT 0 $ do
72
72
[desugared] <- P. desugar externs [P. importPrim m]
73
73
P. runCheck' (P. emptyCheckState initEnv) $ P. typeCheckModule desugared
@@ -79,7 +79,7 @@ server bundled externs initEnv port = do
79
79
P. evalSupplyT nextVar $ P. prettyPrintJS <$> J. moduleToJs renamed Nothing
80
80
case resultMay of
81
81
Left errs -> (return . Left . CompilerErrors . P. toJSONErrors False P. Error ) errs
82
- Right js -> (return . Right ) js
82
+ Right js -> (return . Right ) ( P. toJSONErrors False P. Error ws, js)
83
83
Right _ -> (return . Left . OtherError ) " The name of the main module should be Main."
84
84
85
85
scotty port $ do
@@ -96,8 +96,8 @@ server bundled externs initEnv port = do
96
96
case response of
97
97
Left err ->
98
98
Scotty. json $ A. object [ " error" .= err ]
99
- Right comp ->
100
- Scotty. json $ A. object [ " js" .= comp ]
99
+ Right (warnings, comp) ->
100
+ Scotty. json $ A. object [ " js" .= comp, " warnings " .= warnings ]
101
101
get " /search" $ do
102
102
query <- param " q"
103
103
Scotty. setHeader " Access-Control-Allow-Origin" " *"
0 commit comments