{-# OPTIONS_GHC -Wno-missing-signatures -Wno-unused-do-bind #-}
-- | Ron routines for deserialization. Also exposes the underlying attoparsec
-- parsers if you want to build more complicated consumers of ron, like
-- conduits or pipes
module Data.Ron.Deserialize
    ( decode, decodeLazy, decodeFile
    , loads, loadsLazy, loadFile, loadFile'
    -- * Exceptions
    , ParseError, DecodeError
    -- * Parsers
    , document, toplevel, value, ronWhitespace
    ) where

import Control.Applicative ((<|>), liftA2)
import Control.Exception (Exception, throwIO)
import Data.Attoparsec.ByteString (skip)
import Data.ByteString.Char8 (ByteString, cons)
import Data.ByteString.Lazy (toStrict)
import Data.Char (isAlpha, isAlphaNum, chr)
import Data.List (intercalate)
import Data.Map.Strict (Map)
import Data.Ron.Class (FromRon, fromRon)
import Data.Scientific (Scientific, scientific)
import Data.Text (Text, uncons)
import Data.Text.Encoding (decodeUtf8, decodeUtf8')
import Data.Typeable (Typeable)
import Data.Vector (Vector)

import qualified Data.Map.Strict as Map
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.ByteString.Char8 as ByteString8
import qualified Data.ByteString.Builder as Builder
import qualified Data.Text as Text
import qualified Data.Vector as Vector

import Data.Attoparsec.ByteString.Char8 hiding (feed, hexadecimal, decimal, isSpace, scientific)
import Data.Ron.Value
import Prelude hiding (takeWhile)


-- Each parser function assumes there is no whitespace before it, and must
-- consume all whitespace after it.
--
-- Parsers don't backtrack at all (except a few characters back sometimes
-- internally). It's mostly possible to understand what value is in front of us
-- by its first character, but sometimes we do have to parse the whole
-- identifier or number to see what character comes after it. The parsers xOrY
-- take care of that.
-- But just using those xOrY is not enough at times, since I didn't figure out
-- how to compose them properly: there are a lot of places where this ambiguity
-- arises. So i just duplicated that code. It's still not that bad, but could
-- be a lot better..
--
-- Also, fucking raw strings. Why not just start them with '#'?


--- Decode functions


-- | Parse a 'ByteString' to your type. The error is produced by attoparsec and is
-- not very useful.
decode :: FromRon a => ByteString -> Either String a
decode :: forall a. FromRon a => ByteString -> Either String a
decode ByteString
str = ByteString -> Either String Value
loads ByteString
str Either String Value
-> (Value -> Either String a) -> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Either String a
forall a. FromRon a => Value -> ParseResult a
fromRon

-- | Parse a lazy 'Lazy.ByteString' to your type. The error is produced by
-- attoparsec and is not very useful.
decodeLazy :: FromRon a => Lazy.ByteString -> Either String a
decodeLazy :: forall a. FromRon a => ByteString -> Either String a
decodeLazy ByteString
str = ByteString -> Either String Value
loadsLazy ByteString
str Either String Value
-> (Value -> Either String a) -> Either String a
forall a b.
Either String a -> (a -> Either String b) -> Either String b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Either String a
forall a. FromRon a => Value -> ParseResult a
fromRon

-- | Parse file content to your type. Throws 'ParseError' or 'DecodeError' on
-- errors.
decodeFile :: FromRon a => FilePath -> IO a
decodeFile :: forall a. FromRon a => String -> IO a
decodeFile String
path = String -> IO Value
loadFile String
path IO Value -> (Value -> IO (ParseResult a)) -> IO (ParseResult a)
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ParseResult a -> IO (ParseResult a)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ParseResult a -> IO (ParseResult a))
-> (Value -> ParseResult a) -> Value -> IO (ParseResult a)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ParseResult a
forall a. FromRon a => Value -> ParseResult a
fromRon IO (ParseResult a) -> (ParseResult a -> IO a) -> IO a
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
err -> DecodeError -> IO a
forall e a. Exception e => e -> IO a
throwIO (DecodeError -> IO a) -> DecodeError -> IO a
forall a b. (a -> b) -> a -> b
$! String -> DecodeError
DecodeError String
err
    Right a
x -> a -> IO a
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x

-- | Parse a 'ByteString' to a 'Value'. You probably want 'decode' instead
loads :: ByteString -> Either String Value
loads :: ByteString -> Either String Value
loads = Parser Value -> ByteString -> Either String Value
forall a. Parser a -> ByteString -> Either String a
parseOnly Parser Value
document

-- | Parse a lazy 'Lazy.ByteString' to a 'Value'. You probably want
-- 'decodeLazy' instead
loadsLazy :: Lazy.ByteString -> Either String Value
loadsLazy :: ByteString -> Either String Value
loadsLazy ByteString
str = case ByteString -> [ByteString]
Lazy.toChunks ByteString
str of
    [] -> String -> Either String Value
forall a b. a -> Either a b
Left String
"Empty input"
    ByteString
s:[ByteString]
ss -> [ByteString] -> IResult ByteString Value -> Either String Value
forall {i} {b}. IsString i => [i] -> IResult i b -> Either String b
go [ByteString]
ss (IResult ByteString Value -> Either String Value)
-> IResult ByteString Value -> Either String Value
forall a b. (a -> b) -> a -> b
$! Parser Value -> ByteString -> IResult ByteString Value
forall a. Parser a -> ByteString -> Result a
parse Parser Value
document ByteString
s
  where
    -- since toplevel requires eof after end, _rest should always be nothing
    go :: [i] -> IResult i b -> Either String b
go [i]
_ (Fail i
_rest [String]
contexts String
message) = String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$
        String
"Parse error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message
        String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; context: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [String]
contexts
    go [] (Done i
_rest b
x) = b -> Either String b
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
    go [i]
