@@ -19,111 +19,74 @@ import Affjax.RequestBody as AXRB
1919import Affjax.ResponseFormat as AXRF
2020import Affjax.StatusCode (StatusCode (..))
2121import Control.Alt ((<|>))
22- import Control.Monad.Except (ExceptT (..), runExcept )
22+ import Control.Monad.Except (ExceptT (..))
23+ import Data.Argonaut.Decode (class DecodeJson , decodeJson , (.:))
24+ import Data.Argonaut.Encode (encodeJson )
2325import Data.Either (Either (..))
24- import Data.Generic.Rep (class Generic )
25- import Data.List.NonEmpty (NonEmptyList )
2626import Data.Maybe (Maybe (..))
27+ import Data.Traversable (traverse )
2728import Effect.Aff (Aff )
28- import Foreign (ForeignError , unsafeToForeign )
29- import Foreign.Class (class Decode , decode )
30- import Foreign.Generic (defaultOptions , genericDecode )
31- import Foreign.Generic.Class (Options , SumEncoding (..))
32-
33- decodingOptions :: Options
34- decodingOptions = defaultOptions { unwrapSingleConstructors = true }
3529
3630-- | The range of text associated with an error
37- newtype ErrorPosition = ErrorPosition
31+ type ErrorPosition =
3832 { startLine :: Int
3933 , endLine :: Int
4034 , startColumn :: Int
4135 , endColumn :: Int
4236 }
4337
44- derive instance genericErrorPosition :: Generic ErrorPosition _
45-
46- instance decodeErrorPosition :: Decode ErrorPosition where
47- decode = genericDecode decodingOptions
48-
49- newtype CompilerError = CompilerError
38+ type CompilerError =
5039 { message :: String
5140 , position :: Maybe ErrorPosition
5241 }
5342
54- derive instance genericCompilerError :: Generic CompilerError _
55-
56- instance decodeCompilerError :: Decode CompilerError where
57- decode = genericDecode decodingOptions
58-
5943-- | An error reported from the compile API.
6044data CompileError
6145 = CompilerErrors (Array CompilerError )
6246 | OtherError String
6347
64- derive instance genericCompileError :: Generic CompileError _
65-
66- instance decodeCompileError :: Decode CompileError where
67- decode = genericDecode
68- (defaultOptions
69- { sumEncoding =
70- TaggedObject
71- { tagFieldName: " tag"
72- , contentsFieldName: " contents"
73- , constructorTagTransform: identity
74- }
75- })
76-
77- newtype Suggestion = Suggestion
48+ instance decodeJsonCompileError :: DecodeJson CompileError where
49+ decodeJson = decodeJson >=> \obj -> do
50+ contents <- obj .: " contents"
51+ obj .: " tag" case _ of
52+ " OtherError" ->
53+ map OtherError $ decodeJson contents
54+ " CompilerErrors" ->
55+ map CompilerErrors $ traverse decodeJson =<< decodeJson contents
56+ _ ->
57+ Left " Tag must be one of: OtherError, CompilerErrors"
58+
59+ type Suggestion =
7860 { replacement :: String
7961 , replaceRange :: Maybe ErrorPosition
8062 }
8163
82- derive instance genericSuggestion :: Generic Suggestion _
83-
84- instance decodeSuggestion :: Decode Suggestion where
85- decode = genericDecode decodingOptions
86-
87- newtype CompileWarning = CompileWarning
64+ type CompileWarning =
8865 { errorCode :: String
8966 , message :: String
9067 , position :: Maybe ErrorPosition
9168 , suggestion :: Maybe Suggestion
9269 }
9370
94- derive instance genericCompileWarning :: Generic CompileWarning _
95-
96- instance decodeCompileWarning :: Decode CompileWarning where
97- decode = genericDecode decodingOptions
98-
99- newtype SuccessResult = SuccessResult
71+ type SuccessResult =
10072 { js :: String
10173 , warnings :: Maybe (Array CompileWarning )
10274 }
10375
104- derive instance genericSuccessResult :: Generic SuccessResult _
105-
106- instance decodeSuccessResult :: Decode SuccessResult where
107- decode = genericDecode decodingOptions
108-
109- newtype FailedResult = FailedResult
110- { error :: CompileError }
111-
112- derive instance genericFailedResult :: Generic FailedResult _
113-
114- instance decodeFailedResult :: Decode FailedResult where
115- decode = genericDecode decodingOptions
76+ type FailedResult =
77+ { error :: CompileError
78+ }
11679
11780-- | The result of calling the compile API.
11881data CompileResult
11982 = CompileSuccess SuccessResult
12083 | CompileFailed FailedResult
12184
12285-- | Parse the result from the compile API and verify it
123- instance decodeCompileResult :: Decode CompileResult where
124- decode f =
125- CompileSuccess <$> genericDecode decodingOptions f
126- <|> CompileFailed <$> genericDecode decodingOptions f
86+ instance decodeJsonCompileResult :: DecodeJson CompileResult where
87+ decodeJson json =
88+ map CompileSuccess (decodeJson json)
89+ <|> map CompileFailed (decodeJson json)
12790
12891get :: URL -> ExceptT String Aff String
12992get url = ExceptT $ AX .get AXRF .string url >>= case _ of
@@ -135,13 +98,13 @@ get url = ExceptT $ AX.get AXRF.string url >>= case _ of
13598 pure $ Right body
13699
137100-- | POST the specified code to the Try PureScript API, and wait for a response.
138- compile :: String -> String -> ExceptT String Aff (Either ( NonEmptyList ForeignError ) CompileResult )
139- compile endpoint code = ExceptT $ AX .post AXRF .json (endpoint <> " /compile" ( Just requestBody) >>= case _ of
101+ compile :: String -> String -> ExceptT String Aff (Either String CompileResult )
102+ compile endpoint code = ExceptT $ AX .post AXRF .json (endpoint <> " /compile" case _ of
140103 Left e ->
141104 pure $ Left $ printError e
142105 Right { status } | status >= StatusCode 400 ->
143106 pure $ Left $ " Received error status code: "
144107 Right { body } ->
145- pure $ Right $ runExcept (decode (unsafeToForeign body))
108+ pure $ Right $ decodeJson body
146109 where
147- requestBody = AXRB.String code
110+ requestBody = Just $ AXRB.Json $ encodeJson code
0 commit comments