{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE GADTs #-}
module JsonToHaskell.Internal.Printer where

import Lens.Micro.Platform (makeLenses)
import JsonToHaskell.Internal.Parser
import JsonToHaskell.Internal.Options
import Control.Monad.State
import Control.Monad.Reader
import Control.Monad.Writer
import Data.Foldable (for_, fold)
import qualified Data.Bimap as BM
import qualified Data.HashMap.Strict as HM
import qualified Data.Map as M
import qualified Data.Text as T
import Text.Casing (toCamel, fromAny)
import Data.Char (isAlpha, isAlphaNum)
import Lens.Micro.Platform (view, (+~), (<&>))


-- | The environment used for printing the module
data Env = Env
    { Env -> Options
_options :: Options
    , Env -> Int
_indentationLevel  :: Int
    }
makeLenses ''Env



-- | Convert a name into a valid haskell field name
toFieldName :: T.Text -> T.Text
toFieldName :: Text -> Text
toFieldName = (Char -> Bool) -> Text -> Text
T.filter (Char -> Bool
isAlphaNum) (Text -> Text) -> (Text -> Text) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Identifier String -> String
toCamel (Identifier String -> String)
-> (Text -> Identifier String) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Identifier String
fromAny (String -> Identifier String)
-> (Text -> String) -> Text -> Identifier String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
T.unpack (Text -> String) -> (Text -> Text) -> Text -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> Text -> Text
T.dropWhile (Bool -> Bool
not (Bool -> Bool) -> (Char -> Bool) -> Char -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isAlpha)

type StructName = T.Text

-- | Wrap a writer in parens
parens :: MonadWriter T.Text m => m a -> m a
parens :: m a -> m a
parens m a
m =
    Text -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"(" m () -> m a -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m a
m m a -> m () -> m a
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Text -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
")"

-- | Embed the given writer at the correct level of indentation and add a newline
line :: (MonadReader Env m, MonadWriter T.Text m) => m a -> m a
line :: m a -> m a
line m a
m = do
    Int
n <- Getting Int Env Int -> m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view Getting Int Env Int
Lens' Env Int
indentationLevel
    Text -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> m ()) -> Text -> m ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
n Text
" "
    a
a <- m a
m
    m ()
forall (m :: * -> *). MonadWriter Text m => m ()
newline
    a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return  a
a

-- | Add a newline
newline :: MonadWriter T.Text m => m ()
newline :: m ()
newline = Text -> m ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"\n"

-- | Indent all 'line's of the given writer by one tabstop
indented :: (MonadReader Env m, MonadWriter T.Text m) => m a -> m a
indented :: m a -> m a
indented m a
m = do
    Int
n <- Getting Int Env Int -> m Int
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const Int Options) -> Env -> Const Int Env
Lens' Env Options
options ((Options -> Const Int Options) -> Env -> Const Int Env)
-> ((Int -> Const Int Int) -> Options -> Const Int Options)
-> Getting Int Env Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Int -> Const Int Int) -> Options -> Const Int Options
Lens' Options Int
tabStop)
    (Env -> Env) -> m a -> m a
forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local ((Int -> Identity Int) -> Env -> Identity Env
Lens' Env Int
indentationLevel ((Int -> Identity Int) -> Env -> Identity Env) -> Int -> Env -> Env
forall a s t. Num a => ASetter s t a a -> a -> s -> t
+~ Int
n) m a
m

type Builder a = ReaderT Env (Writer T.Text) ()

writeFieldName :: T.Text -> T.Text -> Builder ()
writeFieldName :: Text -> Text -> Builder ()
writeFieldName Text
recordName Text
fieldName = do
    Bool
addPrefix <- Getting Bool Env Bool -> ReaderT Env (Writer Text) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const Bool Options) -> Env -> Const Bool Env
Lens' Env Options
options ((Options -> Const Bool Options) -> Env -> Const Bool Env)
-> ((Bool -> Const Bool Bool) -> Options -> Const Bool Options)
-> Getting Bool Env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Options -> Const Bool Options
Lens' Options Bool
prefixRecordFields)
    let fieldName' :: Text
fieldName' = if Bool
addPrefix 
                        then Text
recordName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
toRecordName Text
fieldName
                        else Text
fieldName
    Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Text
toFieldName Text
fieldName'