_ (Done i
_rest b
_x) = String -> Either String b
forall a b. a -> Either a b
Left String
"Unconsumed input after value"
    go (i
s:[i]
ss) (Partial i -> IResult i b
feed) = [i] -> IResult i b -> Either String b
go [i]
ss (IResult i b -> Either String b) -> IResult i b -> Either String b
forall a b. (a -> b) -> a -> b
$! i -> IResult i b
feed i
s
    go [] (Partial i -> IResult i b
feed) = case i -> IResult i b
feed i
"" of
        (Fail i
_rest [String]
contexts String
message) -> String -> Either String b
forall a b. a -> Either a b
Left (String -> Either String b) -> String -> Either String b
forall a b. (a -> b) -> a -> b
$
            String
"Parse error: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
message
            String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"; context: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate String
"; " [String]
contexts
        (Done i
_rest b
x) -> b -> Either String b
forall a. a -> Either String a
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
x
        (Partial i -> IResult i b
_) -> String -> Either String b
forall a b. a -> Either a b
Left String
"Unexpected end of input"

-- | Parse file. Throws 'ParseError'
loadFile :: FilePath -> IO Value
loadFile :: String -> IO Value
loadFile String
path = String -> IO (Either String Value)
loadFile' String
path IO (Either String Value)
-> (Either String Value -> IO Value) -> IO Value
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Left String
err -> ParseError -> IO Value
forall e a. Exception e => e -> IO a
throwIO (ParseError -> IO Value) -> ParseError -> IO Value
forall a b. (a -> b) -> a -> b
$! String -> ParseError
ParseError String
err
    Right Value
x -> Value -> IO Value
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
x

-- | Parse file and return the error in 'Either'
loadFile' :: FilePath -> IO (Either String Value)
loadFile' :: String -> IO (Either String Value)
loadFile' String
path = ByteString -> Either String Value
loadsLazy (ByteString -> Either String Value)
-> IO ByteString -> IO (Either String Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> IO ByteString
Lazy.readFile String
path


--- Parsers

-- | A parser for a complete Ron document, consisting of a single value.
-- Expects EOF at the end. Will parse Ron notation, or a toplevel record with
-- no braces, or a toplevel list with no braces; the latter two are ron-hs
-- extensions.
document :: Parser Value
document :: Parser Value
document = Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Value
toplevel Parser Value -> Parser () -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* do
    Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser ()) -> Parser ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Char
Nothing -> () -> Parser ()
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just Char
s -> String -> Parser ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser ()) -> String -> Parser ()
forall a b. (a -> b) -> a -> b
$ String
"Expected eof, got data starting with " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
s

-- | Toplevel is either a toplevel 'list', toplevel 'record', or a regular ron
-- 'value'. The first two are ron-hs extensions.
--
-- This is similar to 'document', but won't parse whitespace before self, and
-- doesn't expect EOF at the end.
toplevel :: Parser Value
toplevel :: Parser Value
toplevel = Parser Char
peekChar' Parser Char -> (Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- raw string, algebraic struct, or a field in toplevel 'record'
    Char
'r' -> Parser ()
skip1 Parser () -> Parser (Maybe Char) -> Parser (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Maybe Char
Nothing -> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Unit Text
"r"
        Just Char
'#' -> Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
ronRawString
        Just Char
'\"' -> Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
ronRawString
        Maybe Char
_ -> do
            Text
ident <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
cons Char
'r' (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword
            Parser ()
ws
            Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Char
'(' -> Text -> Parser Value
recordOrTuple Text
ident Parser Value -> (Value -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Value
toplevelList
                Just Char
':' -> Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Value
toplevelRecord Text
ident
                Maybe Char
_ -> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value
Unit Text
ident)
    Char
c | Char -> Bool
startsIdentifier Char
c -> do
            Text
ident <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword
            Parser ()
ws
            Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Char
'(' -> Text -> Parser Value
recordOrTuple Text
ident Parser Value -> (Value -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Value
toplevelList
                Just Char
':' -> Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Text -> Parser Value
toplevelRecord Text
ident
                Maybe Char
_ -> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
toplevelList (Text -> Value
Unit Text
ident)
      | Bool
otherwise -> Parser Value
value Parser Value -> (Value -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Value -> Parser Value
toplevelList

toplevelList :: Value -> Parser Value
toplevelList :: Value -> Parser Value
toplevelList Value
first = Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just Char
',' -> do
        Parser ()
skip1 -- ,
        Parser ()
ws
        [Value]
xs <- Parser Value -> Parser () -> Parser ByteString [Value]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Value
value (Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws)
        () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws
        Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value)
-> ([Value] -> Value) -> [Value] -> Parser Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> Value
List (Vector Value -> Value)
-> ([Value] -> Vector Value) -> [Value] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Parser Value) -> [Value] -> Parser Value
forall a b. (a -> b) -> a -> b
$ Value
firstValue -> [Value] -> [Value]
forall a. a -> [a] -> [a]
:[Value]
xs
    Maybe Char
_ -> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
first

toplevelRecord :: Text -> Parser Value
toplevelRecord :: Text -> Parser Value
toplevelRecord Text
firstField = do
    Value
firstValue <- Parser Value
value
    let initial :: (Text, Value)
initial = (Text
firstField, Value
firstValue)
    Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Char
',' -> do
            Parser ()
skip1 -- ,
            Parser ()
ws
            let pair :: Parser ByteString (Text, Value)
pair = do
                    ByteString
k <- (Char -> ByteString -> ByteString)
-> Parser Char
-> Parser ByteString ByteString
-> Parser ByteString ByteString
forall a b c.
(a -> b -> c)
-> Parser ByteString a
-> Parser ByteString b
-> Parser ByteString c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> ByteString -> ByteString
cons ((Char -> Bool) -> Parser Char
satisfy Char -> Bool
startsIdentifier) ((Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword)
                    Parser ()
ws
                    Char -> Parser Char
char Char
':'
                    Parser ()
ws
                    Value
v <- Parser Value
value
                    (Text, Value) -> Parser ByteString (Text, Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Text
decodeUtf8 ByteString
k, Value
v)
            [(Text, Value)]
xs <- Parser ByteString (Text, Value)
-> Parser () -> Parser ByteString [(Text, Value)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser ByteString (Text, Value)
pair (Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws)
            () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws
            Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value)
-> ([(Text, Value)] -> Value) -> [(Text, Value)] -> Parser Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Value -> Value
Record Text
"" (Map Text Value -> Value)
-> ([(Text, Value)] -> Map Text Value) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Value)] -> Parser Value)
-> [(Text, Value)] -> Parser Value
forall a b. (a -> b) -> a -> b
$ (Text, Value)
initial(Text, Value) -> [(Text, Value)] -> [(Text, Value)]
forall a. a -> [a] -> [a]
:[(Text, Value)]
xs
        Maybe Char
