git.iko.soy/elk
on master help sign in
switch to using aeson to decode JSON given to /repl
916e73fEvan Czaplicki
worker/elm.cabal+1
compare with master
unifiedsplit
@@ -169,6 +169,7 @@ Executable worker
169 Type.UnionFind
169 Type.UnionFind
170
170
171 Build-depends:
171 Build-depends:
172+ aeson,
172 ansi-terminal >= 0.8 && < 0.9,
173 ansi-terminal >= 0.8 && < 0.9,
173 ansi-wl-pprint >= 0.6.8 && < 0.7,
174 ansi-wl-pprint >= 0.6.8 && < 0.7,
174 base >=4.11 && <5,
175 base >=4.11 && <5,
worker/src/Endpoint/Repl.hs+26−36
@@ -6,17 +6,17 @@ module Endpoint.Repl
6 where
6 where
7
7
8
8
9+import Data.Aeson ((.:))
10+import qualified Data.Aeson as Aeson
11+import qualified Data.Aeson.Types as Aeson
12+import qualified Data.ByteString as BS
9import qualified Data.ByteString.Builder as B
13import qualified Data.ByteString.Builder as B
10−import qualified Data.ByteString.Internal as BS
11import qualified Data.ByteString.Lazy as LBS
14import qualified Data.ByteString.Lazy as LBS
12−import qualified Data.ByteString.UTF8 as BS_UTF8
13import Data.Map ((!))
15import Data.Map ((!))
14import qualified Data.Map as Map
16import qualified Data.Map as Map
15import qualified Data.Map.Utils as Map
17import qualified Data.Map.Utils as Map
16import qualified Data.Name as N
18import qualified Data.Name as N
17import qualified Data.NonEmptyList as NE
19import qualified Data.NonEmptyList as NE
18−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
19−import Foreign.Ptr (minusPtr)
20import Snap.Core
20import Snap.Core
21
21
22import qualified Artifacts as A
22import qualified Artifacts as A
@@ -32,10 +32,7 @@ import qualified Elm.Package as Pkg
32import qualified File
32import qualified File
33import qualified Generate.JavaScript as JS
33import qualified Generate.JavaScript as JS
34import qualified Json.Encode as Encode
34import qualified Json.Encode as Encode
35−import qualified Json.Decode as D
36import qualified Parse.Module as Parse
35import qualified Parse.Module as Parse
37−import qualified Parse.Primitives as P
38−import qualified Parse.Variable as Var
39import qualified Repl
36import qualified Repl
40import qualified Reporting.Annotation as A
37import qualified Reporting.Annotation as A
41import qualified Reporting.Error as Error
38import qualified Reporting.Error as Error
@@ -63,12 +60,12 @@ allowedOrigins =
63endpoint :: A.Artifacts -> Snap ()
60endpoint :: A.Artifacts -> Snap ()
64endpoint artifacts =
61endpoint artifacts =
65 Cors.allow POST allowedOrigins $
62 Cors.allow POST allowedOrigins $
66− do body <- LBS.toStrict <$> readRequestBody (64 * 1024)
63+ do body <- readRequestBody (64 * 1024)
67− case D.fromByteString decoder body of
64+ case decodeBody body of
68− Right (state, entry) ->
65+ Just (state, entry) ->
69 serveOutcome (toOutcome artifacts state entry)
66 serveOutcome (toOutcome artifacts state entry)
70
67
71− Left _ ->
68+ Nothing ->
72 do modifyResponse $ setResponseStatus 400 "Bad Request"
69 do modifyResponse $ setResponseStatus 400 "Bad Request"
73 modifyResponse $ setContentType "text/html; charset=utf-8"
70 modifyResponse $ setContentType "text/html; charset=utf-8"
74 writeBS "Received unexpected JSON body."
71 writeBS "Received unexpected JSON body."
@@ -93,9 +90,9 @@ data Outcome
93 | Failure BS.ByteString Error.Error
90 | Failure BS.ByteString Error.Error
94
91
95
92
96−toOutcome :: A.Artifacts -> Repl.State -> BS.ByteString -> Outcome
93+toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome
97toOutcome artifacts state entry =
94toOutcome artifacts state entry =
98− case reverse (lines (BS_UTF8.toString entry)) of
95+ case reverse (lines entry) of
99 [] ->
96 [] ->
100 Skip
97 Skip
101
98
@@ -226,31 +223,24 @@ checkImports interfaces imports =
226
223
227
224
228
225
229−-- DECODER
226+-- DECODE BODY
230
227
231
228
232−decoder :: D.Decoder () ( Repl.State, BS.ByteString )
229+decodeBody :: LBS.ByteString -> Maybe ( Repl.State, String )
233−decoder =
230+decodeBody body =
231+ Aeson.parseMaybe decodeBodyHelp =<< Aeson.decode' body
232+
233+
234+decodeBodyHelp :: Aeson.Object -> Aeson.Parser ( Repl.State, String )
235+decodeBodyHelp obj =
234 let
236 let
235− bail _ _ = ()
237+ get key =
236− upper = D.KeyDecoder (Var.upper bail) bail
238+ do dict <- obj .: key
237− lower = D.KeyDecoder (Var.lower bail) bail
239+ let f (k,v) = (N.fromChars k, B.stringUtf8 v)
238− bytes = D.customString bytesParser bail
240+ return $ Map.fromList $ map f $ Map.toList dict
239− builder = B.byteString <$> bytes
240 in
241 in
241− do imports <- D.field "imports" (D.dict upper builder)
242+ do imports <- get "imports"
242− types <- D.field "types" (D.dict upper builder)
243+ types <- get "types"
243− decls <- D.field "decls" (D.dict lower builder)
244+ decls <- get "decls"
244− entry <- D.field "entry" bytes
245+ entry <- obj .: "entry"
245 return ( Repl.State imports types decls, entry )
246 return ( Repl.State imports types decls, entry )
246−
247−
248−bytesParser :: P.Parser x BS.ByteString
249−bytesParser =
250− P.Parser $ \(P.State src pos end indent row col) cok _ _ _ ->
251− let
252− off = minusPtr pos (unsafeForeignPtrToPtr src)
253− len = minusPtr end pos
254− newCol = col + fromIntegral len
255− in
256− cok (BS.PS src off len) (P.State src end end indent row newCol)