git.iko.soy/rowtype-yoga/purs-eval
on main help sign in
rowtype-yoga/purs-eval/src/Compiler.purs
99 lines 2.9 kB history raw
1module Compiler
2 ( Settings
3 , Code
4 , ErrorPosition
5 , Suggestion
6 , CompileWarning
7 , SuccessResult
8 , successFromJson
9 , runCompiler
10 , appendMain
11 )
12 where
14import Prelude (bind, pure, show, ($), (<<<), const)
15import Control.Monad.Error.Class (liftEither)
16import Control.Monad.Reader.Trans (ReaderT, runReaderT, ask)
17import Control.Monad.Trans.Class (lift)
18import Data.Argonaut.Core (Json)
19import Data.Argonaut.Decode (printJsonDecodeError)
20import Data.Argonaut.Decode.Class (decodeJson)
21import Data.Argonaut.Parser (jsonParser)
22import Data.Functor ((<$>))
23import Data.Bifunctor (lmap)
24import Data.Either (Either)
25import Data.Maybe (Maybe(Just))
26import Data.Monoid ((<>))
27import Effect.Aff (Aff, error)
28import Effect.Exception (Error)
29import Affjax.ResponseFormat (string)
30import Affjax.Node (post, printError)
31import Affjax.RequestBody (RequestBody (String))
32import Parsing.String as PS
33import Parsing.String.Replace as PS.Replace
35type Settings = { protocol :: String
36 , hostname :: String
37 , port :: Int
38 , parser :: Json -> Either Error SuccessResult
39 }
40type Code = String
41type Compiler = ReaderT Code (ReaderT Settings Aff)
43-- extracted from github:purescript/trypurescript
44type ErrorPosition =
45 { startLine :: Int
46 , endLine :: Int
47 , startColumn :: Int
48 , endColumn :: Int
49 }
50type Suggestion =
51 { replacement :: String
52 , replaceRange :: Maybe ErrorPosition
53 }
54type CompileWarning =
55 { errorCode :: String
56 , message :: String
57 , position :: Maybe ErrorPosition
58 , suggestion :: Maybe Suggestion
59 }
60type SuccessResult =
61 { js :: String
62 , warnings :: Maybe (Array CompileWarning)
63 }
64-- end of imports from github:purescript/trypurescript
66successFromJson :: Json -> Either Error SuccessResult
67successFromJson json = (error <<< printJsonDecodeError) `lmap` (decodeJson json)
69askCode :: Compiler Code
70askCode = ask
72askSettings :: Compiler Settings
73askSettings = lift ask
75liftAff :: forall a. Aff a -> Compiler a
76liftAff h = lift $ lift h
78rename :: String -> String -> Code -> Code
79rename url output code = PS.Replace.replace code (prefix <$> PS.string "from \"..") where
80 prefix = const $ "from \"" <> url <> output
82appendMain :: Code -> Code
83appendMain code = code <> "\nmain();"
85compile :: Compiler Code
86compile = do
87 code <- askCode
88 s <- askSettings
89 let url = s.protocol <> "://" <> s.hostname <> ":" <> show s.port
90 endpoint = "/compile"
91 output = "/output"
92 mRes <- liftAff $ post string (url <> endpoint) $ Just $ String code
93 res <- liftEither $ (error <<< printError) `lmap` mRes
94 body <- liftEither $ error `lmap` (jsonParser res.body)
95 succ <- liftEither $ s.parser body
96 pure $ appendMain $ rename url output succ.js
98runCompiler :: Settings -> Code -> Aff Code
99runCompiler s code = runReaderT (runReaderT compile code) s