Nothing -> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value)
-> ([(Text, Value)] -> Value) -> [(Text, Value)] -> Parser Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Map Text Value -> Value
Record Text
"" (Map Text Value -> Value)
-> ([(Text, Value)] -> Map Text Value) -> [(Text, Value)] -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Value)] -> Parser Value)
-> [(Text, Value)] -> Parser Value
forall a b. (a -> b) -> a -> b
$ [(Text, Value)
initial]
        Maybe Char
_ -> String -> Parser Value
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting , at toplevel record"

-- | A ron value as defined by the ron-rs spec (with minor deviations described
-- in this package).
--
-- Unlike 'toplevel', this won't parse bare toplevel list or record. Unlike
-- 'document' and like 'toplevel', won't parse whitespace before self, and
-- doesn't expect EOF at the end.
value :: Parser Value
value :: Parser Value
value = Parser Char
peekChar' Parser Char -> (Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Char
c | Char -> Bool
startsNumber Char
c -> Parser Value
intOrFloat
      | Char -> Bool
startsChar Char
c -> Char -> Value
Char (Char -> Value) -> Parser Char -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Char
character
      | Char -> Bool
startsString Char
c -> Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
ronString
      | Char -> Bool
startsList Char
c -> Vector Value -> Value
List (Vector Value -> Value)
-> Parser ByteString (Vector Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Vector Value)
list
      | Char -> Bool
startsMap Char
c -> Map Value Value -> Value
Map (Map Value Value -> Value)
-> Parser ByteString (Map Value Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString (Map Value Value)
ronMap
      | Char -> Bool
startsStruct Char
c -> Text -> Parser Value
recordOrTuple Text
""
      | Char -> Bool
startsIdentifier Char
c -> Char -> Parser Value
identifierLike Char
c
      | Bool
otherwise -> String -> Parser Value
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Parser Value) -> String -> Parser Value
forall a b. (a -> b) -> a -> b
$ String
"Unexpected symbol: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Char -> String
forall a. Show a => a -> String
show Char
c

-- | Whitespace as defined by ron-rs spec. Useful if you want to build your
-- custom attoparsec parsers from 'value' or 'toplevel'.
ronWhitespace :: Parser ()
ronWhitespace :: Parser ()
ronWhitespace = Parser ()
ws


--- Numbers ---


intOrFloat :: Parser Value
intOrFloat :: Parser Value
intOrFloat = Parser Value
go Parser Value -> Parser () -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws where
  go :: Parser Value
go = do
    !Bool
positive <- ((Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+') (Char -> Bool) -> Parser Char -> Parser ByteString Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser Char
satisfy (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+'))
             Parser ByteString Bool
-> Parser ByteString Bool -> Parser ByteString Bool
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> Parser ByteString Bool
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
True
    let intOrFloatSimple :: Parser Value
intOrFloatSimple = do
            ByteString
whole <- (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
c -> Char -> Bool
decimalDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_')
            Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Just Char
'.' -> Parser ()
skip1 Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Scientific -> Value
Floating (Scientific -> Value)
-> Parser ByteString Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ByteString -> Parser ByteString Scientific
floating Bool
positive ByteString
whole)
                Just Char
'e' -> Scientific -> Value
Floating (Scientific -> Value)
-> Parser ByteString Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ByteString -> Parser ByteString Scientific
floating Bool
positive ByteString
whole
                Maybe Char
_ -> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Value
Integral (Integer -> Value) -> Integer -> Value
forall a b. (a -> b) -> a -> b
$ Integer -> Bool -> ByteString -> Integer
buildNumber Integer
10 Bool
positive ByteString
whole)
    Parser Char
peekChar' Parser Char -> (Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Char
'.' -> Parser ()
skip1 Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Scientific -> Value
Floating (Scientific -> Value)
-> Parser ByteString Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ByteString -> Parser ByteString Scientific
floating Bool
positive ByteString
"0")
        Char
'0' -> Parser ()
skip1 Parser () -> Parser (Maybe Char) -> Parser (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Maybe Char
Nothing -> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Integer -> Value
Integral Integer
0
            Just Char
'x' -> Parser ()
skip1 Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Integer -> Value
Integral (Integer -> Value) -> Parser ByteString Integer -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser ByteString Integer
hexadecimal Bool
positive)
            Just Char
'o' -> Parser ()
skip1 Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Integer -> Value
Integral (Integer -> Value) -> Parser ByteString Integer -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser ByteString Integer
octal Bool
positive)
            Just Char
'b' -> Parser ()
skip1 Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Integer -> Value
Integral (Integer -> Value) -> Parser ByteString Integer -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> Parser ByteString Integer
binary Bool
positive)
            Just Char
'.' -> Parser ()
skip1 Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Scientific -> Value
Floating (Scientific -> Value)
-> Parser ByteString Scientific -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> ByteString -> Parser ByteString Scientific
floating Bool
positive ByteString
"0")
            Just Char
_ -> Parser Value
intOrFloatSimple
        Char
_ -> Parser Value
intOrFloatSimple

