git.iko.soy/rowtype-yoga/purs-eval
on main help sign in
refact: add Compiler module, improve ServerMock
commit2d33830fa32a28b32588b3040a38cd455d69887a authorWalker <walker@praiseweb.com.br> dateMon 31 Oct 2022, 12:55 (4 years ago) parent532cb5c
5 files changed+130−106
compare with main
unifiedsplit
src/Compiler.purs+38 src/Main.purs+4−42 test/Compiler.purs+18 test/Compiler/ServerMock.purs+65 test/Main.purs+5−64
src/Compiler.pursnew file+38
@@ -0,0 +1,38 @@
1+module Compiler (Settings, Code, runCompiler) where
2+
3+import Prelude (bind, pure, show, ($), (<<<))
4+import Control.Monad.Error.Class (liftEither)
5+import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask)
6+import Control.Monad.Trans.Class (lift)
7+import Data.Bifunctor (lmap)
8+import Data.Maybe (Maybe(Just))
9+import Data.Monoid ((<>))
10+import Effect.Aff (Aff, error)
11+import Affjax.ResponseFormat (string)
12+import Affjax.Node (post, printError)
13+import Affjax.RequestBody (RequestBody (String))
14+
15+type Settings = { protocol :: String, hostname :: String, port :: Int }
16+type Code = String
17+type Compiler = ReaderT Code (ReaderT Settings Aff)
18+
19+askCode :: Compiler Code
20+askCode = ask
21+
22+askSettings :: Compiler Settings
23+askSettings = lift ask
24+
25+liftAff :: forall a. Aff a -> Compiler a
26+liftAff h = lift $ lift h
27+
28+compile :: Compiler Code
29+compile = do
30+ code <- askCode
31+ s <- askSettings
32+ let url = s.protocol <> "://" <> s.hostname <> ":" <> show s.port <> "/compile"
33+ mRes <- liftAff $ post string url $ Just $ String code
34+ res <- liftEither $ (error <<< printError) `lmap` mRes
35+ pure res.body
36+
37+runCompiler :: Settings -> Code -> Aff Code
38+runCompiler s code = runReaderT (runReaderT compile code) s
src/Main.purs+4−42
@@ -1,50 +1,12 @@
1−module Main where
1+module Main (main) where
22
3−import Prelude (Unit, ($), (<<<), void, pure, bind, show, discard)
4−import Control.Bind ((=<<))
5−import Control.Monad.Error.Class (liftEither)
6−import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask)
7−import Control.Monad.Trans.Class (lift)
8−import Data.Bifunctor (lmap)
9−import Data.Maybe (Maybe(Just))
10−import Data.Monoid ((<>))
3+import Prelude (Unit, bind, discard)
114import Data.Tuple (Tuple (Tuple))
12−import Data.Array (concat)
135import Effect (Effect)
14−import Effect.Aff (Aff, error, launchAff_)
15−import Effect.Class (liftEffect)
16−import Node.Buffer (Buffer)
6+import Effect.Aff (launchAff_)
177import Node.Process (stdin, stdout)
18−import Node.Stream (pipe)
198import Node.Stream.Aff (readSome, write, end, toStringUTF8, fromStringUTF8)
20−import Affjax.ResponseFormat (string)
21−import Affjax.Node (post, printError)
22−import Affjax.RequestBody (RequestBody (String))
23−
24−type Settings = { protocol :: String, hostname :: String, port :: Int }
25−type Code = String
26−type Compiler = ReaderT Code (ReaderT Settings Aff)
27−
28−askCode :: Compiler Code
29−askCode = ask
30−
31−askSettings :: Compiler Settings
32−askSettings = lift ask
33−
34−liftAff :: forall a. Aff a -> Compiler a
35−liftAff h = lift $ lift h
36−
37−compile :: Compiler Code
38−compile = do
39− code <- askCode
40− s <- askSettings
41− let url = s.protocol <> "://" <> s.hostname <> ":" <> show s.port <> "/compile"
42− mRes <- liftAff $ post string url $ Just $ String code
43− res <- liftEither $ (error <<< printError) `lmap` mRes
44− pure res.body
45−
46−runCompiler :: Settings -> Code -> Aff Code
47−runCompiler s code = runReaderT (runReaderT compile code) s
9+import Compiler (runCompiler)
4810
4911main :: Effect Unit
5012main = launchAff_ do
test/Compiler.pursnew file+18
@@ -0,0 +1,18 @@
1+module Test.Compiler (runTests) where
2+
3+import Prelude (Unit, bind)
4+import Effect
5+import Test.Unit (suite, test)
6+import Test.Unit.Main (runTest)
7+import Test.Unit.Assert (equal)
8+import Test.Compiler.ServerMock (settings, setupSrv)
9+import Compiler (runCompiler)
10+
11+runTests :: Effect Unit
12+runTests = runTest do
13+ suite "compile" do
14+ test "produces expected output" do
15+ let expected = "compiled-code"
16+ compile = runCompiler settings
17+ actual <- setupSrv expected (compile "code")
18+ expected `equal` actual
test/Compiler/ServerMock.pursnew file+65
@@ -0,0 +1,65 @@
1+module Test.Compiler.ServerMock (settings, setupSrv) where
2+
3+import Prelude (Unit, ($), (==), (>>=), unit, pure, bind, const)
4+import Control.Apply ((*>))
5+import Control.Monad.Error.Class (throwError, liftMaybe)
6+import Control.Monad.Reader.Trans (ReaderT, ask, runReaderT)
7+import Control.Monad.Trans.Class (lift)
8+import Effect
9+import Effect.Aff (Aff, bracket)
10+import Effect.Class (liftEffect)
11+import Effect.Exception (error)
12+import HTTPure.Request (Request)
13+import HTTPure.Response (ResponseM, Response, ok)
14+import HTTPure.Server (serve)
15+import HTTPure.Lookup ((!!))
16+import HTTPure.Method (Method(Post))
17+import Compiler (Settings, Code)
18+
19+type ServerMock = ReaderT Code (ReaderT Request Aff)
20+
21+askRes :: ServerMock Code
22+askRes = ask
23+
24+askReq :: ServerMock Request
25+askReq = lift ask
26+
27+liftAff :: forall a. Aff a -> ServerMock a
28+liftAff h = lift $ lift h
29+
30+settings :: Settings
31+settings = { protocol: "http", hostname: "localhost", port: 3000 }
32+
33+validatePath :: ServerMock Unit
34+validatePath = do
35+ let invalidPath = error "invalid path"
36+ missingPath = error "missing path"
37+ req <- askReq
38+ p <- liftMaybe missingPath $ req.path !! 0
39+ case p == "compile" of
40+ true -> pure unit
41+ false -> throwError invalidPath
42+
43+validateMethod :: ServerMock Unit
44+validateMethod = askReq >>= case _ of
45+ { method: Post } -> pure unit
46+ _ -> throwError $ error "invalid method"
47+
48+validate :: ServerMock Unit
49+validate = validatePath *> validateMethod
50+
51+answer :: ServerMock Response
52+answer = do
53+ res <- askRes
54+ liftAff $ ok res
55+
56+runServerMock :: Code -> Request -> ResponseM
57+runServerMock res req = runReaderT (runReaderT (validate *> answer) res) req
58+
59+launchServerMock :: Code -> Aff (Effect Unit)
60+launchServerMock res = do
61+ close <- liftEffect $ serve settings.port (\req -> runServerMock res req) $ pure unit
62+ pure $ close $ pure unit
63+
64+setupSrv :: forall b. Code -> Aff b -> Aff b
65+setupSrv code act = bracket (launchServerMock code) liftEffect (const act)
test/Main.purs+5−64
@@ -1,67 +1,8 @@
1−module Test.Main where
1+module Test.Main (main) where
22
3−import Prelude (Unit, ($), (==), (>>=), unit, pure, bind, const)
4−import Control.Apply ((*>))
5−import Control.Monad.Error.Class (throwError, liftMaybe)
6−import Control.Monad.Reader.Trans (ReaderT, ask, runReaderT)
7−import Control.Monad.Trans.Class (lift)
8−import Effect
9−import Effect.Aff (Aff, bracket)
10−import Effect.Class (liftEffect)
11−import Effect.Exception (error)
12−import HTTPure.Request (Request)
13−import HTTPure.Response (ok)
14−import HTTPure.Server (serve)
15−import HTTPure.Body (class Body)
16−import HTTPure.Lookup ((!!))
17−import HTTPure.Method (Method(Post))
18−import Test.Unit (suite, test)
19−import Test.Unit.Main (runTest)
20−import Test.Unit.Assert (equal)
21−import Main (Settings, Code, runCompiler)
22−
23−type ServerMock = ReaderT Code (ReaderT Request Aff)
24−
25−askCode :: ServerMock Code
26−askCode = ask
27−
28−askReq :: ServerMock Request
29−askReq = lift ask
30−
31−settings :: Settings
32−settings = { protocol: "http", hostname: "localhost", port: 3000 }
33−
34−validatePath :: ServerMock Unit
35−validatePath = do
36− let invalidPath = error "invalid path"
37− missingPath = error "missing path"
38− req <- askReq
39− p <- liftMaybe missingPath $ req.path !! 0
40− case p == "compile" of
41− true -> pure unit
42− false -> throwError invalidPath
43−
44−validateMethod :: ServerMock Unit
45−validateMethod = askReq >>= case _ of
46− { method: Post } -> pure unit
47− _ -> throwError $ error "invalid method"
48−
49−runServerMock :: Code -> Request -> Aff Unit
50−runServerMock res req = runReaderT (runReaderT (validatePath *> validateMethod) res) req
51−
52−launchServerMock :: Code -> Aff (Effect Unit)
53−launchServerMock res = do
54− close <- liftEffect $ serve settings.port (\req -> runServerMock res req *> ok res) $ pure unit
55− pure $ close $ pure unit
56−
57−setupSrv :: forall b. Code -> Aff b -> Aff b
58−setupSrv code act = bracket (launchServerMock code) liftEffect (const act)
3+import Prelude (Unit)
4+import Effect (Effect)
5+import Test.Compiler as Compiler
596
607main :: Effect Unit
61−main = runTest do
62− suite "compile" do
63− test "produces expected output" do
64− let expected = "compiled-code"
65− compile = runCompiler settings
66− actual <- setupSrv expected (compile "code")
67− expected `equal` actual
8+main = Compiler.runTests