{-# LANGUAGE RecordWildCards #-}

-- | Definitions for serializing values into bytes. When serializing, you must
-- choose a formatting option defined at 'SerializeSettings'
module Data.Ron.Serialize
    ( encode, encodeFile
    , dumps, dumpFile
    -- * Style options
    , SerializeSettings (..)
    , haskellStyle, rustStyle, compactStyle
    , CommaStyle (..)
    -- * Low-level builders
    , ronBuilder
    ) where

import Data.ByteString.Builder (Builder, toLazyByteString, byteString, integerDec, char7, string7, hPutBuilder)
import Data.ByteString.Builder.Prim (primBounded, condB, (>$<), (>*<), liftFixedToBounded, word16HexFixed)
import Data.ByteString.Builder.Scientific (scientificBuilder)
import Data.Char (ord)
import Data.List (intersperse)
import Data.Text (Text)
import Data.Text.Encoding (encodeUtf8, encodeUtf8BuilderEscaped)
import Data.Ron.Class (ToRon (toRon))
import Data.Word (Word8)
import Test.QuickCheck (Arbitrary, arbitrary, chooseEnum)
import System.IO (IOMode (WriteMode), hSetBinaryMode, hSetBuffering, BufferMode (BlockBuffering), withFile)

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

import Data.Ron.Value


-- | Style of comma in compound values
data CommaStyle
    = CommaHistoric
    -- ^ Like in json, comma after value without trailing
    | CommaTrailing
    -- ^ Comma after value, including last element
    | CommaLeading
    -- ^ Haskell style, comma at line start
    deriving (CommaStyle -> CommaStyle -> Bool
(CommaStyle -> CommaStyle -> Bool)
-> (CommaStyle -> CommaStyle -> Bool) -> Eq CommaStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CommaStyle -> CommaStyle -> Bool
== :: CommaStyle -> CommaStyle -> Bool
$c/= :: CommaStyle -> CommaStyle -> Bool
/= :: CommaStyle -> CommaStyle -> Bool
Eq, Int -> CommaStyle -> ShowS
[CommaStyle] -> ShowS
CommaStyle -> String
(Int -> CommaStyle -> ShowS)
-> (CommaStyle -> String)
-> ([CommaStyle] -> ShowS)
-> Show CommaStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CommaStyle -> ShowS
showsPrec :: Int -> CommaStyle -> ShowS
$cshow :: CommaStyle -> String
show :: CommaStyle -> String
$cshowList :: [CommaStyle] -> ShowS
showList :: [CommaStyle] -> ShowS
Show, CommaStyle
CommaStyle -> CommaStyle -> Bounded CommaStyle
forall a. a -> a -> Bounded a
$cminBound :: CommaStyle
minBound :: CommaStyle
$cmaxBound :: CommaStyle
maxBound :: CommaStyle
Bounded, Int -> CommaStyle
CommaStyle -> Int
CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle
CommaStyle -> CommaStyle -> [CommaStyle]
CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
(CommaStyle -> CommaStyle)
-> (CommaStyle -> CommaStyle)
-> (Int -> CommaStyle)
-> (CommaStyle -> Int)
-> (CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> [CommaStyle])
-> (CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle])
-> Enum CommaStyle
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
$csucc :: CommaStyle -> CommaStyle
succ :: CommaStyle -> CommaStyle
$cpred :: CommaStyle -> CommaStyle
pred :: CommaStyle -> CommaStyle
$ctoEnum :: Int -> CommaStyle
toEnum :: Int -> CommaStyle
$cfromEnum :: CommaStyle -> Int
fromEnum :: CommaStyle -> Int
$cenumFrom :: CommaStyle -> [CommaStyle]
enumFrom :: CommaStyle -> [CommaStyle]
$cenumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThen :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
enumFromTo :: CommaStyle -> CommaStyle -> [CommaStyle]
$cenumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
enumFromThenTo :: CommaStyle -> CommaStyle -> CommaStyle -> [CommaStyle]
Enum)

