Last active
March 2, 2020 03:47
-
-
Save masaeedu/ad9b88ae2cda6171b6c0a3d4543083bc to your computer and use it in GitHub Desktop.
JSON biparser
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
{-# LANGUAGE LambdaCase, DeriveGeneric #-} | |
module Examples.Biparsing.JSON where | |
import MyPrelude hiding (exponent) | |
import GHC.Generics | |
import GHC.Natural | |
import Data.List.NonEmpty (NonEmpty(..)) | |
import Data.Generics.Wrapped (_Wrapped, _Unwrapped) | |
import Profunctor.Mux | |
import Profunctor.Demux | |
import Profunctor.Lazy | |
import Optics | |
import SOP.Sums | |
import SOP.Products | |
import Examples.Biparsing.Common | |
-- Let's build a biparser for the JSON grammar described here: https://www.json.org/json-en.html | |
data JSON = JSON { lpad :: Whitespace, val :: Value, rpad :: Whitespace } | |
deriving (Generic, Show) | |
-- Parse a JSON document | |
json :: Biparser' Maybe JSON | |
json = gprod $ jsonWhitespace /\ jsonValue /\ jsonWhitespace /\ start | |
data Value = N Number | S String | B Bool | Null | O Object | A Array | |
deriving (Generic, Show) | |
-- Parse a JSON value (without leading/trailing whitespace) | |
jsonValue :: Biparser' Maybe Value | |
jsonValue = gsum $ jsonNumber \/ jsonString \/ jsonBool \/ jsonNull \/ jsonObject \/ jsonArray \/ stop | |
data Number = Number { whole :: Int, fraction :: Maybe Natural, exponent :: Maybe Int } | |
deriving (Generic, Show) | |
-- Parse a JSON number | |
jsonNumber :: Biparser' Maybe Number | |
jsonNumber = gprod $ int /\ perhaps nat /\ perhaps int /\ start | |
data SpaceChar = Space | LF | CR | Tab | |
deriving (Generic, Show) | |
-- Parse a character representing a space in a JSON document | |
jsonSpaceChar :: Biparser' Maybe SpaceChar | |
jsonSpaceChar = gsum $ token_ " " \/ token_ "\n" \/ token_ "\r" \/ token_ "\t" \/ stop | |
type Whitespace = [SpaceChar] | |
-- Parse some whitespace in a JSON document | |
jsonWhitespace :: Biparser' Maybe Whitespace | |
jsonWhitespace = each jsonSpaceChar | |
-- Parse a normal character in a JSON string (anything but quotes or backslashes) | |
jsonNChar :: Biparser' Maybe Char | |
jsonNChar = re (predicate (\c -> c /= '\\' && c /= '"')) char | |
-- Special characters which need to be escaped with backslashes | |
isSpecial :: Char -> Bool | |
isSpecial c = c `elem` "\"\\/\b\f\n\r\t" | |
-- Distinguish characters by whether they're special or not | |
specialVsNormal :: Iso' Char (Escape + Char) | |
specialVsNormal = distinguish isSpecial . liftIsoFirst (convert _Wrapped) | |
-- Parse the escape code of a special character | |
jsonEscapeCode :: Biparser' Maybe Char | |
jsonEscapeCode = re (predicate isSpecial) $ asEscapeCode $ convert _Unwrapped $ char | |
-- Parse an escaped special character in a JSON string | |
jsonSChar :: Biparser' Maybe Escape | |
jsonSChar = token_ "\\" -\ convert _Unwrapped jsonEscapeCode | |
-- Parse a JSON string | |
jsonString :: Biparser' Maybe String | |
jsonString = token_ "\"" -\ (each $ specialVsNormal $ jsonSChar \/ jsonNChar) /- token_ "\"" | |
-- Parse a JSON boolean | |
jsonBool :: Biparser' Maybe Bool | |
jsonBool = gsum $ token_ "true" \/ token_ "false" \/ stop | |
-- Parse a JSON null | |
jsonNull :: Biparser' Maybe () | |
jsonNull = token_ "null" | |
data KeyValuePair = KeyValuePair { lead :: Whitespace, key :: String, sep :: Whitespace, value :: JSON } | |
deriving (Generic, Show) | |
-- Parse a JSON key value pair | |
jsonKeyValuePair :: Biparser' Maybe KeyValuePair | |
jsonKeyValuePair = gprod $ jsonWhitespace /\ jsonString /\ jsonWhitespace /\ token_ ":" -\ (defer $ \_ -> json) /\ start | |
type Object = NonEmpty KeyValuePair + Whitespace | |
-- Parse a JSON object | |
jsonObject :: Biparser' Maybe Object | |
jsonObject = token_ "{" -\ separated (token_ ",") jsonKeyValuePair \/ jsonWhitespace /- token_ "}" | |
type Array = NonEmpty JSON + Whitespace | |
-- Parse a JSON array | |
jsonArray :: Biparser' Maybe Array | |
jsonArray = token_ "[" -\ separated (token_ ",") (defer $ \_ -> json) \/ jsonWhitespace /- token_ "]" |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment
See this for runnable example