buildNumber :: Integer -> Bool -> ByteString -> Integer
buildNumber :: Integer -> Bool -> ByteString -> Integer
buildNumber Integer
base Bool
positive ByteString
digits = Integer -> Integer
mbNegate (Integer -> Integer)
-> (ByteString -> Integer) -> ByteString -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Integer -> Char -> Integer) -> Integer -> ByteString -> Integer
forall a. (a -> Char -> a) -> a -> ByteString -> a
ByteString8.foldl' Integer -> Char -> Integer
step Integer
0 (ByteString -> Integer) -> ByteString -> Integer
forall a b. (a -> b) -> a -> b
$ ByteString
digits where
    mbNegate :: Integer -> Integer
mbNegate = if Bool
positive then Integer -> Integer
forall a. a -> a
id else Integer -> Integer
forall a. Num a => a -> a
negate
    step :: Integer -> Char -> Integer
step !Integer
a Char
'_' = Integer
a
    step !Integer
a !Char
d = Integer
a Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
base Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Char -> Integer
toDigit Char
d
    toDigit :: Char -> Integer
toDigit = \case
        Char
'0' -> Integer
0
        Char
'1' -> Integer
1
        Char
'2' -> Integer
2
        Char
'3' -> Integer
3
        Char
'4' -> Integer
4
        Char
'5' -> Integer
5
        Char
'6' -> Integer
6
        Char
'7' -> Integer
7
        Char
'8' -> Integer
8
        Char
'9' -> Integer
9
        Char
'a' -> Integer
10
        Char
'b' -> Integer
11
        Char
'c' -> Integer
12
        Char
'd' -> Integer
13
        Char
'e' -> Integer
14
        Char
'f' -> Integer
15
        Char
'A' -> Integer
10
        Char
'B' -> Integer
11
        Char
'C' -> Integer
12
        Char
'D' -> Integer
13
        Char
'E' -> Integer
14
        Char
'F' -> Integer
15
        Char
_ -> String -> Integer
forall a. HasCallStack => String -> a
error String
"Not a number"

hexadecimal :: Bool -> Parser ByteString Integer
hexadecimal Bool
positive
    = Integer -> Bool -> ByteString -> Integer
buildNumber Integer
16 Bool
positive (ByteString -> Integer)
-> Parser ByteString ByteString -> Parser ByteString Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
hexadecimalDigit Char
c) Parser ByteString Integer -> Parser () -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws
decimal :: Bool -> Parser ByteString Integer
decimal Bool
positive
    = Integer -> Bool -> ByteString -> Integer
buildNumber Integer
10 Bool
positive (ByteString -> Integer)
-> Parser ByteString ByteString -> Parser ByteString Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
decimalDigit Char
c) Parser ByteString Integer -> Parser () -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws
octal :: Bool -> Parser ByteString Integer
octal Bool
positive
    = Integer -> Bool -> ByteString -> Integer
buildNumber Integer
8 Bool
positive (ByteString -> Integer)
-> Parser ByteString ByteString -> Parser ByteString Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
octalDigit Char
c) Parser ByteString Integer -> Parser () -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws
binary :: Bool -> Parser ByteString Integer
binary Bool
positive
    = Integer -> Bool -> ByteString -> Integer
buildNumber Integer
2 Bool
positive (ByteString -> Integer)
-> Parser ByteString ByteString -> Parser ByteString Integer
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
binaryDigit Char
c) Parser ByteString Integer -> Parser () -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws

floating :: Bool -> ByteString -> Parser Scientific
floating :: Bool -> ByteString -> Parser ByteString Scientific
floating Bool
positive !ByteString
wholeStr = do
    -- dot is already skipped, e is not
    !ByteString
fracStr <- (Char -> Bool) -> Parser ByteString ByteString
takeWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char -> Bool
decimalDigit Char
c)
    let !fracPart :: Integer
fracPart = Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$! Integer -> Bool -> ByteString -> Integer
buildNumber Integer
10 Bool
positive ByteString
fracStr
    let !wholePart :: Integer
wholePart = Integer -> Integer
forall a. Num a => Integer -> a
fromInteger (Integer -> Integer) -> Integer -> Integer
forall a b. (a -> b) -> a -> b
$! Integer -> Bool -> ByteString -> Integer
buildNumber Integer
10 Bool
positive ByteString
wholeStr
    let !shift :: Integer
shift = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Integer) -> Int -> Integer
forall a b. (a -> b) -> a -> b
$! ByteString -> Int
ByteString.length ByteString
fracStr
    !Integer
e <- ((Char -> Bool) -> Parser Char
satisfy (\Char
w -> Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
w Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E') Parser Char
-> Parser ByteString Integer -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ByteString Integer
decimal') Parser ByteString Integer
-> Parser ByteString Integer -> Parser ByteString Integer
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Integer -> Parser ByteString Integer
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
0
    let !mantissa :: Integer
mantissa = Integer
wholePart Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10Integer -> Integer -> Integer
forall a b. (Num a, Integral b) => a -> b -> a
^Integer
shift Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
fracPart
    let !power :: Integer
power = Integer
e Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
shift
    Parser ()
ws
    Scientific -> Parser ByteString Scientific
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Scientific -> Parser ByteString Scientific)
-> Scientific -> Parser ByteString Scientific
forall a b. (a -> b) -> a -> b
$! Integer -> Int -> Scientific
scientific Integer
mantissa (Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Integer
power)
    where
        decimal' :: Parser ByteString Integer
decimal' = Parser Char
peekChar' Parser Char
-> (Char -> Parser ByteString Integer) -> Parser ByteString Integer
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Char
'+' -> Parser ()
skip1 Parser () -> Parser ByteString Integer -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser ByteString Integer
decimal Bool
True
            Char
'-' -> Parser ()
skip1 Parser () -> Parser ByteString Integer -> Parser ByteString Integer
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Bool -> Parser ByteString Integer
decimal Bool
False
            Char
c | Char -> Bool
isDigit Char
c -> Bool -> Parser ByteString Integer
decimal Bool
True
            Char
_ -> String -> Parser ByteString Integer
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expected + or - or digit (scientific notation power)"


--- Strings ---


character :: Parser Char
character :: Parser Char
character = Parser ()
skip1 Parser () -> Parser Char -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
peekChar' Parser Char -> (Char -> Parser Char) -> Parser Char
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Char
'\\' -> Parser ()
skip1 Parser () -> Parser Char -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Char
escapedChar Parser Char -> Parser Char -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Char -> Parser Char
char Char
'\'' Parser Char -> Parser () -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws
  Char
_ -> do
    ByteString
chunk <- (Char -> Bool) -> Parser ByteString ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\'')
    Parser ()