data SerializeSettings = SerializeSettings
    { SerializeSettings -> CommaStyle
commaStyle :: !CommaStyle
    -- ^ How to separate values in compounds (tuples, records, maps, lists)
    , SerializeSettings -> Int
indent :: !Int
    -- ^ Amount of spaces to indent with. Setting this to zero also disables
    -- line breaks
    , SerializeSettings -> Bool
singleElementSpecial :: !Bool
    -- ^ When a compound type only contains one element, this compound value is
    -- printed on one line
    , SerializeSettings -> Bool
unpackToplevel :: !Bool
    -- ^ Toplevel record and list are unpacked to not include the constructor
    -- and brackets. This is useful for human-consumed files, and looks similar
    -- to yaml but with commas. Warning: ron-rs doesn't support reading this
    , SerializeSettings -> Bool
openBracketOnSameLine :: !Bool
    -- ^ For compound types, does the opening bracket go on a new line or stays
    -- on the same line as the constructor
    , SerializeSettings -> Bool
closeBracketOnSameLine :: !Bool
    -- ^ For compound types, does the closing bracket go on a new line or stays
    -- on the same line as the last element. Setting this to True is a popular
    -- default in some haskell autoformat programs
    , SerializeSettings -> Bool
spaceAfterColon :: !Bool
    -- ^ Should a space character be put after colon in records and maps.
    -- Useful as @False@ for compact representation
    } deriving (SerializeSettings -> SerializeSettings -> Bool
(SerializeSettings -> SerializeSettings -> Bool)
-> (SerializeSettings -> SerializeSettings -> Bool)
-> Eq SerializeSettings
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: SerializeSettings -> SerializeSettings -> Bool
== :: SerializeSettings -> SerializeSettings -> Bool
$c/= :: SerializeSettings -> SerializeSettings -> Bool
/= :: SerializeSettings -> SerializeSettings -> Bool
Eq, Int -> SerializeSettings -> ShowS
[SerializeSettings] -> ShowS
SerializeSettings -> String
(Int -> SerializeSettings -> ShowS)
-> (SerializeSettings -> String)
-> ([SerializeSettings] -> ShowS)
-> Show SerializeSettings
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SerializeSettings -> ShowS
showsPrec :: Int -> SerializeSettings -> ShowS
$cshow :: SerializeSettings -> String
show :: SerializeSettings -> String
$cshowList :: [SerializeSettings] -> ShowS
showList :: [SerializeSettings] -> ShowS
Show)

-- | Style similar to what is produced in haskell with stylish-haskell or
-- hindent.
--
--      * Uses indent size of 4
--
--      * Unpacks top level values
haskellStyle :: SerializeSettings
haskellStyle :: SerializeSettings
haskellStyle = SerializeSettings
    { commaStyle :: CommaStyle
commaStyle = CommaStyle
CommaLeading
    , indent :: Int
indent = Int
4
    , singleElementSpecial :: Bool
singleElementSpecial = Bool
True
    , unpackToplevel :: Bool
unpackToplevel = Bool
True
    , openBracketOnSameLine :: Bool
openBracketOnSameLine = Bool
False
    , closeBracketOnSameLine :: Bool
closeBracketOnSameLine = Bool
False
    , spaceAfterColon :: Bool
spaceAfterColon = Bool
True
    }

-- | Style similar to what is produced by rustfmt, or by ron-rs itself
rustStyle :: SerializeSettings
rustStyle :: SerializeSettings
rustStyle = SerializeSettings
    { commaStyle :: CommaStyle
commaStyle = CommaStyle
CommaTrailing
    , indent :: Int
indent = Int
4
    , singleElementSpecial :: Bool
singleElementSpecial = Bool
True
    , unpackToplevel :: Bool
unpackToplevel = Bool
False
    , openBracketOnSameLine :: Bool
openBracketOnSameLine = Bool
True
    , closeBracketOnSameLine :: Bool
closeBracketOnSameLine = Bool
False
    , spaceAfterColon :: Bool
spaceAfterColon = Bool
True
    }

-- | All whitespace is disabled. Does not unpack toplevel for compatability, so
-- you can set that if you want an even compacter style that can't be read by
-- ron-rs
compactStyle :: SerializeSettings
compactStyle :: SerializeSettings
compactStyle = SerializeSettings
    { commaStyle :: CommaStyle
commaStyle = CommaStyle
CommaHistoric
    , indent :: Int
indent = Int
0
    , singleElementSpecial :: Bool
singleElementSpecial = Bool
True
    , unpackToplevel :: Bool
unpackToplevel = Bool
False
    , openBracketOnSameLine :: Bool
openBracketOnSameLine = Bool
True
    , closeBracketOnSameLine :: Bool
closeBracketOnSameLine = Bool
True
    , spaceAfterColon :: Bool
spaceAfterColon = Bool
False
    }

