commit
b9a6240c37
@ -0,0 +1,3 @@ |
||||
.stack-work/ |
||||
json-parser.cabal |
||||
*~ |
@ -0,0 +1,30 @@ |
||||
Copyright Abhinav Sarkar (c) 2018 |
||||
|
||||
All rights reserved. |
||||
|
||||
Redistribution and use in source and binary forms, with or without |
||||
modification, are permitted provided that the following conditions are met: |
||||
|
||||
* Redistributions of source code must retain the above copyright |
||||
notice, this list of conditions and the following disclaimer. |
||||
|
||||
* Redistributions in binary form must reproduce the above |
||||
copyright notice, this list of conditions and the following |
||||
disclaimer in the documentation and/or other materials provided |
||||
with the distribution. |
||||
|
||||
* Neither the name of Abhinav Sarkar nor the names of other |
||||
contributors may be used to endorse or promote products derived |
||||
from this software without specific prior written permission. |
||||
|
||||
THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS |
||||
"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT |
||||
LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR |
||||
A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT |
||||
OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, |
||||
SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT |
||||
LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, |
||||
DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY |
||||
THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT |
||||
(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE |
||||
OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. |
@ -0,0 +1,3 @@ |
||||
# json-parser |
||||
|
||||
Simple JSON parser written from scratch in Haskell. Meant for teaching/illustrative purposes only. |
@ -0,0 +1,11 @@ |
||||
module Main where |
||||
|
||||
import JSONParser (parseJSON) |
||||
import Text.Pretty.Simple (pPrintNoColor) |
||||
|
||||
main :: IO () |
||||
main = do |
||||
s <- getContents |
||||
case parseJSON s of |
||||
Nothing -> error "JSON parsing failed" |
||||
Just j -> pPrintNoColor j |
@ -0,0 +1,50 @@ |
||||
name: json-parser |
||||
version: 0.1.0.0 |
||||
github: "abhin4v/hs-json-parser" |
||||
license: BSD3 |
||||
author: "Abhinav Sarkar" |
||||
maintainer: "abhinav@abhinavsarkar.net" |
||||
copyright: "2018 Abhinav Sarkar" |
||||
|
||||
extra-source-files: |
||||
- README.md |
||||
|
||||
# Metadata used when publishing your package |
||||
# synopsis: Short description of your package |
||||
# category: Web |
||||
|
||||
# To avoid duplicated efforts in documentation and dealing with the |
||||
# complications of embedding Haddock markup inside cabal files, it is |
||||
# common to point users to the README.md file. |
||||
description: Please see the README on Github at <https://github.com/abhin4v/hs-json-parser#readme> |
||||
|
||||
dependencies: |
||||
- base >= 4.7 && < 5 |
||||
|
||||
library: |
||||
source-dirs: src |
||||
dependencies: [] |
||||
exposed-modules: |
||||
- JSONParser |
||||
ghc-options: |
||||
- -Wall |
||||
|
||||
executables: |
||||
ppj: |
||||
main: Main.hs |
||||
source-dirs: app |
||||
ghc-options: [] |
||||
dependencies: |
||||
- json-parser |
||||
- pretty-simple |
||||
|
||||
tests: |
||||
json-parser-test: |
||||
main: Spec.hs |
||||
source-dirs: test |
||||
ghc-options: |
||||
- -threaded |
||||
- -rtsopts |
||||
- -with-rtsopts=-N |
||||
dependencies: |
||||
- json-parser |
@ -0,0 +1,165 @@ |
||||
module JSONParser where |
||||
|
||||
import Control.Applicative (Alternative(..), optional) |
||||
import Control.Monad (replicateM) |
||||
import Data.Char (isDigit, isHexDigit, isSpace, isControl, chr, digitToInt) |
||||
import Data.Functor (($>)) |
||||
import Data.List (intercalate) |
||||
|
||||
newtype Parser i o = Parser { runParser :: i -> Maybe (i, o) } |
||||
|
||||
instance Functor (Parser i) where |
||||
fmap f p = Parser $ fmap (fmap f) . runParser p |
||||
|
||||
instance Applicative (Parser i) where |
||||
pure x = Parser $ pure . (\a -> (a, x)) |
||||
pf <*> po = Parser $ \input -> case runParser pf input of |
||||
Nothing -> Nothing |
||||
Just (rest, f) -> fmap f <$> runParser po rest |
||||
|
||||
instance Alternative (Parser i) where |
||||
empty = Parser $ const Nothing |
||||
p1 <|> p2 = Parser $ \input -> runParser p1 input <|> runParser p2 input |
||||
|
||||
satisfy :: (a -> Bool) -> Parser [a] a |
||||
satisfy p = Parser $ \i -> case i of |
||||
(x:xs) | p x -> Just (xs, x) |
||||
_ -> Nothing |
||||
|
||||
char :: Char -> Parser String Char |
||||
char c = satisfy (== c) |
||||
|
||||
digit :: Parser String Int |
||||
digit = digitToInt <$> satisfy isDigit |
||||
|
||||
hexDigit :: Parser String Int |
||||
hexDigit = digitToInt <$> satisfy isHexDigit |
||||
|
||||
string :: String -> Parser String String |
||||
string "" = pure "" |
||||
string (c:cs) = (:) <$> char c <*> string cs |
||||
|
||||
space :: Parser String Char |
||||
space = satisfy isSpace |
||||
|
||||
digits :: Parser String [Int] |
||||
digits = some digit |
||||
|
||||
spaces :: Parser String String |
||||
spaces = many space |
||||
|
||||
surroundedBy :: Parser String a -> Parser String b -> Parser String a |
||||
surroundedBy p1 p2 = p2 *> p1 <* p2 |
||||
|
||||
separatedBy :: Parser i v -> Parser i s -> Parser i [v] |
||||
separatedBy v s = (:) <$> v <*> many (s *> v) <|> pure [] |
||||
|
||||
data JValue = JNull |
||||
| JBool Bool |
||||
| JString String |
||||
| JNumber { significand :: Integer, exponent :: Integer} |
||||
| JArray [JValue] |
||||
| JObject [(String, JValue)] |
||||
deriving (Eq) |
||||
|
||||
instance Show JValue where |
||||
show value = case value of |
||||
JNull -> "null" |
||||
JBool True -> "true" |
||||
JBool False -> "false" |
||||
JString s -> "\"" ++ s ++ "\"" |
||||
JNumber s e -> if e == 0 then show s else show s ++ "e" ++ show e |
||||
JArray a -> "[" ++ intercalate ", " (map show a) ++ "]" |
||||
JObject o -> "{" ++ intercalate ", " (map (\(k, v) -> show k ++ ": " ++ show v) o) ++ "}" |
||||
|
||||
jNull :: Parser String JValue |
||||
jNull = string "null" $> JNull |
||||
|
||||
jBool :: Parser String JValue |
||||
jBool = string "true" $> JBool True |
||||
<|> string "false" $> JBool False |
||||
|
||||
digitsToNumber :: Int -> Integer -> [Int] -> Integer |
||||
digitsToNumber base = foldl (\num d -> num * fromIntegral base + fromIntegral d) |
||||
|
||||
jString :: Parser String JValue |
||||
jString = JString <$> (char '"' *> many jsonChar <* char '"') |
||||
where |
||||
jsonChar = satisfy (\c -> not (c == '\"' || c == '\\' || isControl c)) |
||||
<|> string "\\\"" $> '"' |
||||
<|> string "\\\\" $> '\\' |
||||
<|> string "\\/" $> '/' |
||||
<|> string "\\b" $> '\b' |
||||
<|> string "\\f" $> '\f' |
||||
<|> string "\\n" $> '\n' |
||||
<|> string "\\r" $> '\r' |
||||
<|> string "\\t" $> '\t' |
||||
<|> chr . fromIntegral . digitsToNumber 16 0 <$> (string "\\u" *> replicateM 4 hexDigit) |
||||
|
||||
digit19 :: Parser String Int |
||||
digit19 = digitToInt <$> satisfy (\x -> isDigit x && x /= '0') |
||||
|
||||
jUInt :: Parser String Integer |
||||
jUInt = (\d ds -> digitsToNumber 10 0 (d:ds)) <$> digit19 <*> digits |
||||
<|> fromIntegral <$> digit |
||||
|
||||
data Sign = Positive | Negative |
||||
|
||||
jInt' :: Parser String (Sign, Integer) |
||||
jInt' = mkInt <$> optional (char '-') <*> jUInt |
||||
where |
||||
mkInt (Just '-') i = (Negative, i) |
||||
mkInt _ i = (Positive, i) |
||||
|
||||
applySign :: (Sign, Integer) -> Integer |
||||
applySign (Negative, i) = negate i |
||||
applySign (Positive, i) = i |
||||
|
||||
jFrac :: Parser String [Int] |
||||
jFrac = char '.' *> digits |
||||
|
||||
jExp :: Parser String Integer |
||||
jExp = (char 'e' <|> char 'E') *> (mkExp <$> optional (char '+' <|> char '-') <*> jUInt) |
||||
where |
||||
mkExp (Just '-') i = negate i |
||||
mkExp _ i = i |
||||
|
||||
jInt :: Parser String JValue |
||||
jInt = JNumber <$> (applySign <$> jInt') <*> pure 0 |
||||
|
||||
jIntExp :: Parser String JValue |
||||
jIntExp = JNumber <$> (applySign <$> jInt') <*> jExp |
||||
|
||||
jIntFrac :: Parser String JValue |
||||
jIntFrac = |
||||
(\(sign, i) f -> JNumber (applySign (sign, digitsToNumber 10 i f)) (fromIntegral . negate . length $ f)) |
||||
<$> jInt' <*> jFrac |
||||
|
||||
jIntFracExp :: Parser String JValue |
||||
jIntFracExp = (\ ~(JNumber i e) e' -> JNumber i (e + e')) <$> jIntFrac <*> jExp |
||||
|
||||
jNumber :: Parser String JValue |
||||
jNumber = jIntFracExp <|> jIntExp <|> jIntFrac <|> jInt |
||||
|
||||
jArray :: Parser String JValue |
||||
jArray = JArray <$> (char '[' *> (jValue `separatedBy` char ',' `surroundedBy` spaces) <* char ']') |
||||
|
||||
jObject :: Parser String JValue |
||||
jObject = JObject <$> (char '{' *> pair `separatedBy` char ',' <* char '}') |
||||
where |
||||
pair = (\ ~(JString s) j -> (s, j)) <$> (jString `surroundedBy` spaces) <* char ':' <*> jValue |
||||
|
||||
jValue :: Parser String JValue |
||||
jValue = jValue' `surroundedBy` spaces |
||||
where |
||||
jValue' = jNull |
||||
<|> jBool |
||||
<|> jString |
||||
<|> jNumber |
||||
<|> jArray |
||||
<|> jObject |
||||
|
||||
parseJSON :: String -> Maybe JValue |
||||
parseJSON s = case runParser jValue s of |
||||
Just ("", j) -> Just j |
||||
_ -> Nothing |
@ -0,0 +1,10 @@ |
||||
resolver: lts-10.6 |
||||
|
||||
packages: |
||||
- . |
||||
|
||||
# extra-deps: [] |
||||
|
||||
# flags: {} |
||||
|
||||
# extra-package-dbs: [] |
@ -0,0 +1,2 @@ |
||||
main :: IO () |
||||
main = putStrLn "Test suite not yet implemented" |
Loading…
Reference in new issue