@@ -6,17 +6,17 @@ module Endpoint.Repl
66 where
77
88
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
913import qualified Data.ByteString.Builder as B
10−import qualified Data.ByteString.Internal as BS
1114import qualified Data.ByteString.Lazy as LBS
12−import qualified Data.ByteString.UTF8 as BS_UTF8
1315import Data.Map ((!))
1416import qualified Data.Map as Map
1517import qualified Data.Map.Utils as Map
1618import qualified Data.Name as N
1719import qualified Data.NonEmptyList as NE
18−import Foreign.ForeignPtr.Unsafe (unsafeForeignPtrToPtr)
19−import Foreign.Ptr (minusPtr)
2020import Snap.Core
2121
2222import qualified Artifacts as A
@@ -32,10 +32,7 @@ import qualified Elm.Package as Pkg
3232import qualified File
3333import qualified Generate.JavaScript as JS
3434import qualified Json.Encode as Encode
35−import qualified Json.Decode as D
3635import qualified Parse.Module as Parse
37−import qualified Parse.Primitives as P
38−import qualified Parse.Variable as Var
3936import qualified Repl
4037import qualified Reporting.Annotation as A
4138import qualified Reporting.Error as Error
@@ -63,12 +60,12 @@ allowedOrigins =
6360endpoint :: A.Artifacts -> Snap ()
6461endpoint artifacts =
6562 Cors.allow POST allowedOrigins $
66− do body <- LBS.toStrict <$> readRequestBody (64 * 1024)
67− case D.fromByteString decoder body of
68− Right (state, entry) ->
63+ do body <- readRequestBody (64 * 1024)
64+ case decodeBody body of
65+ Just (state, entry) ->
6966 serveOutcome (toOutcome artifacts state entry)
7067
71− Left _ ->
68+ Nothing ->
7269 do modifyResponse $ setResponseStatus 400 "Bad Request"
7370 modifyResponse $ setContentType "text/html; charset=utf-8"
7471 writeBS "Received unexpected JSON body."
@@ -93,9 +90,9 @@ data Outcome
9390 | Failure BS.ByteString Error.Error
9491
9592
96−toOutcome :: A.Artifacts -> Repl.State -> BS.ByteString -> Outcome
93+toOutcome :: A.Artifacts -> Repl.State -> String -> Outcome
9794toOutcome artifacts state entry =
98− case reverse (lines (BS_UTF8.toString entry)) of
95+ case reverse (lines entry) of
9996 [] ->
10097 Skip
10198
@@ -226,31 +223,24 @@ checkImports interfaces imports =
226223
227224
228225
229−-- DECODER
226+-- DECODE BODY
230227
231228
232−decoder :: D.Decoder () ( Repl.State, BS.ByteString )
233−decoder =
229+decodeBody :: LBS.ByteString -> Maybe ( Repl.State, String )
230+decodeBody body =
231+ Aeson.parseMaybe decodeBodyHelp =<< Aeson.decode' body
232+
233+
234+decodeBodyHelp :: Aeson.Object -> Aeson.Parser ( Repl.State, String )
235+decodeBodyHelp obj =
234236 let
235− bail _ _ = ()
236− upper = D.KeyDecoder (Var.upper bail) bail
237− lower = D.KeyDecoder (Var.lower bail) bail
238− bytes = D.customString bytesParser bail
239− builder = B.byteString <$> bytes
237+ get key =
238+ do dict <- obj .: key
239+ let f (k,v) = (N.fromChars k, B.stringUtf8 v)
240+ return $ Map.fromList $ map f $ Map.toList dict
240241 in
241− do imports <- D.field "imports" (D.dict upper builder)
242− types <- D.field "types" (D.dict upper builder)
243− decls <- D.field "decls" (D.dict lower builder)
244− entry <- D.field "entry" bytes
242+ do imports <- get "imports"
243+ types <- get "types"
244+ decls <- get "decls"
245+ entry <- obj .: "entry"
245246 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)