-- | Serialize a value to a lazy bytestring. For settings you can use
-- 'haskellStyle' or 'rustStyle' or 'compactStyle'
encode :: ToRon a => SerializeSettings -> a -> Lazy.ByteString
encode :: forall a. ToRon a => SerializeSettings -> a -> ByteString
encode SerializeSettings
settings = SerializeSettings -> Value -> ByteString
dumps SerializeSettings
settings (Value -> ByteString) -> (a -> Value) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToRon a => a -> Value
toRon

-- | Serialize a value into a file. For settings you can use
-- 'haskellStyle' or 'rustStyle' or 'compactStyle'
encodeFile :: ToRon a => SerializeSettings -> FilePath -> a -> IO ()
encodeFile :: forall a. ToRon a => SerializeSettings -> String -> a -> IO ()
encodeFile SerializeSettings
settings String
path = SerializeSettings -> String -> Value -> IO ()
dumpFile SerializeSettings
settings String
path (Value -> IO ()) -> (a -> Value) -> a -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToRon a => a -> Value
toRon

-- | Serialize a RON value to a lazy bytestring. You probably want to use
-- 'encode' instead
dumps :: SerializeSettings -> Value -> Lazy.ByteString
dumps :: SerializeSettings -> Value -> ByteString
dumps SerializeSettings
settings = Builder -> ByteString
toLazyByteString (Builder -> ByteString)
-> (Value -> Builder) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. SerializeSettings -> Value -> Builder
ronBuilder SerializeSettings
settings

-- | Serialize a RON value into a file. You probably want to use 'encodeFile'
-- instead
dumpFile :: SerializeSettings -> FilePath -> Value -> IO ()
dumpFile :: SerializeSettings -> String -> Value -> IO ()
dumpFile SerializeSettings
settings String
path Value
value = String -> IOMode -> (Handle -> IO ()) -> IO ()
forall r. String -> IOMode -> (Handle -> IO r) -> IO r
withFile String
path IOMode
WriteMode ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
handle -> do
    -- recommended in builder package
    Handle -> Bool -> IO ()
hSetBinaryMode Handle
handle Bool
True
    Handle -> BufferMode -> IO ()
hSetBuffering Handle
handle (BufferMode -> IO ()) -> BufferMode -> IO ()
forall a b. (a -> b) -> a -> b
$ Maybe Int -> BufferMode
BlockBuffering Maybe Int
forall a. Maybe a
Nothing -- hmm
    Handle -> Builder -> IO ()
hPutBuilder Handle
handle (Builder -> IO ()) -> Builder -> IO ()
forall a b. (a -> b) -> a -> b
$ SerializeSettings -> Value -> Builder
ronBuilder SerializeSettings
settings Value
value

-- | The builder producing the serialized representation. You can use this to
-- write ron to outputs not supported by this library, like pipes or conduits
ronBuilder :: SerializeSettings -> Value -> Builder
ronBuilder :: SerializeSettings -> Value -> Builder
ronBuilder SerializeSettings {Bool
Int
CommaStyle
commaStyle :: SerializeSettings -> CommaStyle
indent :: SerializeSettings -> Int
singleElementSpecial :: SerializeSettings -> Bool
unpackToplevel :: SerializeSettings -> Bool
openBracketOnSameLine :: SerializeSettings -> Bool
closeBracketOnSameLine :: SerializeSettings -> Bool
spaceAfterColon :: SerializeSettings -> Bool
commaStyle :: CommaStyle
indent :: Int
singleElementSpecial :: Bool
unpackToplevel :: Bool
openBracketOnSameLine :: Bool
closeBracketOnSameLine :: Bool
spaceAfterColon :: Bool
..} = Value -> Builder
toplevel where
    deeper :: Int -> Int
deeper !Int
lvl = Int
lvl Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
indent
    nl :: Builder
nl  = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 then Builder
forall a. Monoid a => a
mempty else Char -> Builder
char7 Char
'\n'
    shift :: Int -> Builder
shift Int
lvl = String -> Builder
string7 (String -> Builder) -> String -> Builder
forall a b. (a -> b) -> a -> b
$ Int -> Char -> String
forall a. Int -> a -> [a]
replicate Int
lvl Char
' '
    bracketOpen :: Bool -> Int -> Char -> Builder