-- | Write out the Haskell code for a record data type
writeRecord :: StructName -> RecordFields 'Ref -> Builder ()
writeRecord :: Text -> RecordFields 'Ref -> Builder ()
writeRecord Text
name RecordFields 'Ref
struct = do
    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> ([Text] -> Builder ()) -> [Text] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> ([Text] -> Text) -> [Text] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold ([Text] -> Builder ()) -> [Text] -> Builder ()
forall a b. (a -> b) -> a -> b
$ [Text
"data ", Text
name, Text
" = ", Text
name]

    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
      Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RecordFields 'Ref -> Bool
forall k v. HashMap k v -> Bool
HM.null RecordFields 'Ref
struct) (Builder () -> Builder ())
-> (Builder () -> Builder ()) -> Builder () -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{"
      [(Int, (Text, Struct 'Ref))]
-> ((Int, (Text, Struct 'Ref)) -> Builder ()) -> Builder ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Int] -> [(Text, Struct 'Ref)] -> [(Int, (Text, Struct 'Ref))]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([(Text, Struct 'Ref)] -> [(Int, (Text, Struct 'Ref))])
-> [(Text, Struct 'Ref)] -> [(Int, (Text, Struct 'Ref))]
forall a b. (a -> b) -> a -> b
$ RecordFields 'Ref -> [(Text, Struct 'Ref)]
forall k v. HashMap k v -> [(k, v)]
HM.toList RecordFields 'Ref
struct) (((Int, (Text, Struct 'Ref)) -> Builder ()) -> Builder ())
-> ((Int, (Text, Struct 'Ref)) -> Builder ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, (Text
k, Struct 'Ref
v)) -> do
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
            if (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) then Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{ "
                        else Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
", "
            Text -> Text -> Builder ()
writeFieldName Text
name Text
k
            Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
" :: "
            Bool
useStrictData <- Getting Bool Env Bool -> ReaderT Env (Writer Text) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const Bool Options) -> Env -> Const Bool Env
Lens' Env Options
options ((Options -> Const Bool Options) -> Env -> Const Bool Env)
-> ((Bool -> Const Bool Bool) -> Options -> Const Bool Options)
-> Getting Bool Env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Options -> Const Bool Options
Lens' Options Bool
strictData)
            Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
useStrictData (Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"!")
            Bool -> Struct 'Ref -> Builder ()
writeType Bool
False Struct 'Ref
v
    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ())
-> (Builder () -> Builder ()) -> Builder () -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"} "
        Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"deriving (Show, Eq, Ord)"

-- | Write out the Haskell code for a ToJSON instance for the given record
writeToJSONInstance :: StructName -> RecordFields 'Ref -> Builder ()
writeToJSONInstance :: Text -> RecordFields 'Ref -> Builder ()
writeToJSONInstance Text
name RecordFields 'Ref
struct = do
    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"instance ToJSON " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where"
    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
            Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"toJSON " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
            Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> (RecordFields 'Ref -> Bool) -> RecordFields 'Ref -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordFields 'Ref -> Bool
forall k v. HashMap k v -> Bool
HM.null (RecordFields 'Ref -> Bool) -> RecordFields 'Ref -> Bool
forall a b. (a -> b) -> a -> b
$ RecordFields 'Ref
struct) (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{..}"
            Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
" = object"
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
            Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (RecordFields 'Ref -> Bool
forall k v. HashMap k v -> Bool
HM.null RecordFields 'Ref
struct) (Builder () -> Builder ())
-> (Builder () -> Builder ()) -> Builder () -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"["
            [(Int, Text)] -> ((Int, Text) -> Builder ()) -> Builder ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ ([Int] -> [Text] -> [(Int, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Int
0 :: Int ..] ([Text] -> [(Int, Text)]) -> [Text] -> [(Int, Text)]
forall a b. (a -> b) -> a -> b
$ RecordFields 'Ref -> [Text]
forall k v. HashMap k v -> [k]
HM.keys RecordFields 'Ref
struct) (((Int, Text) -> Builder ()) -> Builder ())
-> ((Int, Text) -> Builder ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \(Int
i, Text
k) -> do
                Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
                    if (Int
i Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) then Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"[ "
                                else Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
", "
                    Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeQuotes Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
                    Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
" .= "
                    Text -> Text -> Builder ()
writeFieldName Text
name Text
k
            Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"] "

-- | Write out the Haskell code for a FromJSON instance for the given record
writeFromJSONInstance :: StructName -> RecordFields 'Ref -> Builder ()
writeFromJSONInstance :: Text -> RecordFields 'Ref -> Builder ()
writeFromJSONInstance Text
name RecordFields 'Ref
struct = do
    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"instance FromJSON " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" where"
    Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"parseJSON (Object v) = do"
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
            [Text] -> (Text -> Builder ()) -> Builder ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (RecordFields 'Ref -> [Text]
forall k v. HashMap k v -> [k]
HM.keys RecordFields 'Ref
struct) ((Text -> Builder ()) -> Builder ())
-> (Text -> Builder ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \Text
k -> do
                Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
                    Text -> Text -> Builder ()
writeFieldName Text
name Text
k
                    Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
" <- v .: "
                    Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
escapeQuotes Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
            Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
                Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"pure $ " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name
                Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Bool -> Bool)
-> (RecordFields 'Ref -> Bool) -> RecordFields 'Ref -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. RecordFields 'Ref -> Bool
forall k v. HashMap k v -> Bool
HM.null (RecordFields 'Ref -> Bool) -> RecordFields 'Ref -> Bool
forall a b. (a -> b) -> a -> b
$ RecordFields 'Ref
struct) (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"{..}"
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"parseJSON invalid = do"
        Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
          Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"prependFailure \"parsing " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" failed, \""
          Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
indented (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"(typeMismatch \"Object\" invalid)"


-- | Write out the Haskell representation for a given JSON type
writeType :: Bool -> Struct 'Ref -> Builder ()
writeType :: Bool -> Struct 'Ref -> Builder ()
writeType Bool
nested Struct 'Ref
struct = do
  Bool
strict <- Getting Bool Env Bool -> ReaderT Env (Writer Text) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const Bool Options) -> Env -> Const Bool Env
Lens' Env Options
options ((Options -> Const Bool Options) -> Env -> Const Bool Env)
-> ((Bool -> Const Bool Bool) -> Options -> Const Bool Options)
-> Getting Bool Env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Options -> Const Bool Options
Lens' Options Bool
strictData)
  let wrapOuter :: Builder () -> Builder ()
wrapOuter = if Bool
strict Bool -> Bool -> Bool
|| Bool
nested then Builder () -> Builder ()
forall (m :: * -> *) a. MonadWriter Text m => m a -> m a
parens else Builder () -> Builder ()
forall a. a -> a
id
  case Struct 'Ref
struct of
    Struct 'Ref
SNull -> Builder () -> Builder ()
wrapOuter (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Maybe Value"
    Struct 'Ref
SString -> do
        ReaderT Env (Writer Text) Text
getTextType ReaderT Env (Writer Text) Text
-> (Text -> Builder ()) -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell
    SNumber NumberVariant
t -> do
        NumberType
pref <- Getting NumberType Env NumberType
-> ReaderT Env (Writer Text) NumberType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const NumberType Options)
-> Env -> Const NumberType Env
Lens' Env Options
options ((Options -> Const NumberType Options)
 -> Env -> Const NumberType Env)
-> ((NumberType -> Const NumberType NumberType)
    -> Options -> Const NumberType Options)
-> Getting NumberType Env NumberType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NumberType -> Const NumberType NumberType)
-> Options -> Const NumberType Options
Lens' Options NumberType
numberType)
        case (NumberType
pref, NumberVariant
t) of
            (NumberType
UseFloats, NumberVariant
_) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Float"
            (NumberType
UseDoubles, NumberVariant
_) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Double"
            (NumberType
UseScientific, NumberVariant
_) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Scientific"
            (NumberType
UseSmartFloats, NumberVariant
Fractional) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Float"
            (NumberType
UseSmartFloats, NumberVariant
Whole) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Int"
            (NumberType
UseSmartDoubles, NumberVariant
Fractional) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Double"
            (NumberType
UseSmartDoubles, NumberVariant
Whole) -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Int"

    Struct 'Ref
SBool -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Bool"
    Struct 'Ref
SValue -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Value"
    SMap Struct 'Ref
s -> do
        Text
txtType <- ReaderT Env (Writer Text) Text
getTextType
        Text
mapStr <- Getting MapType Env MapType -> ReaderT Env (Writer Text) MapType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const MapType Options) -> Env -> Const MapType Env
Lens' Env Options
options ((Options -> Const MapType Options) -> Env -> Const MapType Env)
-> ((MapType -> Const MapType MapType)
    -> Options -> Const MapType Options)
-> Getting MapType Env MapType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MapType -> Const MapType MapType)
-> Options -> Const MapType Options
Lens' Options MapType
mapType) ReaderT Env (Writer Text) MapType
-> (MapType -> Text) -> ReaderT Env (Writer Text) Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
            MapType
UseMap -> Text
"Map"
            MapType
UseHashMap -> Text
"HashMap"
        Builder () -> Builder ()
wrapOuter (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text
mapStr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
txtType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ") Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Struct 'Ref -> Builder ()
writeType Bool
True Struct 'Ref
s
    SArray Struct 'Ref
s -> do
        Getting ListType Env ListType -> ReaderT Env (Writer Text) ListType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const ListType Options) -> Env -> Const ListType Env
Lens' Env Options
options ((Options -> Const ListType Options) -> Env -> Const ListType Env)
-> ((ListType -> Const ListType ListType)
    -> Options -> Const ListType Options)
-> Getting ListType Env ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListType -> Const ListType ListType)
-> Options -> Const ListType Options
Lens' Options ListType
listType) ReaderT Env (Writer Text) ListType
-> (ListType -> Builder ()) -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
          ListType
UseList -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"[" Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Struct 'Ref -> Builder ()
writeType Bool
False Struct 'Ref
s Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"]"
          ListType
UseVector -> Builder () -> Builder ()
wrapOuter (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
"Vector " Builder () -> Builder () -> Builder ()
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> Bool -> Struct 'Ref -> Builder ()
writeType Bool
True Struct 'Ref
s
    SRecordRef Text
n -> Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell Text
n
  where
    getTextType :: ReaderT Env (Writer Text) Text
getTextType = do
        Getting TextType Env TextType -> ReaderT Env (Writer Text) TextType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const TextType Options) -> Env -> Const TextType Env
Lens' Env Options
options ((Options -> Const TextType Options) -> Env -> Const TextType Env)
-> ((TextType -> Const TextType TextType)
    -> Options -> Const TextType Options)
-> Getting TextType Env TextType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextType -> Const TextType TextType)
-> Options -> Const TextType Options
Lens' Options TextType
textType) ReaderT Env (Writer Text) TextType
-> (TextType -> Text) -> ReaderT Env (Writer Text) Text
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \case
          TextType
UseString -> Text
"String"
          TextType
UseByteString -> Text
"ByteString"
          TextType
UseText -> Text
"Text"

-- | Write out all the given records and their instances
writeModel :: Options -> BM.Bimap T.Text (RecordFields 'Ref) -> T.Text
writeModel :: Options -> Bimap Text (RecordFields 'Ref) -> Text
writeModel Options
opts (Bimap Text (RecordFields 'Ref) -> Map Text (RecordFields 'Ref)
forall a b. Bimap a b -> Map a b
BM.toMap -> Map Text (RecordFields 'Ref)
m) = Writer Text () -> Text
forall w a. Writer w a -> w
execWriter (Writer Text () -> Text)
-> (Builder () -> Writer Text ()) -> Builder () -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Builder () -> Env -> Writer Text ())
-> Env -> Builder () -> Writer Text ()
forall a b c. (a -> b -> c) -> b -> a -> c
flip Builder () -> Env -> Writer Text ()
forall r (m :: * -> *) a. ReaderT r m a -> r -> m a
runReaderT (Options -> Int -> Env
Env Options
opts Int
0) (Builder () -> Text) -> Builder () -> Text
forall a b. (a -> b) -> a -> b
$ do
    Bool
incHeader <- Getting Bool Env Bool -> ReaderT Env (Writer Text) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const Bool Options) -> Env -> Const Bool Env
Lens' Env Options
options ((Options -> Const Bool Options) -> Env -> Const Bool Env)
-> ((Bool -> Const Bool Bool) -> Options -> Const Bool Options)
-> Getting Bool Env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Options -> Const Bool Options
Lens' Options Bool
includeHeader)
    Bool
incInstances <- Getting Bool Env Bool -> ReaderT Env (Writer Text) Bool
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const Bool Options) -> Env -> Const Bool Env
Lens' Env Options
options ((Options -> Const Bool Options) -> Env -> Const Bool Env)
-> ((Bool -> Const Bool Bool) -> Options -> Const Bool Options)
-> Getting Bool Env Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Bool -> Const Bool Bool) -> Options -> Const Bool Options
Lens' Options Bool
includeInstances)
    Bool
includeScientific <- Getting NumberType Env NumberType
-> ReaderT Env (Writer Text) NumberType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const NumberType Options)
-> Env -> Const NumberType Env
Lens' Env Options
options ((Options -> Const NumberType Options)
 -> Env -> Const NumberType Env)
