@@ -1,23 +1,56 @@
11module Main where
22
3−import Prelude (Unit, ($), (<<<), void, pure, bind)
4−
3+import Prelude (Unit, ($), (<<<), void, pure, bind, show, discard)
4+import Control.Bind ((=<<))
55import Control.Monad.Error.Class (liftEither)
6+import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask)
7+import Control.Monad.Trans.Class (lift)
68import Data.Bifunctor (lmap)
79import Data.Maybe (Maybe(Just))
10+import Data.Monoid ((<>))
11+import Data.Tuple (Tuple (Tuple))
12+import Data.Array (concat)
813import 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)
1017import Node.Process (stdin, stdout)
1118import Node.Stream (pipe)
19+import Node.Stream.Aff (readSome, write, end, toStringUTF8, fromStringUTF8)
1220import Affjax.ResponseFormat (string)
1321import Affjax.Node (post, printError)
1422import Affjax.RequestBody (RequestBody (String))
1523
16−compile :: String -> Aff String
17−compile s = do
18− mRes <- post string "http://localhost:3000/compile" $ Just $ String s
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
1943 res <- liftEither $ (error <<< printError) `lmap` mRes
2044 pure res.body
2145
46+runCompiler :: Settings -> Code -> Aff Code
47+runCompiler s code = runReaderT (runReaderT compile code) s
48+
2249main :: 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