bracketOpen Bool
afterColon Int
lvl Char
c
        | Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Char -> Builder
char7 Char
c
        | Bool
openBracketOnSameLine  = Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift (Int -> Int
deeper Int
lvl)
            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
CommaLeading
                then Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' '
                else Builder
forall a. Monoid a => a
mempty
        | CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
CommaLeading  =
            Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift (Int -> Int
deeper Int
lvl) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' '
        | Bool
otherwise  = Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift Int
lvl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
c Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift (Int -> Int
deeper Int
lvl)
            where spc :: Builder
spc = if Bool
afterColon Bool -> Bool -> Bool
&& Bool
spaceAfterColon then Char -> Builder
char7 Char
' ' else Builder
forall a. Monoid a => a
mempty
    bracketClose :: Int -> Char -> Builder
bracketClose Int
lvl Char
c
        | Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0  = Char -> Builder
char7 Char
c
        | Bool
closeBracketOnSameLine  = Char -> Builder
char7 Char
' ' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
c
        | CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
CommaLeading  = Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift (Int -> Int
deeper Int
lvl) Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
c
        | Bool
otherwise  = Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift Int
lvl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
c
    comma :: Int -> Builder
comma Int
lvl = if CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
CommaLeading
        then Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift Int
lvl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
", "
        else Char -> Builder
char7 Char
',' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nl Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
shift Int
lvl
    trailingComma :: Builder
trailingComma = if CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
CommaTrailing
        then Char -> Builder
char7 Char
','
        else Builder
forall a. Monoid a => a
mempty
    toplevel :: Value -> Builder
toplevel = if Bool
unpackToplevel
        then \case
            -- Those two looks bad with leading comma, not sure what to do.
            -- Don't want to turn them into trailing/historic comma for
            -- toplevel only, since I personally always forget to put it after
            -- the previous element
            List Vector Value
xs | Bool -> Bool
not (Vector Value -> Bool
forall a. Vector a -> Bool
Vector.null Vector Value
xs) -> Int -> Vector Value -> Builder
listContent Int
0 Vector Value
xs
            Record Text
name Map Text Value
xs | Text -> Bool
Text.null Text
name -> Int -> Map Text Value -> Builder
recordContent Int
0 Map Text Value
xs
            Value
v -> Int -> Value -> Builder
go Int
startIndent Value
v
        else Int -> Value -> Builder
go Int
startIndent
        -- special handling for haskell-style: don't indent the topmost block
        where startIndent :: Int
startIndent = if CommaStyle
commaStyle CommaStyle -> CommaStyle -> Bool
forall a. Eq a => a -> a -> Bool
== CommaStyle
CommaLeading
                then Int -> Int
forall a. Num a => a -> a
negate Int
indent
                else Int
0
    --
    go :: Int -> Value -> Builder
go = Bool -> Int -> Value -> Builder
go' Bool
False
    go' :: Bool -> Int -> Value -> Builder
go' !Bool
afterColon !Int
lvl = \case
        Integral Integer
x -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Integer -> Builder
integerDec Integer
x
        Floating Scientific
x -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Scientific -> Builder
scientificBuilder Scientific
x
        Char Char
x -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\'' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
encodeChar Char
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'\''
        String Text
x -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
encodeString Text
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
'"'
        Unit Text
name -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> if Text -> Bool
Text.null Text
name
            then String -> Builder
string7 String
"()"
            else Text -> Builder
fromText Text
name
        List Vector Value
xs
            | Vector Value -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector Value
xs -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
"[]"
            | Bool
singleElementSpecial Bool -> Bool -> Bool
&& Value -> Bool
isSimple (Vector Value -> Value
List Vector Value
xs)
                -> let !x :: Value
x = Vector Value -> Value
forall a. Vector a -> a
Vector.unsafeHead Vector Value
xs
                       open :: Builder
open = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
"[ " else Char -> Builder
char7 Char
'['
                       close :: Builder
close = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
" ]" else Char -> Builder
char7 Char
']'
                   in Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Builder
go Int
lvl Value
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close
            | Bool
otherwise -> Bool -> Int -> Char -> Builder
bracketOpen Bool
afterColon Int
lvl Char
'[' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Vector Value -> Builder
listContent (Int -> Int
deeper Int
lvl) Vector Value
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
bracketClose Int
lvl Char
']'
        Map Map Value Value
xs
            | Map Value Value -> Bool
