git.iko.soy/elk
on ca2be8a help sign in
elk/src/Json/Decode.hs
310 lines 7.9 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
3module Json.Decode
4 ( parse
5 -- re-export from Json.Decode.Internals
6 , Json.Decoder
7 , Json.string, Json.text, Json.name, Json.bool, Json.int
8 , Json.list, Json.dict, Json.pairs, Json.maybe
9 , Json.field, Json.at
10 , Json.index
11 , Json.map, Json.map2, Json.mapError
12 , Json.succeed, Json.fail
13 , Json.andThen, Json.oneOf
14 )
15 where
18import Prelude hiding (length)
19import qualified Data.ByteString.Char8 as Char8
20import qualified Data.ByteString.Internal as B
21import qualified Data.HashMap.Strict as HashMap
22import qualified Data.Text as Text
23import qualified Data.Text.Encoding as Text
24import qualified Data.Vector as Vector
25import Foreign.ForeignPtr (ForeignPtr)
26import GHC.Word (Word8(..))
28import qualified Json.Decode.Internals as Json
29import qualified Parse.Primitives as P
30import qualified Parse.Primitives.Internals as I
31import Parse.Primitives.Internals (Parser(..), State(..), noError)
32import qualified Parse.Primitives.Keyword as Keyword
33import qualified Parse.Primitives.Number as Number
34import qualified Parse.Primitives.Symbol as Symbol
35import qualified Reporting.Error.Syntax as E
36import qualified Reporting.Error.Json as J
37import qualified Reporting.Helpers as H
38import qualified Reporting.Region as R
39import qualified Reporting.Render.Code as Code
43-- PARSE
46parse :: FilePath -> String -> (e -> [H.Doc]) -> Json.Decoder e a -> B.ByteString -> Either H.Doc a
47parse path rootName userErrorToDocs (Json.Decoder run) bytestring =
48 let
49 source =
50 Code.toSource (Text.replace "\t" " " (Text.decodeUtf8 bytestring))
52 toDoc err =
53 J.toDoc path rootName source userErrorToDocs err
54 in
55 case P.run jsonFile bytestring of
56 Left err ->
57 Left (toDoc (J.BadJson err))
59 Right value ->
60 case run value of
61 Left err ->
62 Left (toDoc (J.BadContent err))
64 Right answer ->
65 Right answer
69-- JSON
72jsonFile :: Parser Json.Value
73jsonFile =
74 do spaces
75 value <- jsonValue
76 spaces
77 P.endOfFile
78 return value
81jsonValue :: Parser Json.Value
82jsonValue =
83 do start <- P.getPosition
84 I.oneOf
85 [ Json.String <$> string
86 , object start
87 , array start
88 , number
89 , Keyword.jsonTrue >> return Json.TRUE
90 , Keyword.jsonFalse >> return Json.FALSE
91 , Keyword.jsonNull >> return Json.NULL
92 ]
96-- OBJECT
99object :: R.Position -> Parser Json.Value
100object start =
101 do Symbol.leftCurly
102 P.inContext start E.ExprRecord $
103 do spaces
104 I.oneOf
105 [ do entry <- field
106 spaces
107 objectHelp [entry]
108 , do Symbol.rightCurly
109 return (Json.Object [] HashMap.empty)
110 ]
113objectHelp :: [(Text.Text, Json.Value)] -> Parser Json.Value
114objectHelp revEntries =
115 I.oneOf
116 [
117 do Symbol.comma
118 spaces
119 entry <- field
120 spaces
121 objectHelp (entry:revEntries)
122 ,
123 do Symbol.rightCurly
124 return (Json.Object (reverse revEntries) (HashMap.fromList revEntries))
125 ]
128field :: Parser (Text.Text, Json.Value)
129field =
130 do key <- string
131 spaces
132 Symbol.hasType
133 spaces
134 value <- jsonValue
135 return (key, value)
139-- ARRAY
142array :: R.Position -> Parser Json.Value
143array start =
144 do Symbol.leftSquare
145 P.inContext start E.ExprList $
146 do spaces
147 I.oneOf
148 [ do entry <- jsonValue
149 spaces
150 arrayHelp 1 [entry]
151 , do Symbol.rightSquare
152 return (Json.Array Vector.empty)
153 ]
156arrayHelp :: Int -> [Json.Value] -> Parser Json.Value
157arrayHelp !length revEntries =
158 I.oneOf
159 [
160 do Symbol.comma
161 spaces
162 entry <- jsonValue
163 spaces
164 arrayHelp (length + 1) (entry:revEntries)
165 ,
166 do Symbol.rightSquare
167 return $ Json.Array $ Vector.reverse $
168 Vector.fromListN length revEntries
169 ]
173-- NUMBER
176number :: Parser Json.Value
177number =
178 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
179 if offset < terminal then
181 let
182 !word = I.unsafeIndex fp offset
183 !offset1 = offset + 1
184 in
185 if word <= 0x39 {- 9 -} && word >= 0x31 {- 1 -} then
186 case Number.chompInt fp offset1 terminal (fromIntegral (word - 0x30 {- 0 -})) of
187 Number.Err newOffset problem ->
188 cerr (E.ParseError row (col + (newOffset - offset)) problem)
190 Number.OkInt newOffset n ->
191 let
192 !newState = State fp newOffset terminal indent row (col + (newOffset - offset)) ctx
193 in
194 cok (Json.Integer n) newState noError
196 Number.OkFloat newOffset ->
197 let
198 !length = newOffset - offset
199 !scientific = read $ Char8.unpack $ B.PS fp offset length
200 !newState = State fp newOffset terminal indent row (col + length) ctx
201 in
202 cok (Json.Float scientific) newState noError
204 else if word == 0x30 {- 0 -} then
205 cok (Json.Integer 0) (State fp offset1 terminal indent row (col + 1) ctx) noError
207 else
208 eerr noError
210 else
211 eerr noError
216-- STRING
219string :: Parser Text.Text
220string =
221 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
222 if offset < terminal && I.unsafeIndex fp offset == 0x22 {- " -} then
224 let
225 !offset1 = offset + 1
226 in
227 case stringHelp fp offset1 terminal row (col + 1) of
228 Err err ->
229 cerr err
231 Ok newOffset newRow newCol ->
232 let
233 !newState = State fp newOffset terminal indent newRow newCol ctx
234 !content = Text.decodeUtf8 (B.PS fp offset1 (newOffset - offset1 - 1))
235 in
236 cok content newState noError
238 else
239 eerr noError
242data StringResult
243 = Err E.ParseError
244 | Ok !Int !Int !Int
247stringHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> StringResult
248stringHelp fp offset terminal row col =
249 if offset >= terminal then
250 Err (E.ParseError row col E.EndOfFile_String)
252 else
253 case I.unsafeIndex fp offset of
254 0x22 {- " -} ->
255 Ok (offset + 1) row (col + 1)
257 0x0A {- \n -} ->
258 Err (E.ParseError row col E.NewLineInString)
260 0x5C {- \ -} ->
261 let
262 !offset1 = offset + 1
263 in
264 if offset1 < terminal then
266 let
267 !word = I.unsafeIndex fp offset1
268 !newOffset = offset1 + I.getCharWidth fp offset1 terminal word
269 in
270 stringHelp fp newOffset terminal row (col + 2)
272 else
273 Err (E.ParseError (row + 1) col E.EndOfFile_String)
275 word ->
276 let !newOffset = offset + I.getCharWidth fp offset terminal word in
277 stringHelp fp newOffset terminal row (col + 1)
282-- SPACES
285spaces :: Parser ()
286spaces =
287 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ _ ->
288 let
289 (# newOffset, newRow, newCol #) =
290 eatSpaces fp offset terminal row col
292 !newState =
293 State fp newOffset terminal indent newRow newCol ctx
294 in
295 cok () newState noError
298eatSpaces :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> (# Int, Int, Int #)
299eatSpaces fp offset terminal row col =
300 if offset >= terminal then
301 (# offset, row, col #)
303 else
304 case I.unsafeIndex fp offset of
305 0x20 {- -} -> eatSpaces fp (offset + 1) terminal row (col + 1)
306 0x09 {- \t -} -> eatSpaces fp (offset + 1) terminal row (col + 1)
307 0x0A {- \n -} -> eatSpaces fp (offset + 1) terminal (row + 1) 1
308 0x0D {- \r -} -> eatSpaces fp (offset + 1) terminal row col
309 _ ->
310 (# offset, row, col #)