-> ((NumberType -> Const NumberType NumberType)
    -> Options -> Const NumberType Options)
-> Getting NumberType Env NumberType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (NumberType -> Const NumberType NumberType)
-> Options -> Const NumberType Options
Lens' Options NumberType
numberType) ReaderT Env (Writer Text) NumberType
-> (NumberType -> Bool) -> ReaderT Env (Writer Text) Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (NumberType -> NumberType -> Bool
forall a. Eq a => a -> a -> Bool
== NumberType
UseScientific)
    Bool
includeVector <- Getting ListType Env ListType -> ReaderT Env (Writer Text) ListType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const ListType Options) -> Env -> Const ListType Env
Lens' Env Options
options ((Options -> Const ListType Options) -> Env -> Const ListType Env)
-> ((ListType -> Const ListType ListType)
    -> Options -> Const ListType Options)
-> Getting ListType Env ListType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ListType -> Const ListType ListType)
-> Options -> Const ListType Options
Lens' Options ListType
listType) ReaderT Env (Writer Text) ListType
-> (ListType -> Bool) -> ReaderT Env (Writer Text) Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (ListType -> ListType -> Bool
forall a. Eq a => a -> a -> Bool
== ListType
UseVector)
    Bool
includeText <- Getting TextType Env TextType -> ReaderT Env (Writer Text) TextType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const TextType Options) -> Env -> Const TextType Env
Lens' Env Options
options ((Options -> Const TextType Options) -> Env -> Const TextType Env)
-> ((TextType -> Const TextType TextType)
    -> Options -> Const TextType Options)