forall a. Map Value a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Value Value
xs -> Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> String -> Builder
string7 String
"{}"
            | Bool
singleElementSpecial Bool -> Bool -> Bool
&& Value -> Bool
isSimple (Map Value Value -> Value
Map Map Value Value
xs)
                -> let (!Value
k, !Value
v) = [(Value, Value)] -> (Value, Value)
forall a. HasCallStack => [a] -> a
head ([(Value, Value)] -> (Value, Value))
-> (Map Value Value -> [(Value, Value)])
-> Map Value Value
-> (Value, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Value Value -> [(Value, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Value Value -> (Value, Value))
-> Map Value Value -> (Value, Value)
forall a b. (a -> b) -> a -> b
$ Map Value Value
xs
                       open :: Builder
open = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
"{ " else Char -> Builder
char7 Char
'{'
                       close :: Builder
close = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
" }" else Char -> Builder
char7 Char
'}'
                   in Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Builder
go Int
lvl Value
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Int -> Value -> Builder
go' Bool
True Int
lvl Value
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close
            | Bool
otherwise -> Bool -> Int -> Char -> Builder
bracketOpen Bool
afterColon Int
lvl Char
'{' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Map Value Value -> Builder
mapContent (Int -> Int
deeper Int
lvl) Map Value Value
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
bracketClose Int
lvl Char
'}'
        Tuple Text
name Vector Value
xs
            | Bool
singleElementSpecial Bool -> Bool -> Bool
&& Value -> Bool
isSimple (Text -> Vector Value -> Value
Tuple Text
name Vector Value
xs) ->
                let !x :: Value
x = Vector Value -> Value
forall a. Vector a -> a
Vector.unsafeHead Vector Value
xs
                    nameB :: Builder
nameB = if Text -> Bool
Text.null Text
name
                        then Builder
forall a. Monoid a => a
mempty
                        else Text -> Builder
fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' '
                    open :: Builder
open = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
"( " else Char -> Builder
char7 Char
'('
                    close :: Builder
close = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
" )" else Char -> Builder
char7 Char
')'
                in Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nameB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Builder
go Int
lvl Value
x Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close
            | Text -> Bool
Text.null Text
name ->
                Bool -> Int -> Char -> Builder
bracketOpen Bool
afterColon Int
lvl Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Vector Value -> Builder
listContent (Int -> Int
deeper Int
lvl) Vector Value
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
bracketClose Int
lvl Char
')'
            | Bool
otherwise ->
                Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Int -> Char -> Builder
bracketOpen Bool
True Int
lvl Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Vector Value -> Builder
listContent (Int -> Int
deeper Int
lvl) Vector Value
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
bracketClose Int
lvl Char
')'
        Record Text
name Map Text Value
xs
            | Bool
singleElementSpecial Bool -> Bool -> Bool
&& Value -> Bool
isSimple (Text -> Map Text Value -> Value
Record Text
name Map Text Value
xs) ->
                let (!Text
k, !Value
v) = [(Text, Value)] -> (Text, Value)
forall a. HasCallStack => [a] -> a
head ([(Text, Value)] -> (Text, Value))
-> (Map Text Value -> [(Text, Value)])
-> Map Text Value
-> (Text, Value)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList (Map Text Value -> (Text, Value))
-> Map Text Value -> (Text, Value)
forall a b. (a -> b) -> a -> b
$ Map Text Value
xs
                    nameB :: Builder
nameB = if Text -> Bool
Text.null Text
name
                        then Builder
forall a. Monoid a => a
mempty
                        else Text -> Builder
fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
' '
                    open :: Builder
open = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
"( " else Char -> Builder
char7 Char
'('
                    close :: Builder
close = if Int
indent Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then String -> Builder
string7 String
" )" else Char -> Builder
char7 Char
')'
                in Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
nameB Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
open Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Int -> Value -> Builder
go' Bool
True Int
lvl Value
v Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
close
            | Text -> Bool
Text.null Text
name ->
                Bool -> Int -> Char -> Builder
bracketOpen Bool
afterColon Int
lvl Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Map Text Value -> Builder
recordContent (Int -> Int
deeper Int
lvl) Map Text Value
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
bracketClose Int
lvl Char
')'
            | Bool
otherwise ->
                Builder
spc Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Text -> Builder
fromText Text
name Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Int -> Char -> Builder
bracketOpen Bool
True Int
lvl Char
'(' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Map Text Value -> Builder
recordContent (Int -> Int
deeper Int
lvl) Map Text Value
xs Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> Builder
bracketClose Int
lvl Char
')'
        where
            spc :: Builder
spc = if Bool
afterColon Bool -> Bool -> Bool
&& Bool
spaceAfterColon then Char -> Builder
char7 Char
' ' else Builder
forall a. Monoid a => a
mempty
    --
    listContent :: Int -> Vector Value -> Builder
listContent Int
lvl = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
trailingComma) (Builder -> Builder)
-> (Vector Value -> Builder) -> Vector Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Vector Value -> [Builder]) -> Vector Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Int -> Builder
comma Int
lvl) ([Builder] -> [Builder])
-> (Vector Value -> [Builder]) -> Vector Value -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Value -> Builder) -> [Value] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Value -> Builder
go Int
lvl) ([Value] -> [Builder])
-> (Vector Value -> [Value]) -> Vector Value -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList
    --
    mapContent :: Int -> Map Value Value -> Builder
