c5609ef · rowtype-yoga/purs-eval

git.iko.soy/rowtype-yoga/purs-eval

on main help sign in

feat: add capabilities and launch the compiler

c5609efWalker4 years ago

flake.nix+2

compare with main

unifiedsplit

@@ -33,10 +33,12 @@

33 debug

34 aff

35 effect

36+ node-buffer

36 node-process

37 node-process

37 test-unit

38 test-unit

38 httpure

39 httpure

39 affjax-node

40 affjax-node

41+ node-streams-aff

40 ];

42 ];

42 foreign."Affjax.Node".node_modules = npm.node_modules { src = ./.; } + /node_modules;

44 foreign."Affjax.Node".node_modules = npm.node_modules { src = ./.; } + /node_modules;

src/Main.purs+40−7

@@ -1,23 +1,56 @@

1module Main where

3−import Prelude (Unit, ($), (<<<), void, pure, bind)

3+import Prelude (Unit, ($), (<<<), void, pure, bind, show, discard)

4−

4+import Control.Bind ((=<<))

5import Control.Monad.Error.Class (liftEither)

6+import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask)

7+import Control.Monad.Trans.Class (lift)

6import Data.Bifunctor (lmap)

8import Data.Bifunctor (lmap)

7import Data.Maybe (Maybe(Just))

9import Data.Maybe (Maybe(Just))

10+import Data.Monoid ((<>))

11+import Data.Tuple (Tuple (Tuple))

12+import Data.Array (concat)

8import Effect (Effect)

13import Effect (Effect)

9−import Effect.Aff (Aff, error)

14+import Effect.Aff (Aff, error, launchAff_)

15+import Effect.Class (liftEffect)

16+import Node.Buffer (Buffer)

10import Node.Process (stdin, stdout)

17import Node.Process (stdin, stdout)

11import Node.Stream (pipe)

18import Node.Stream (pipe)

19+import Node.Stream.Aff (readSome, write, end, toStringUTF8, fromStringUTF8)

12import Affjax.ResponseFormat (string)

20import Affjax.ResponseFormat (string)

13import Affjax.Node (post, printError)

21import Affjax.Node (post, printError)

14import Affjax.RequestBody (RequestBody (String))

22import Affjax.RequestBody (RequestBody (String))

16−compile :: String -> Aff String

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+

17−compile s = do

37+compile :: Compiler Code

38+compile = do

39+ code <- askCode

40+ s <- askSettings

41+ let url = s.protocol <> "://" <> s.hostname <> ":" <> show s.port <> "/compile"

18− mRes <- post string "http://localhost:3000/compile" $ Just $ String s

42+ mRes <- liftAff $ post string url $ Just $ String code

19 res <- liftEither $ (error <<< printError) `lmap` mRes

43 res <- liftEither $ (error <<< printError) `lmap` mRes

20 pure res.body

44 pure res.body

46+runCompiler :: Settings -> Code -> Aff Code

47+runCompiler s code = runReaderT (runReaderT compile code) s

48+

22main :: Effect Unit

49main :: Effect Unit

23−main = void $ stdin `pipe` stdout

50+main = launchAff_ do

51+ Tuple input _ <- readSome stdin

52+ code <- toStringUTF8 input

53+ code' <- runCompiler { protocol: "https", hostname: "try.purescript.org", port: 80 } code

54+ output <- fromStringUTF8 code'

55+ write stdout output

56+ end stdout

test/Main.purs+8−4

@@ -2,12 +2,12 @@ module Test.Main where

3import Prelude (Unit, ($), (==), (>>=), unit, pure, bind, const)

4import Control.Apply ((*>))

5−import Control.Monad.Error.Class (class MonadThrow, throwError, liftMaybe)

5+import Control.Monad.Error.Class (throwError, liftMaybe)

6import Control.Monad.Reader.Trans (ReaderT, ask, runReaderT)

7import Effect

8import Effect.Aff (Aff, bracket)

9import Effect.Class (liftEffect)

10−import Effect.Exception (Error, error)

10+import Effect.Exception (error)

11import HTTPure.Request (Request)

12import HTTPure.Response (ok)

13import HTTPure.Server (serve)

@@ -17,10 +17,13 @@ import HTTPure.Method (Method(Post))

17import Test.Unit (suite, test)

18import Test.Unit.Main (runTest)

19import Test.Unit.Assert (equal)

20−import Main (compile)

20+import Main (Settings, runCompiler)

22type RequestValidator = ReaderT Request Aff Unit

24+settings :: Settings

25+settings = { protocol: "http", hostname: "localhost", port: 3000 }

26+

24validatePath :: RequestValidator

27validatePath :: RequestValidator

25validatePath = do

28validatePath = do

26 let invalidPath = error "invalid path"

29 let invalidPath = error "invalid path"

@@ -41,7 +44,7 @@ runReqValidator req = runReaderT (validatePath *> validateMethod) req

42mockSrv :: forall a. Body a => a -> Aff (Effect Unit)

45mockSrv :: forall a. Body a => a -> Aff (Effect Unit)

43mockSrv res = do

46mockSrv res = do

44− close <- liftEffect $ serve 3000 (\req -> runReqValidator req *> ok res) $ pure unit

47+ close <- liftEffect $ serve settings.port (\req -> runReqValidator req *> ok res) $ pure unit

45 pure $ close $ pure unit

48 pure $ close $ pure unit

47setupSrv :: forall a b. Body a => a -> Aff b -> Aff b

50setupSrv :: forall a b. Body a => a -> Aff b -> Aff b

@@ -52,5 +55,6 @@ main = runTest do

52 suite "compile" do

55 suite "compile" do

53 test "produces expected output" do

56 test "produces expected output" do

54 let expected = "2"

57 let expected = "2"

58+ compile = runCompiler settings

55 actual <- setupSrv expected (compile "1+1")

59 actual <- setupSrv expected (compile "1+1")

56 expected `equal` actual

60 expected `equal` actual