skip1
    Parser ()
ws
    Text
text <- case ByteString -> Either UnicodeException Text
decodeUtf8' ByteString
chunk of
            Right Text
x -> Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
x
            Left UnicodeException
_err -> String -> Parser ByteString Text
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Incorrect utf8 in Char"
    case Text -> Maybe (Char, Text)
uncons Text
text of
        Just (Char
c, Text
cs) | Text -> Int
Text.length Text
cs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
c
        Maybe (Char, Text)
_ -> String -> Parser Char
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Incorrect length of Char content"

-- This is common for string and char. It seems by the spec @\'@ is incorrect
-- sequence for string, and @\"@ is incorrect sequence for char. I choose to
-- parse both for both for simplicity. Coming from C++ I want to call this
-- "undefined behaviour" in case of incorrect source RON file ;-)
escapedChar :: Parser Char
escapedChar :: Parser Char
escapedChar = Parser Char
anyChar Parser Char -> (Char -> Parser Char) -> Parser Char
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
  Char
'\\' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\\'
  Char
'\"' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\"'
  Char
'\'' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\''
  Char
'b' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\b'
  Char
'f' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\f'
  Char
'n' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\n'
  Char
'r' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\r'
  Char
't' -> Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Char
'\t'
  Char
'u' -> do
      String
digits <- Int -> Parser Char -> Parser ByteString String
forall (m :: * -> *) a. Monad m => Int -> m a -> m [a]
count Int
4 (Parser Char -> Parser ByteString String)
-> Parser Char -> Parser ByteString String
forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Parser Char
satisfy Char -> Bool
hexadecimalDigit
      let code :: Int
code = Integer -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Integer -> Int) -> (String -> Integer) -> String -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Integer -> Bool -> ByteString -> Integer
buildNumber Integer
16 Bool
True (ByteString -> Integer)
-> (String -> ByteString) -> String -> Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> ByteString
ByteString8.pack (String -> Int) -> String -> Int
forall a b. (a -> b) -> a -> b
$ String
digits
      Char -> Parser Char
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Char -> Parser Char) -> Char -> Parser Char
forall a b. (a -> b) -> a -> b
$ Int -> Char
chr Int
code
  Char
_ -> String -> Parser Char
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Invalid escape sequence"

ronString :: Parser Text
ronString :: Parser ByteString Text
ronString = Parser ()
skip1 Parser () -> Parser ByteString Text -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> Text)
-> Parser ByteString Builder -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> Parser ByteString Builder
go Builder
forall a. Monoid a => a
mempty) Parser ByteString Text -> Parser () -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
skip1 Parser ByteString Text -> Parser () -> Parser ByteString Text
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Parser ()
ws
  where
    go :: Builder.Builder -> Parser Builder.Builder
    go :: Builder -> Parser ByteString Builder
go !Builder
builder = do
        ByteString
chunk <- (Char -> Bool) -> Parser ByteString ByteString
takeTill (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\')
        let !r :: Builder
r = Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
chunk
        Parser Char
peekChar' Parser Char
-> (Char -> Parser ByteString Builder) -> Parser ByteString Builder
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Char
'\"' -> Builder -> Parser ByteString Builder
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
r
            Char
'\\' -> do
              Parser ()
skip1
              Char
c <- Parser Char
escapedChar
              Builder -> Parser ByteString Builder
go (Builder -> Parser ByteString Builder)
-> Builder -> Parser ByteString Builder
forall a b. (a -> b) -> a -> b
$ Builder
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.charUtf8 Char
c
            Char
_ -> String -> Parser ByteString Builder
forall a. HasCallStack => String -> a
error String
"takeTill took till wrong character (not \" or \\)"

ronRawString :: Parser Text
ronRawString :: Parser ByteString Text
ronRawString = do
    ByteString
delimeter <- (Char -> Bool) -> Parser ByteString ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#')
    Char -> Parser Char
char Char
'\"'
    let go :: Builder -> Parser ByteString Builder
go !Builder
builder = do
            ByteString
chunk <- (Char -> Bool) -> Parser ByteString ByteString
takeWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\"')
            Parser ()
skip1
            let !r :: Builder
r = Builder
builder Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> ByteString -> Builder
Builder.byteString ByteString
chunk
            (ByteString -> Parser ByteString ByteString
string ByteString
delimeter Parser ByteString ByteString
-> Parser ByteString Builder -> Parser ByteString Builder
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Builder -> Parser ByteString Builder
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Builder
r) Parser ByteString Builder
-> Parser ByteString Builder -> Parser ByteString Builder
forall a.
Parser ByteString a -> Parser ByteString a -> Parser ByteString a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Builder -> Parser ByteString Builder
go (Builder
r Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
Builder.char7 Char
'\"')
    Text
r <- ByteString -> Text
decodeUtf8 (ByteString -> Text) -> (Builder -> ByteString) -> Builder -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
toStrict (ByteString -> ByteString)
-> (Builder -> ByteString) -> Builder -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> ByteString
Builder.toLazyByteString (Builder -> Text)
-> Parser ByteString Builder -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Builder -> Parser ByteString Builder
go Builder
forall a. Monoid a => a
mempty
    Parser ()
ws
    Text -> Parser ByteString Text
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
r


--- List, Map ---


list :: Parser (Vector Value)
list :: Parser ByteString (Vector Value)
list = do
    Parser ()
skip1 -- [
    Parser ()
ws
    [Value]
xs <- Parser Value -> Parser () -> Parser ByteString [Value]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Value
value (Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws)
    () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws
    Char -> Parser Char
char Char
']'
    Parser ()
ws
    Vector Value -> Parser ByteString (Vector Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Value -> Parser ByteString (Vector Value))
-> ([Value] -> Vector Value)
-> [Value]
-> Parser ByteString (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Parser ByteString (Vector Value))
-> [Value] -> Parser ByteString (Vector Value)
forall a b. (a -> b) -> a -> b
$ [Value]
xs

ronMap :: Parser (Map Value Value)
ronMap :: Parser ByteString (Map Value Value)
ronMap = do
    Parser ()
skip1 -- {
    Parser ()
ws
    let pair :: Parser ByteString (Value, Value)
pair = do
            Value
k <- Parser Value
value
            Char -> Parser Char
char Char
':'
            Parser ()
ws
            Value
v <- Parser Value
value
            (Value, Value) -> Parser ByteString (Value, Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value
k, Value
v)
    [(Value, Value)]
xs <- Parser ByteString (Value, Value)
-> Parser () -> Parser ByteString [(Value, Value)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser ByteString (Value, Value)
pair (Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws)
    () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws
    Char -> Parser Char
char Char
'}'
    Parser ()
ws
    Map Value Value -> Parser ByteString (Map Value Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Value Value -> Parser ByteString (Map Value Value))
-> ([(Value, Value)] -> Map Value Value)
-> [(Value, Value)]
-> Parser ByteString (Map Value Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Value, Value)] -> Map Value Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Value, Value)] -> Parser ByteString (Map Value Value))
-> [(Value, Value)] -> Parser ByteString (Map Value Value)
forall a b. (a -> b) -> a -> b
$ [(Value, Value)]
xs