mapContent Int
lvl = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
trailingComma) (Builder -> Builder)
-> (Map Value Value -> Builder) -> Map Value Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Map Value Value -> [Builder]) -> Map Value Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Int -> Builder
comma Int
lvl) ([Builder] -> [Builder])
-> (Map Value Value -> [Builder]) -> Map Value Value -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Value, Value) -> Builder) -> [(Value, Value)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Value, Value) -> Builder
toElem ([(Value, Value)] -> [Builder])
-> (Map Value Value -> [(Value, Value)])
-> Map Value Value
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Value Value -> [(Value, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList where
        toElem :: (Value, Value) -> Builder
toElem (Value
k, Value
v) = Int -> Value -> Builder
go Int
lvl Value
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Int -> Value -> Builder
go' Bool
True Int
lvl Value
v
    --
    recordContent :: Int -> Map Text Value -> Builder
recordContent Int
lvl = (Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
trailingComma) (Builder -> Builder)
-> (Map Text Value -> Builder) -> Map Text Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Builder] -> Builder
forall a. Monoid a => [a] -> a
mconcat ([Builder] -> Builder)
-> (Map Text Value -> [Builder]) -> Map Text Value -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> [Builder] -> [Builder]
forall a. a -> [a] -> [a]
intersperse (Int -> Builder
comma Int
lvl) ([Builder] -> [Builder])
-> (Map Text Value -> [Builder]) -> Map Text Value -> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text, Value) -> Builder) -> [(Text, Value)] -> [Builder]
forall a b. (a -> b) -> [a] -> [b]
map (Text, Value) -> Builder
toElem ([(Text, Value)] -> [Builder])
-> (Map Text Value -> [(Text, Value)])
-> Map Text Value
-> [Builder]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList where
        toElem :: (Text, Value) -> Builder
toElem (Text
k, Value
v) = Text -> Builder
fromText Text
k Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Char -> Builder
char7 Char
':' Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Bool -> Int -> Value -> Builder
go' Bool
True Int
lvl Value
v

-- | Can the value be nicely rendered on a single line? True for non-compounds and single-value compounds
isSimple :: Value -> Bool
isSimple :: Value -> Bool
isSimple (Integral Integer
_) = Bool
True
isSimple (Floating Scientific
_) = Bool
True
isSimple (Char Char
_) = Bool
True
isSimple (String Text
_) = Bool
True
isSimple (Unit Text
_) = Bool
True
isSimple (List Vector Value
elems) = case Vector Value -> Maybe (Value, Vector Value)
forall a. Vector a -> Maybe (a, Vector a)
Vector.uncons Vector Value
elems of
    Maybe (Value, Vector Value)
Nothing -> Bool
True
    Just (Value
x, Vector Value
xs)
        | Vector Value -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector Value
xs   -> Value -> Bool
isSimple Value
x
        | Bool
otherwise -> Bool
False
isSimple (Map Map Value Value
xs)
    | Map Value Value -> Bool
forall a. Map Value a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Value Value
xs = Bool
True
    | Map Value Value -> Int
