feat: add capabilities and launch the compiler

flake.nix

@@ -33,10 +33,12 @@
                     debug
                     aff
                     effect
+                    node-buffer
                     node-process
                     test-unit
                     httpure
                     affjax-node
+                    node-streams-aff
                   ];
 
                 foreign."Affjax.Node".node_modules = npm.node_modules { src = ./.; } + /node_modules;

src/Main.purs

@@ -1,23 +1,56 @@
 module Main where
 
-import Prelude (Unit, ($), (<<<), void, pure, bind)
-
+import Prelude (Unit, ($), (<<<), void, pure, bind, show, discard)
+import Control.Bind ((=<<))
 import Control.Monad.Error.Class (liftEither)
+import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask)
+import Control.Monad.Trans.Class (lift)
 import Data.Bifunctor (lmap)
 import Data.Maybe (Maybe(Just))
+import Data.Monoid ((<>))
+import Data.Tuple (Tuple (Tuple))
+import Data.Array (concat)
 import Effect (Effect)
-import Effect.Aff (Aff, error)
+import Effect.Aff (Aff, error, launchAff_)
+import Effect.Class (liftEffect)
+import Node.Buffer (Buffer)
 import Node.Process (stdin, stdout)
 import Node.Stream (pipe)
+import Node.Stream.Aff (readSome, write, end, toStringUTF8, fromStringUTF8)
 import Affjax.ResponseFormat (string)
 import Affjax.Node (post, printError)
 import Affjax.RequestBody (RequestBody (String))
 
-compile :: String -> Aff String
-compile s = do
-  mRes <- post string "http://localhost:3000/compile" $ Just $ String s
+type Settings = { protocol :: String, hostname :: String, port :: Int }
+type Code = String
+type Compiler = ReaderT Code (ReaderT Settings Aff)
+
+askCode :: Compiler Code
+askCode = ask
+
+askSettings :: Compiler Settings
+askSettings = lift ask
+
+liftAff :: forall a. Aff a -> Compiler a
+liftAff h = lift $ lift h
+
+compile :: Compiler Code
+compile = do
+  code <- askCode
+  s <- askSettings
+  let url = s.protocol <> "://" <> s.hostname <> ":" <> show s.port <> "/compile"
+  mRes <- liftAff $ post string url $ Just $ String code
   res <- liftEither $ (error <<< printError) `lmap` mRes 
   pure res.body
 
+runCompiler :: Settings -> Code -> Aff Code
+runCompiler s code = runReaderT (runReaderT compile code) s
+
 main :: Effect Unit
-main = void $ stdin `pipe` stdout
+main = launchAff_ do
+  Tuple input _ <- readSome stdin
+  code <- toStringUTF8 input
+  code' <- runCompiler { protocol: "https", hostname: "try.purescript.org", port: 80 } code
+  output <- fromStringUTF8 code'
+  write stdout output
+  end stdout

test/Main.purs

@@ -2,12 +2,12 @@ module Test.Main where
 
 import Prelude (Unit, ($), (==), (>>=), unit, pure, bind, const)
 import Control.Apply ((*>))
-import Control.Monad.Error.Class (class MonadThrow, throwError, liftMaybe)
+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, error)
+import Effect.Exception (error)
 import HTTPure.Request (Request)
 import HTTPure.Response (ok)
 import HTTPure.Server (serve)
@@ -17,10 +17,13 @@ import HTTPure.Method (Method(Post))
 import Test.Unit (suite, test)
 import Test.Unit.Main (runTest)
 import Test.Unit.Assert (equal)
-import Main (compile)
+import Main (Settings, runCompiler)
 
 type RequestValidator = ReaderT Request Aff Unit
 
+settings :: Settings
+settings = { protocol: "http", hostname: "localhost", port: 3000 }
+
 validatePath :: RequestValidator
 validatePath = do
    let invalidPath = error "invalid path"
@@ -41,7 +44,7 @@ runReqValidator req = runReaderT (validatePath *> validateMethod) req
 
 mockSrv :: forall a. Body a => a -> Aff (Effect Unit)
 mockSrv res = do
-  close <- liftEffect $ serve 3000 (\req -> runReqValidator req *> ok res) $ pure unit
+  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
@@ -52,5 +55,6 @@ main = runTest do
   suite "compile" do
      test "produces expected output" do
         let expected = "2"
+            compile = runCompiler settings
         actual <- setupSrv expected (compile "1+1")
         expected `equal` actual