-> Getting TextType Env TextType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextType -> Const TextType TextType)
-> Options -> Const TextType Options
Lens' Options TextType
textType) ReaderT Env (Writer Text) TextType
-> (TextType -> Bool) -> ReaderT Env (Writer Text) Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (TextType -> TextType -> Bool
forall a. Eq a => a -> a -> Bool
== TextType
UseText)
    Bool
includeByteString <- Getting TextType Env TextType -> ReaderT Env (Writer Text) TextType
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view ((Options -> Const TextType Options) -> Env -> Const TextType Env
Lens' Env Options
options ((Options -> Const TextType Options) -> Env -> Const TextType Env)
-> ((TextType -> Const TextType TextType)
    -> Options -> Const TextType Options)
-> Getting TextType Env TextType
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (TextType -> Const TextType TextType)
-> Options -> Const TextType Options
Lens' Options TextType
textType) ReaderT Env (Writer Text) TextType
-> (TextType -> Bool) -> ReaderT Env (Writer Text) Bool
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (TextType -> TextType -> Bool
forall a. Eq a => a -> a -> Bool
== TextType
UseByteString)
    Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
incHeader (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> ([Text] -> Text) -> [Text] -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Text] -> Text
T.unlines ([Text] -> Builder ()) -> [Text] -> Builder ()
forall a b. (a -> b) -> a -> b
$
            [ Text
"{-# LANGUAGE DuplicateRecordFields #-}"
            , Text
"{-# LANGUAGE RecordWildCards #-}"
            , Text
"{-# LANGUAGE OverloadedStrings #-}"
            , Text
"module Model where"
            , Text
""
            , Text
"import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), (.:), (.=), object)"
            , Text
"import Data.Aeson.Types (prependFailure, typeMismatch)"
            ]
        Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
