mirror of
https://github.com/rowtype-yoga/purs-eval.git
synced 2024-12-02 09:15:19 +03:00
61 lines
1.9 KiB
Plaintext
61 lines
1.9 KiB
Plaintext
module Test.Main where
|
|
|
|
import Prelude (Unit, ($), (==), (>>=), unit, pure, bind, const)
|
|
import Control.Apply ((*>))
|
|
import Control.Monad.Error.Class (throwError, liftMaybe)
|
|
import Control.Monad.Reader.Trans (ReaderT, ask, runReaderT)
|
|
import Effect
|
|
import Effect.Aff (Aff, bracket)
|
|
import Effect.Class (liftEffect)
|
|
import Effect.Exception (error)
|
|
import HTTPure.Request (Request)
|
|
import HTTPure.Response (ok)
|
|
import HTTPure.Server (serve)
|
|
import HTTPure.Body (class Body)
|
|
import HTTPure.Lookup ((!!))
|
|
import HTTPure.Method (Method(Post))
|
|
import Test.Unit (suite, test)
|
|
import Test.Unit.Main (runTest)
|
|
import Test.Unit.Assert (equal)
|
|
import Main (Settings, runCompiler)
|
|
|
|
type RequestValidator = ReaderT Request Aff
|
|
|
|
settings :: Settings
|
|
settings = { protocol: "http", hostname: "localhost", port: 3000 }
|
|
|
|
validatePath :: RequestValidator Unit
|
|
validatePath = do
|
|
let invalidPath = error "invalid path"
|
|
missingPath = error "missing path"
|
|
req <- ask
|
|
p <- liftMaybe missingPath $ req.path !! 0
|
|
case p == "compile" of
|
|
true -> pure unit
|
|
false -> throwError invalidPath
|
|
|
|
validateMethod :: RequestValidator Unit
|
|
validateMethod = ask >>= case _ of
|
|
{ method: Post } -> pure unit
|
|
_ -> throwError $ error "invalid method"
|
|
|
|
runReqValidator :: Request -> Aff Unit
|
|
runReqValidator req = runReaderT (validatePath *> validateMethod) req
|
|
|
|
mockSrv :: forall a. Body a => a -> Aff (Effect Unit)
|
|
mockSrv res = do
|
|
close <- liftEffect $ serve settings.port (\req -> runReqValidator req *> ok res) $ pure unit
|
|
pure $ close $ pure unit
|
|
|
|
setupSrv :: forall a b. Body a => a -> Aff b -> Aff b
|
|
setupSrv res act = bracket (mockSrv res) liftEffect (const act)
|
|
|
|
main :: Effect Unit
|
|
main = runTest do
|
|
suite "compile" do
|
|
test "produces expected output" do
|
|
let expected = "compiled-code"
|
|
compile = runCompiler settings
|
|
actual <- setupSrv expected (compile "code")
|
|
expected `equal` actual
|