forall a. Map Value a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map Value Value
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = case Map Value Value -> [(Value, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Value Value
xs of
        [(Value
k, Value
v)] -> Value -> Bool
isSimple Value
k Bool -> Bool -> Bool
&& Value -> Bool
isSimple Value
v
        [(Value, Value)]
_ -> Bool
False
    | Bool
otherwise = Bool
False
isSimple (Tuple Text
_ Vector Value
elems) = case Vector Value -> Maybe (Value, Vector Value)
forall a. Vector a -> Maybe (a, Vector a)
Vector.uncons Vector Value
elems of
    Maybe (Value, Vector Value)
Nothing -> Bool
True
    Just (Value
x, Vector Value
xs)
        | Vector Value -> Bool
forall a. Vector a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Vector Value
xs   -> Value -> Bool
isSimple Value
x
        | Bool
otherwise -> Bool
False
isSimple (Record Text
_ Map Text Value
xs)
    | Map Text Value -> Bool
forall a. Map Text a -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Value
xs = Bool
True
    | Map Text Value -> Int
forall a. Map Text a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length Map Text Value
xs Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
1 = case Map Text Value -> [(Text, Value)]
forall k a. Map k a -> [(k, a)]
Map.toList Map Text Value
xs of
        [(Text
_, Value
v)] -> Value -> Bool
isSimple Value
v
        [(Text, Value)]
_ -> Bool
False
    | Bool
otherwise = Bool
False

fromText :: Text -> Builder
fromText :: Text -> Builder
fromText = ByteString -> Builder
byteString (ByteString -> Builder) -> (Text -> ByteString) -> Text -> Builder
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
encodeUtf8

encodeString :: Text -> Builder
encodeString :: Text -> Builder
encodeString = BoundedPrim Word8 -> Text -> Builder
encodeUtf8BuilderEscaped BoundedPrim Word8
escape
    where
        escape :: BoundedPrim Word8
escape
            = (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\\' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'\\'))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\b' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'b' ))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\f' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'f' ))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\n' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'n' ))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\r' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'r' ))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\t' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
't' ))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Char -> Word8
c2w Char
'\"' ) ((Char, Char) -> BoundedPrim Word8
forall {a}. (Char, Char) -> BoundedPrim a
ascii2 (Char
'\\',Char
'\"' ))
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8
-> BoundedPrim Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word8 -> Bool)
-> BoundedPrim Word8 -> BoundedPrim Word8 -> BoundedPrim Word8
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
>= Char -> Word8
c2w Char
' '  ) (FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Word8
Prim.word8)
            (BoundedPrim Word8 -> BoundedPrim Word8)
-> BoundedPrim Word8 -> BoundedPrim Word8
forall a b. (a -> b) -> a -> b
$ FixedPrim Word8 -> BoundedPrim Word8
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Word8
hexEscape -- fallback for chars < 0x20
        hexEscape :: FixedPrim Word8
hexEscape = (\Word8
c -> (Char
'\\', (Char
'u', Word8 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
c))) (Word8 -> (Char, (Char, Word16)))
-> FixedPrim (Char, (Char, Word16)) -> FixedPrim Word8
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
            FixedPrim Char
Prim.char8 FixedPrim Char
-> FixedPrim (Char, Word16) -> FixedPrim (Char, (Char, Word16))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
Prim.char8 FixedPrim Char -> FixedPrim Word16 -> FixedPrim (Char, Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word16
word16HexFixed
        ascii2 :: (Char, Char) -> BoundedPrim a
ascii2 (Char, Char)
cs = FixedPrim a -> BoundedPrim a
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded (FixedPrim a -> BoundedPrim a) -> FixedPrim a -> BoundedPrim a
forall a b. (a -> b) -> a -> b
$ (Char, Char) -> a -> (Char, Char)
forall a b. a -> b -> a
const (Char, Char)
cs (a -> (Char, Char)) -> FixedPrim (Char, Char) -> FixedPrim a
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< FixedPrim Char
Prim.char7 FixedPrim Char -> FixedPrim Char -> FixedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
Prim.char7
        c2w :: Char -> Word8
c2w = Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word8) -> (Char -> Int) -> Char -> Word8
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord :: Char -> Word8

encodeChar :: Char -> Builder
encodeChar :: Char -> Builder
encodeChar = BoundedPrim Char -> Char -> Builder
forall a. BoundedPrim a -> a -> Builder
primBounded BoundedPrim Char
escape
    where
        escape :: BoundedPrim Char
escape
            = (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\\' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
'\\'))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\b' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
'b' ))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\f' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
'f' ))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\n' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
'n' ))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\r' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
'r' ))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\t' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
't' ))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'\'' ) ((Char, Char) -> BoundedPrim Char
forall {a}. (Char, Char) -> BoundedPrim a
unicode2 (Char
'\\',Char
'\'' ))
            (BoundedPrim Char -> BoundedPrim Char)
