git.iko.soy/elk
on ba0b721 help sign in
elk/src/Json/Decode.hs
306 lines 7.6 kB history raw
1{-# OPTIONS_GHC -Wall -fno-warn-unused-do-bind #-}
2{-# LANGUAGE BangPatterns, MagicHash, OverloadedStrings, UnboxedTuples #-}
3module Json.Decode
4 ( parse
5 , Failure(..)
6 -- re-export from Json.Decode.Internals
7 , Json.Decoder, Json.Error(..), Json.Type(..)
8 , Json.string, Json.text, Json.bool, Json.int
9 , Json.list, Json.dict, Json.pairs, Json.maybe
10 , Json.field, Json.at
11 , Json.index
12 , Json.map, Json.map2, Json.mapError
13 , Json.succeed, Json.fail
14 , Json.andThen, Json.oneOf
15 )
16 where
19import Prelude hiding (length)
20import qualified Data.ByteString.Char8 as Char8
21import qualified Data.ByteString.Internal as B
22import qualified Data.HashMap.Strict as HashMap
23import qualified Data.Text as Text
24import qualified Data.Text.Encoding as Text
25import qualified Data.Vector as Vector
26import Foreign.ForeignPtr (ForeignPtr)
27import GHC.Word (Word8(..))
29import qualified Json.Decode.Internals as Json
30import qualified Parse.Primitives as P
31import qualified Parse.Primitives.Internals as I
32import Parse.Primitives.Internals (Parser(..), State(..), noError)
33import qualified Parse.Primitives.Keyword as Keyword
34import qualified Parse.Primitives.Number as Number
35import qualified Parse.Primitives.Symbol as Symbol
36import qualified Reporting.Error.Syntax as E
37import qualified Reporting.Region as R
41-- PARSE
44data Failure e
45 = BadJson E.Error
46 | BadContent (Json.Error e)
49parse :: Json.Decoder e a -> B.ByteString -> Either (Failure e) a
50parse (Json.Decoder run) bytestring =
51 case P.run jsonFile bytestring of
52 Left err ->
53 Left (BadJson err)
55 Right value ->
56 case run value of
57 Left err ->
58 Left (BadContent err)
60 Right answer ->
61 Right answer
65-- JSON
68jsonFile :: Parser Json.Value
69jsonFile =
70 do spaces
71 value <- jsonValue
72 spaces
73 P.endOfFile
74 return value
77jsonValue :: Parser Json.Value
78jsonValue =
79 do start <- P.getPosition
80 I.oneOf
81 [ Json.String <$> string
82 , object start
83 , array start
84 , number
85 , Keyword.jsonTrue >> return Json.TRUE
86 , Keyword.jsonFalse >> return Json.FALSE
87 , Keyword.jsonNull >> return Json.NULL
88 ]
92-- OBJECT
95object :: R.Position -> Parser Json.Value
96object start =
97 do Symbol.leftCurly
98 P.inContext start E.ExprRecord $
99 do spaces
100 I.oneOf
101 [ do entry <- field
102 spaces
103 objectHelp [entry]
104 , do Symbol.rightCurly
105 return (Json.Object [] HashMap.empty)
106 ]
109objectHelp :: [(Text.Text, Json.Value)] -> Parser Json.Value
110objectHelp revEntries =
111 I.oneOf
112 [
113 do Symbol.comma
114 spaces
115 entry <- field
116 spaces
117 objectHelp (entry:revEntries)
118 ,
119 do Symbol.rightCurly
120 return (Json.Object (reverse revEntries) (HashMap.fromList revEntries))
121 ]
124field :: Parser (Text.Text, Json.Value)
125field =
126 do key <- string
127 spaces
128 Symbol.hasType
129 spaces
130 value <- jsonValue
131 return (key, value)
135-- ARRAY
138array :: R.Position -> Parser Json.Value
139array start =
140 do Symbol.leftSquare
141 P.inContext start E.ExprList $
142 do spaces
143 I.oneOf
144 [ do entry <- jsonValue
145 spaces
146 arrayHelp 1 [entry]
147 , do Symbol.rightSquare
148 return (Json.Array Vector.empty)
149 ]
152arrayHelp :: Int -> [Json.Value] -> Parser Json.Value
153arrayHelp !length revEntries =
154 I.oneOf
155 [
156 do Symbol.comma
157 spaces
158 entry <- jsonValue
159 spaces
160 arrayHelp (length + 1) (entry:revEntries)
161 ,
162 do Symbol.rightSquare
163 return $ Json.Array $ Vector.reverse $
164 Vector.fromListN length revEntries
165 ]
169-- NUMBER
172number :: Parser Json.Value
173number =
174 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
175 if offset < terminal then
177 let
178 !word = I.unsafeIndex fp offset
179 !offset1 = offset + 1
180 in
181 if word <= 0x39 {- 9 -} && word >= 0x31 {- 1 -} then
182 case Number.chompInt fp offset1 terminal (fromIntegral (word - 0x30 {- 0 -})) of
183 Number.Err newOffset problem ->
184 cerr (E.ParseError row (col + (newOffset - offset)) problem)
186 Number.OkInt newOffset n ->
187 let
188 !newState = State fp newOffset terminal indent row (col + (newOffset - offset)) ctx
189 in
190 cok (Json.Integer n) newState noError
192 Number.OkFloat newOffset ->
193 let
194 !length = newOffset - offset
195 !scientific = read $ Char8.unpack $ B.PS fp offset length
196 !newState = State fp newOffset terminal indent row (col + length) ctx
197 in
198 cok (Json.Float scientific) newState noError
200 else if word == 0x30 {- 0 -} then
201 cok (Json.Integer 0) (State fp offset1 terminal indent row (col + 1) ctx) noError
203 else
204 eerr noError
206 else
207 eerr noError
212-- STRING
215string :: Parser Text.Text
216string =
217 Parser $ \(State fp offset terminal indent row col ctx) cok cerr _ eerr ->
218 if offset < terminal && I.unsafeIndex fp offset == 0x22 {- " -} then
220 let
221 !offset1 = offset + 1
222 in
223 case stringHelp fp offset1 terminal row (col + 1) of
224 Err err ->
225 cerr err
227 Ok newOffset newRow newCol ->
228 let
229 !newState = State fp newOffset terminal indent newRow newCol ctx
230 !content = Text.decodeUtf8 (B.PS fp offset1 (newOffset - offset1 - 1))
231 in
232 cok content newState noError
234 else
235 eerr noError
238data StringResult
239 = Err E.ParseError
240 | Ok !Int !Int !Int
243stringHelp :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> StringResult
244stringHelp fp offset terminal row col =
245 if offset >= terminal then
246 Err (E.ParseError row col E.EndOfFile_String)
248 else
249 case I.unsafeIndex fp offset of
250 0x22 {- " -} ->
251 Ok (offset + 1) row (col + 1)
253 0x0A {- \n -} ->
254 Err (E.ParseError row col E.NewLineInString)
256 0x5C {- \ -} ->
257 let
258 !offset1 = offset + 1
259 in
260 if offset1 < terminal then
262 let
263 !word = I.unsafeIndex fp offset1
264 !newOffset = offset1 + I.getCharWidth fp offset1 terminal word
265 in
266 stringHelp fp newOffset terminal row (col + 2)
268 else
269 Err (E.ParseError (row + 1) col E.EndOfFile_String)
271 word ->
272 let !newOffset = offset + I.getCharWidth fp offset terminal word in
273 stringHelp fp newOffset terminal row (col + 1)
278-- SPACES
281spaces :: Parser ()
282spaces =
283 Parser $ \(State fp offset terminal indent row col ctx) cok _ _ _ ->
284 let
285 (# newOffset, newRow, newCol #) =
286 eatSpaces fp offset terminal row col
288 !newState =
289 State fp newOffset terminal indent newRow newCol ctx
290 in
291 cok () newState noError
294eatSpaces :: ForeignPtr Word8 -> Int -> Int -> Int -> Int -> (# Int, Int, Int #)
295eatSpaces fp offset terminal row col =
296 if offset >= terminal then
297 (# offset, row, col #)
299 else
300 case I.unsafeIndex fp offset of
301 0x20 {- -} -> eatSpaces fp (offset + 1) terminal row (col + 1)
302 0x09 {- \t -} -> eatSpaces fp (offset + 1) terminal row (col + 1)
303 0x0A {- \n -} -> eatSpaces fp (offset + 1) terminal (row + 1) 1
304 0x0D {- \r -} -> eatSpaces fp (offset + 1) terminal row col
305 _ ->
306 (# offset, row, col #)