--- Algeraic types


recordOrTuple :: Text -> Parser Value
recordOrTuple :: Text -> Parser Value
recordOrTuple Text
name = Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
ws Parser () -> Parser Char -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
peekChar' Parser Char -> (Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    -- either a value or an identifier (or end)
    -- identifier overlaps with 'record' field
    Char
')' -> Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value
Unit Text
name)
    Char
'r' -> Parser ()
skip1 Parser () -> Parser Char -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
peekChar' Parser Char -> (Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"' -> do
            Value
val <- Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
ronRawString
            Parser ()
ws
            Text -> Vector Value -> Value
Tuple Text
name (Vector Value -> Value)
-> Parser ByteString (Vector Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Parser ByteString (Vector Value)
tupleAndComma [Value
val]
          | Bool
otherwise -> Maybe Char -> Parser Value
common (Char -> Maybe Char
forall a. a -> Maybe a
Just Char
'r')
    Char
c | Char -> Bool
startsIdentifier Char
c -> Maybe Char -> Parser Value
common Maybe Char
forall a. Maybe a
Nothing
        -- not starting an identifier means it's not a 'record' field, so a 'tuple'
      | Bool
otherwise -> Text -> Vector Value -> Value
Tuple Text
name (Vector Value -> Value)
-> Parser ByteString (Vector Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Parser ByteString (Vector Value)
tuple []
  where
    common :: Maybe Char -> Parser Value
common Maybe Char
mbHead = do
        Text
ident <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ByteString -> ByteString)
-> (Char -> ByteString -> ByteString)
-> Maybe Char
-> ByteString
-> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString -> ByteString
forall a. a -> a
id Char -> ByteString -> ByteString
cons Maybe Char
mbHead (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword
        Parser ()
ws
        Parser Char
peekChar' Parser Char -> (Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Char
':' -> Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> do
                Value
v <- Parser Value
value
                Text -> Map Text Value -> Value
Record Text
name (Map Text Value -> Value)
-> Parser ByteString (Map Text Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Value)] -> Parser ByteString (Map Text Value)
recordAndComma [(Text
ident, Value
v)]
            Char
'(' -> do -- a 'tuple' with first element as a 'tuple' or 'record'
                Value
val <- Text -> Parser Value
recordOrTuple Text
ident
                Text -> Vector Value -> Value
Tuple Text
name (Vector Value -> Value)
-> Parser ByteString (Vector Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Parser ByteString (Vector Value)
tupleAndComma [Value
val]
            Char
',' -> Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> Vector Value -> Value
Tuple Text
name (Vector Value -> Value)
-> Parser ByteString (Vector Value) -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Value] -> Parser ByteString (Vector Value)
tuple [Text -> Value
Unit Text
ident])
            Char
')' -> Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Vector Value -> Value
Tuple Text
name ([Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList [Text -> Value
Unit Text
ident]))
            Char
_ -> String -> Parser Value
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting expecting ':', ',' or '('"


tuple, tupleAndComma :: [Value] -> Parser (Vector Value)
tuple :: [Value] -> Parser ByteString (Vector Value)
tuple [Value]
initial = do
    [Value]
xs <- Parser Value -> Parser () -> Parser ByteString [Value]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser Value
value (Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws)
    () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws
    Char -> Parser Char
char Char
')'
    Parser ()
ws
    Vector Value -> Parser ByteString (Vector Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Vector Value -> Parser ByteString (Vector Value))
-> ([Value] -> Vector Value)
-> [Value]
-> Parser ByteString (Vector Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList ([Value] -> Parser ByteString (Vector Value))
-> [Value] -> Parser ByteString (Vector Value)
forall a b. (a -> b) -> a -> b
$ [Value]
initial [Value] -> [Value] -> [Value]
forall a. Semigroup a => a -> a -> a
<> [Value]
xs
tupleAndComma :: [Value] -> Parser ByteString (Vector Value)
tupleAndComma [Value]
initial = Parser Char
anyChar Parser Char
-> (Char -> Parser ByteString (Vector Value))
-> Parser ByteString (Vector Value)
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Char
',' -> Parser ()
ws Parser ()
-> Parser ByteString (Vector Value)
-> Parser ByteString (Vector Value)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [Value] -> Parser ByteString (Vector Value)
tuple [Value]
initial
    Char
')' -> Parser ()
ws Parser ()
-> Parser ByteString (Vector Value)
-> Parser ByteString (Vector Value)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Vector Value -> Parser ByteString (Vector Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Value] -> Vector Value
forall a. [a] -> Vector a
Vector.fromList [Value]
initial)
    Char