-> (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char
-> BoundedPrim Char
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool)
-> BoundedPrim Char -> BoundedPrim Char -> BoundedPrim Char
forall a.
(a -> Bool) -> BoundedPrim a -> BoundedPrim a -> BoundedPrim a
condB (Char -> Char -> Bool
forall a. Ord a => a -> a -> Bool
>= Char
' '  ) BoundedPrim Char
Prim.charUtf8
            (BoundedPrim Char -> BoundedPrim Char)
-> BoundedPrim Char -> BoundedPrim Char
forall a b. (a -> b) -> a -> b
$ FixedPrim Char -> BoundedPrim Char
forall a. FixedPrim a -> BoundedPrim a
liftFixedToBounded FixedPrim Char
hexEscape -- fallback for chars < 0x20
        hexEscape :: FixedPrim Char
hexEscape = (\Char
c -> (Char
'\\', (Char
'u', Int -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word16) -> (Char -> Int) -> Char -> Word16
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Int
ord (Char -> Word16) -> Char -> Word16
forall a b. (a -> b) -> a -> b
$ Char
c))) (Char -> (Char, (Char, Word16)))
-> FixedPrim (Char, (Char, Word16)) -> FixedPrim Char
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$<
            FixedPrim Char
Prim.char8 FixedPrim Char
-> FixedPrim (Char, Word16) -> FixedPrim (Char, (Char, Word16))
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Char
Prim.char8 FixedPrim Char -> FixedPrim Word16 -> FixedPrim (Char, Word16)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< FixedPrim Word16
word16HexFixed
        unicode2 :: (Char, Char) -> BoundedPrim b
unicode2 (Char, Char)
cs = (Char, Char) -> b -> (Char, Char)
forall a b. a -> b -> a
const (Char, Char)
cs (b -> (Char, Char)) -> BoundedPrim (Char, Char) -> BoundedPrim b
forall (f :: * -> *) b a. Contravariant f => (b -> a) -> f a -> f b
>$< BoundedPrim Char
Prim.charUtf8 BoundedPrim Char -> BoundedPrim Char -> BoundedPrim (Char, Char)
forall (f :: * -> *) a b. Monoidal f => f a -> f b -> f (a, b)
>*< BoundedPrim Char
Prim.charUtf8

--- QuickCheck

instance Arbitrary CommaStyle where
    arbitrary :: Gen CommaStyle
arbitrary = (CommaStyle, CommaStyle) -> Gen CommaStyle
forall a. Enum a => (a, a) -> Gen a
chooseEnum (CommaStyle
forall a. Bounded a => a
minBound, CommaStyle
forall a. Bounded a => a
maxBound)

instance Arbitrary SerializeSettings where
    arbitrary :: Gen SerializeSettings
arbitrary = CommaStyle
-> Int -> Bool -> Bool -> Bool -> Bool -> Bool -> SerializeSettings
SerializeSettings
        (CommaStyle
 -> Int
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> Bool
 -> SerializeSettings)
-> Gen CommaStyle
-> Gen
     (Int -> Bool -> Bool -> Bool -> Bool -> Bool -> SerializeSettings)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CommaStyle
forall a. Arbitrary a => Gen a
arbitrary
        Gen
  (Int -> Bool -> Bool -> Bool -> Bool -> Bool -> SerializeSettings)
-> Gen Int
-> Gen (Bool -> Bool -> Bool -> Bool -> Bool -> SerializeSettings)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Bool -> Bool -> Bool -> Bool -> Bool -> SerializeSettings)
-> Gen Bool
-> Gen (Bool -> Bool -> Bool -> Bool -> SerializeSettings)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Bool -> Bool -> Bool -> Bool -> SerializeSettings)
-> Gen Bool -> Gen (Bool -> Bool -> Bool -> SerializeSettings)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Bool -> Bool -> Bool -> SerializeSettings)
-> Gen Bool -> Gen (Bool -> Bool -> SerializeSettings)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Bool -> Bool -> SerializeSettings)
-> Gen Bool -> Gen (Bool -> SerializeSettings)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
        Gen (Bool -> SerializeSettings)
-> Gen Bool -> Gen SerializeSettings
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary