Skip to content
Merged
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
15 changes: 9 additions & 6 deletions server/Main.hs
Original file line number Diff line number Diff line change
Expand Up @@ -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')
Expand All @@ -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)
Expand Down Expand Up @@ -59,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"))
Expand All @@ -72,7 +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
desugared <- P.desugar 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
Expand Down Expand Up @@ -167,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
2 changes: 1 addition & 1 deletion stack.yaml
Original file line number Diff line number Diff line change
Expand Up @@ -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
Expand Down
8 changes: 4 additions & 4 deletions stack.yaml.lock
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand Down
4 changes: 2 additions & 2 deletions trypurescript.cabal
Original file line number Diff line number Diff line change
@@ -1,5 +1,5 @@
name: trypurescript
version: 0.13.5
version: 0.13.6
cabal-version: >=1.8
build-type: Simple
license: BSD3
Expand All @@ -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.*,
Expand Down