_ -> String -> Parser ByteString (Vector Value)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting ',' or ')' in tuple"

record, recordAndComma :: [(Text, Value)] -> Parser (Map Text Value)
record :: [(Text, Value)] -> Parser ByteString (Map Text Value)
record [(Text, Value)]
initial = do
    let pair :: Parser ByteString (Text, Value)
pair = do
            ByteString
k <- (Char -> ByteString -> ByteString)
-> Parser Char
-> Parser ByteString ByteString
-> Parser ByteString ByteString
forall a b c.
(a -> b -> c)
-> Parser ByteString a
-> Parser ByteString b
-> Parser ByteString c
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> ByteString -> ByteString
cons ((Char -> Bool) -> Parser Char
satisfy Char -> Bool
startsIdentifier) ((Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword)
            Parser ()
ws
            Char -> Parser Char
char Char
':'
            Parser ()
ws
            Value
v <- Parser Value
value
            (Text, Value) -> Parser ByteString (Text, Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteString -> Text
decodeUtf8 ByteString
k, Value
v)
    [(Text, Value)]
xs <- Parser ByteString (Text, Value)
-> Parser () -> Parser ByteString [(Text, Value)]
forall (f :: * -> *) a s. Alternative f => f a -> f s -> f [a]
sepBy Parser ByteString (Text, Value)
pair (Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws)
    () -> Parser () -> Parser ()
forall (f :: * -> *) a. Alternative f => a -> f a -> f a
option () (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Char -> Parser Char
char Char
',' Parser Char -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser ()
ws
    Char -> Parser Char
char Char
')'
    Parser ()
ws
    Map Text Value -> Parser ByteString (Map Text Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Value -> Parser ByteString (Map Text Value))
-> ([(Text, Value)] -> Map Text Value)
-> [(Text, Value)]
-> Parser ByteString (Map Text Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList ([(Text, Value)] -> Parser ByteString (Map Text Value))
-> [(Text, Value)] -> Parser ByteString (Map Text Value)
forall a b. (a -> b) -> a -> b
$ [(Text, Value)]
initial [(Text, Value)] -> [(Text, Value)] -> [(Text, Value)]
forall a. Semigroup a => a -> a -> a
<> [(Text, Value)]
xs
recordAndComma :: [(Text, Value)] -> Parser ByteString (Map Text Value)
recordAndComma [(Text, Value)]
initial = Parser Char
anyChar Parser Char
-> (Char -> Parser ByteString (Map Text Value))
-> Parser ByteString (Map Text Value)
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Char
',' -> Parser ()
ws Parser ()
-> Parser ByteString (Map Text Value)
-> Parser ByteString (Map Text Value)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> [(Text, Value)] -> Parser ByteString (Map Text Value)
record [(Text, Value)]
initial
    Char
')' -> Parser ()
ws Parser ()
-> Parser ByteString (Map Text Value)
-> Parser ByteString (Map Text Value)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Map Text Value -> Parser ByteString (Map Text Value)
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([(Text, Value)] -> Map Text Value
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList [(Text, Value)]
initial)
    Char
_ -> String -> Parser ByteString (Map Text Value)
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Expecting ',' or ')' in record"

-- | Algebraic struct (named unit, 'record', 'tuple') or a raw string
identifierLike :: Char -> Parser Value
identifierLike :: Char -> Parser Value
identifierLike Char
'r' = Parser ()
skip1 Parser () -> Parser (Maybe Char) -> Parser (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Char
Nothing -> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Value -> Parser Value) -> Value -> Parser Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
Unit Text
"r"
    Just Char
'#' -> Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
ronRawString
    Just Char
'\"' -> Text -> Value
String (Text -> Value) -> Parser ByteString Text -> Parser Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser ByteString Text
ronRawString
    Maybe Char
_ -> do
        Text
name <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> (ByteString -> ByteString) -> ByteString -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> ByteString -> ByteString
cons Char
'r' (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword
        Parser ()
ws
        Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Just Char
'(' -> Text -> Parser Value
recordOrTuple Text
name
            Maybe Char
_ -> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value
Unit Text
name)
identifierLike Char
_ = do
    Text
name <- ByteString -> Text
decodeUtf8 (ByteString -> Text)
-> Parser ByteString ByteString -> Parser ByteString Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Char -> Bool) -> Parser ByteString ByteString
takeWhile Char -> Bool
isKeyword
    Parser ()
ws
    Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser Value) -> Parser Value
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just Char
'(' -> Text -> Parser Value
recordOrTuple Text
name
        Maybe Char
_ -> Parser ()
ws Parser () -> Parser Value -> Parser Value
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Value -> Parser Value
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text -> Value
Unit Text
name)


--- Common ---

-- | Whitespace and comment skipper
ws :: Parser ()
ws :: Parser ()
ws = (Char -> Bool) -> Parser ()
skipWhile Char -> Bool
isSpace Parser () -> Parser (Maybe Char) -> Parser (Maybe Char)
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser (Maybe Char)
peekChar Parser (Maybe Char) -> (Maybe Char -> Parser ()) -> Parser ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Char
Nothing -> () -> Parser ()
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
    Just Char
c | Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'/' -> Parser ()
skip1 Parser () -> Parser Char -> Parser Char
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser Char
anyChar Parser Char -> (Char -> Parser ()) -> Parser ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Char
'/' -> (Char -> Bool) -> Parser ()
skipWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n') Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser () -> Parser ()
forall {t}. Chunk t => Parser t () -> Parser t ()
endOr Parser ()
skip1 Parser () -> Parser () -> Parser ()
forall a b.
Parser ByteString a -> Parser ByteString b -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Parser ()
ws
        Char
