blob: 018e27d3072ab5224c972f5df9f46b7c7fb08f9c (
plain) (
blame)
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
|
-- | Json "Parsec" parser, based on
-- [json](https://hackage.haskell.org/package/json) package.
--
module Haddock.Utils.Json.Parser
( parseJSONValue
) where
import Prelude hiding (null)
import Control.Applicative (Alternative (..))
import Control.Monad (MonadPlus (..))
import Data.Char (isHexDigit)
import Data.Functor (($>))
import qualified Data.ByteString.Lazy.Char8 as BSCL
import Numeric
import Text.Parsec.ByteString.Lazy (Parser)
import Text.ParserCombinators.Parsec ((<?>))
import qualified Text.ParserCombinators.Parsec as Parsec
import Haddock.Utils.Json.Types hiding (object)
parseJSONValue :: Parser Value
parseJSONValue = Parsec.spaces *> parseValue
tok :: Parser a -> Parser a
tok p = p <* Parsec.spaces
parseValue :: Parser Value
parseValue =
parseNull
<|> Bool <$> parseBoolean
<|> Array <$> parseArray
<|> String <$> parseString
<|> Object <$> parseObject
<|> Number <$> parseNumber
<?> "JSON value"
parseNull :: Parser Value
parseNull = tok
$ Parsec.string "null"
$> Null
parseBoolean :: Parser Bool
parseBoolean = tok
$ Parsec.string "true" $> True
<|> Parsec.string "false" $> False
parseArray :: Parser [Value]
parseArray =
Parsec.between
(tok (Parsec.char '['))
(tok (Parsec.char ']'))
(parseValue `Parsec.sepBy` tok (Parsec.char ','))
parseString :: Parser String
parseString =
Parsec.between
(tok (Parsec.char '"'))
(tok (Parsec.char '"'))
(many char)
where
char = (Parsec.char '\\' >> escapedChar)
<|> Parsec.satisfy (\x -> x /= '"' && x /= '\\')
escapedChar =
Parsec.char '"' $> '"'
<|> Parsec.char '\\' $> '\\'
<|> Parsec.char '/' $> '/'
<|> Parsec.char 'b' $> '\b'
<|> Parsec.char 'f' $> '\f'
<|> Parsec.char 'n' $> '\n'
<|> Parsec.char 'r' $> '\r'
<|> Parsec.char 't' $> '\t'
<|> Parsec.char 'u' *> uni
<?> "escape character"
uni = check =<< Parsec.count 4 (Parsec.satisfy isHexDigit)
where
check x | code <= max_char = return (toEnum code)
| otherwise = mzero
where code = fst $ head $ readHex x
max_char = fromEnum (maxBound :: Char)
parseObject :: Parser Object
parseObject =
Parsec.between
(tok (Parsec.char '{'))
(tok (Parsec.char '}'))
(field `Parsec.sepBy` tok (Parsec.char ','))
where
field :: Parser (String, Value)
field = (,)
<$> parseString
<* tok (Parsec.char ':')
<*> parseValue
parseNumber :: Parser Double
parseNumber = tok $ do
s <- BSCL.unpack <$> Parsec.getInput
case readSigned readFloat s of
[(n,s')] -> Parsec.setInput (BSCL.pack s') $> n
_ -> mzero
|