includeVector (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"import Data.Vector (Vector)"
        Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
includeScientific (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"import Data.Scientific (Scientific)"
        Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
includeText (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"import Data.Text (Text)"
        Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
includeByteString (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder () -> Builder ()
forall (m :: * -> *) a.
(MonadReader Env m, MonadWriter Text m) =>
m a -> m a
line (Builder () -> Builder ())
-> (Text -> Builder ()) -> Text -> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Builder ()
forall w (m :: * -> *). MonadWriter w m => w -> m ()
tell (Text -> Builder ()) -> Text -> Builder ()
forall a b. (a -> b) -> a -> b
$ Text
"import Data.ByteString (ByteString)"
        Builder ()
forall (m :: * -> *). MonadWriter Text m => m ()
newline
    ReaderT Env (Writer Text) (Map Text ()) -> Builder ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Env (Writer Text) (Map Text ()) -> Builder ())
-> ((Text -> RecordFields 'Ref -> Builder ())
    -> ReaderT Env (Writer Text) (Map Text ()))
-> (Text -> RecordFields 'Ref -> Builder ())
-> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> RecordFields 'Ref -> Builder ())
 -> Map Text (RecordFields 'Ref)
 -> ReaderT Env (Writer Text) (Map Text ()))
-> Map Text (RecordFields 'Ref)
-> (Text -> RecordFields 'Ref -> Builder ())
-> ReaderT Env (Writer Text) (Map Text ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> RecordFields 'Ref -> Builder ())
-> Map Text (RecordFields 'Ref)
-> ReaderT Env (Writer Text) (Map Text ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey Map Text (RecordFields 'Ref)
m ((Text -> RecordFields 'Ref -> Builder ()) -> Builder ())
-> (Text -> RecordFields 'Ref -> Builder ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \Text
k RecordFields 'Ref
v -> do
        Text -> RecordFields 'Ref -> Builder ()
writeRecord Text
k RecordFields 'Ref
v
        Builder ()
forall (m :: * -> *). MonadWriter Text m => m ()
newline
    Bool -> Builder () -> Builder ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
incInstances (Builder () -> Builder ()) -> Builder () -> Builder ()
forall a b. (a -> b) -> a -> b
$ do
        ReaderT Env (Writer Text) (Map Text ()) -> Builder ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Env (Writer Text) (Map Text ()) -> Builder ())
-> ((Text -> RecordFields 'Ref -> Builder ())
    -> ReaderT Env (Writer Text) (Map Text ()))
-> (Text -> RecordFields 'Ref -> Builder ())
-> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> RecordFields 'Ref -> Builder ())
 -> Map Text (RecordFields 'Ref)
 -> ReaderT Env (Writer Text) (Map Text ()))
-> Map Text (RecordFields 'Ref)
-> (Text -> RecordFields 'Ref -> Builder ())
-> ReaderT Env (Writer Text) (Map Text ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> RecordFields 'Ref -> Builder ())
-> Map Text (RecordFields 'Ref)
-> ReaderT Env (Writer Text) (Map Text ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey Map Text (RecordFields 'Ref)
m ((Text -> RecordFields 'Ref -> Builder ()) -> Builder ())
-> (Text -> RecordFields 'Ref -> Builder ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \Text
k RecordFields 'Ref
v -> do
            Text -> RecordFields 'Ref -> Builder ()
writeToJSONInstance Text
k RecordFields 'Ref
v
            Builder ()
forall (m :: * -> *). MonadWriter Text m => m ()
newline
        ReaderT Env (Writer Text) (Map Text ()) -> Builder ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReaderT Env (Writer Text) (Map Text ()) -> Builder ())
-> ((Text -> RecordFields 'Ref -> Builder ())
    -> ReaderT Env (Writer Text) (Map Text ()))
-> (Text -> RecordFields 'Ref -> Builder ())
-> Builder ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Text -> RecordFields 'Ref -> Builder ())
 -> Map Text (RecordFields 'Ref)
 -> ReaderT Env (Writer Text) (Map Text ()))
-> Map Text (RecordFields 'Ref)
-> (Text -> RecordFields 'Ref -> Builder ())
-> ReaderT Env (Writer Text) (Map Text ())
forall a b c. (a -> b -> c) -> b -> a -> c
flip (Text -> RecordFields 'Ref -> Builder ())
-> Map Text (RecordFields 'Ref)
-> ReaderT Env (Writer Text) (Map Text ())
forall (t :: * -> *) k a b.
Applicative t =>
(k -> a -> t b) -> Map k a -> t (Map k b)
M.traverseWithKey Map Text (RecordFields 'Ref)
m ((Text -> RecordFields 'Ref -> Builder ()) -> Builder ())
-> (Text -> RecordFields 'Ref -> Builder ()) -> Builder ()
forall a b. (a -> b) -> a -> b
$ \Text
k RecordFields 'Ref
v -> do
            Text -> RecordFields 'Ref -> Builder ()
writeFromJSONInstance Text
k RecordFields 'Ref
v
            Builder ()
forall (m :: * -> *). MonadWriter Text m => m ()
newline

escapeQuotes :: T.Text -> T.Text
escapeQuotes :: Text -> Text
escapeQuotes = Text -> Text -> Text -> Text
T.replace Text
"\"" Text
"\\\""