'*' -> Int -> Parser ()
forall {a}. (Eq a, Num a) => a -> Parser ()
goMultiline (Int
1 :: Int)
        Char
_ -> String -> Parser ()
forall a. String -> Parser ByteString a
forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"Unexpected '/', not followed by a comment starting"
    Maybe Char
_ -> () -> Parser ()
forall a. a -> Parser ByteString a
forall (f :: * -> *) a. Applicative f => a -> f a
pure () -- not a comment
  where
    goMultiline :: a -> Parser ()
goMultiline a
0 = Parser ()
ws -- end of multiline comment, try taking some new whitespace
    goMultiline a
level = do
        (Char -> Bool) -> Parser ()
skipWhile (\Char
c -> Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'*' Bool -> Bool -> Bool
&& Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'/')
        Parser () -> Parser ()
forall {t}. Chunk t => Parser t () -> Parser t ()
endOr (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Char
anyChar Parser Char -> (Char -> Parser ()) -> Parser ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
            Char
'*' -> Parser () -> Parser ()
forall {t}. Chunk t => Parser t () -> Parser t ()
endOr (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Char
anyChar Parser Char -> (Char -> Parser ()) -> Parser ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Char
'/' -> a -> Parser ()
goMultiline (a -> Parser ()) -> a -> Parser ()
forall a b. (a -> b) -> a -> b
$! a
level a -> a -> a
forall a. Num a => a -> a -> a
- a
1
                Char
_ -> a -> Parser ()
goMultiline a
level
            Char
'/' -> Parser () -> Parser ()
forall {t}. Chunk t => Parser t () -> Parser t ()
endOr (Parser () -> Parser ()) -> Parser () -> Parser ()
forall a b. (a -> b) -> a -> b
$ Parser Char
anyChar Parser Char -> (Char -> Parser ()) -> Parser ()
forall a b.
Parser ByteString a
-> (a -> Parser ByteString b) -> Parser ByteString b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
                Char
'*' -> a -> Parser ()
goMultiline (a -> Parser ()) -> a -> Parser ()
forall a b. (a -> b) -> a -> b
$! a
level a -> a -> a
forall a. Num a => a -> a -> a
+ a
1
                Char
_ -> a -> Parser ()
goMultiline a
level
            Char
_ -> String -> Parser ()
forall a. HasCallStack => String -> a
error String
"skipWhile skipped until unexpected character"

isSpace :: Char -> Bool
isSpace Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t'
isKeyword :: Char -> Bool
isKeyword Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''
startsNumber :: Char -> Bool
startsNumber Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'+' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'.' Bool -> Bool -> Bool
|| Char -> Bool
decimalDigit Char
c
startsString :: Char -> Bool
startsString Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\"'
startsList :: Char -> Bool
startsList Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'['
startsMap :: Char -> Bool
startsMap Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'{'
startsStruct :: Char -> Bool
startsStruct Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'('
startsIdentifier :: Char -> Bool
startsIdentifier Char
c = Char -> Bool
isAlpha Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'_' -- this can also be a raw string
startsChar :: Char -> Bool
startsChar Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\''

binaryDigit :: Char -> Bool
binaryDigit Char
c = Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'0' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'1'
octalDigit :: Char -> Bool
octalDigit Char
c = Char -> Bool
binaryDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'2' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'3' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'4'
                             Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'5' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'6' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'7'
decimalDigit :: Char -> Bool
decimalDigit Char
c = Char -> Bool
octalDigit Char
c Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'8' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'9'
hexadecimalDigit :: Char -> Bool
hexadecimalDigit Char
c = Char -> Bool
decimalDigit Char
c
                  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'a' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'b' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'c' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'd' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'e' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'f'
                  Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'A' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'B' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'C' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'D' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'E' Bool -> Bool -> Bool
|| Char
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'F'

skip1 :: Parser ()
skip1 = (Word8 -> Bool) -> Parser ()
skip (Bool -> Word8 -> Bool
forall a b. a -> b -> a
const Bool
True)
endOr :: Parser t () -> Parser t ()
endOr Parser t ()
parser = Parser t Bool
forall t. Chunk t => Parser t Bool
atEnd Parser t Bool -> (Bool -> Parser t ()) -> Parser t ()
forall a b. Parser t a -> (a -> Parser t b) -> Parser t b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case {Bool
True -> () -> Parser t ()
forall a. a -> Parser t a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (); Bool
False -> Parser t ()
parser}


--- Exceptions


-- | Error parsing 'ByteString' to 'Value'
newtype ParseError = ParseError String
    deriving (Int -> ParseError -> String -> String
[ParseError] -> String -> String
ParseError -> String
(Int -> ParseError -> String -> String)
-> (ParseError -> String)
-> ([ParseError] -> String -> String)
-> Show ParseError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> ParseError -> String -> String
showsPrec :: Int -> ParseError -> String -> String
$cshow :: ParseError -> String
show :: ParseError -> String
$cshowList :: [ParseError] -> String -> String
showList :: [ParseError] -> String -> String
Show, Typeable)

-- | Error parsing 'Value' to custom type
newtype DecodeError = DecodeError String
    deriving (Int -> DecodeError -> String -> String
[DecodeError] -> String -> String
DecodeError -> String
(Int -> DecodeError -> String -> String)
-> (DecodeError -> String)
-> ([DecodeError] -> String -> String)
-> Show DecodeError
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
$cshowsPrec :: Int -> DecodeError -> String -> String
showsPrec :: Int -> DecodeError -> String -> String
$cshow :: DecodeError -> String
show :: DecodeError -> String
$cshowList :: [DecodeError] -> String -> String
showList :: [DecodeError] -> String -> String
Show, Typeable)

instance Exception ParseError
instance Exception DecodeError