{-# OPTIONS_HADDOCK prune #-}
{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module: Vestigia.Json
-- Copyright: (c) 2026 Jared Tobin
-- License: MIT
-- Maintainer: Jared Tobin <jared@ppad.tech>
--
-- A JSON value and its encoding: enough to write a report, with
-- object keys in the order given.

module Vestigia.Json (
    Value(..)
  , encode
  ) where

import Data.Char (ord)
import qualified Data.Text as T
import Numeric (showHex)

-- | A JSON value. An object keeps its keys in the order given.
data Value =
    Null
  | Bool !Bool
  | Number !Integer
  | String !T.Text
  | Array ![Value]
  | Object ![(T.Text, Value)]
  deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)

-- | The value's encoding, indented two spaces per level.
--
-- >>> encode (Object [("a", Array [Number 1, Null])])
-- "{\n  \"a\": [\n    1,\n    null\n  ]\n}\n"
encode :: Value -> T.Text
encode :: Value -> Text
encode Value
v = Int -> Value -> Text
go Int
0 Value
v Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n"
  where
    go :: Int -> Value -> T.Text
    go :: Int -> Value -> Text
go Int
d Value
x = case Value
x of
      Value
Null -> Text
"null"
      Bool Bool
b -> if Bool
b then Text
"true" else Text
"false"
      Number Integer
n -> String -> Text
T.pack (Integer -> String
forall a. Show a => a -> String
show Integer
n)
      String Text
s -> Text -> Text
str Text
s
      Array [] -> Text
"[]"
      Array [Value]
xs -> Text
"[\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
",\n"
        [ Int -> Text
pad (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Text
go (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Value
y | Value
y <- [Value]
xs ]
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
pad Int
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"]"
      Object [] -> Text
"{}"
      Object [(Text, Value)]
kvs -> Text
"{\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
",\n"
        [ Int -> Text
pad (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
str Text
k Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Value -> Text
go (Int
d Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Value
y
        | (Text
k, Value
y) <- [(Text, Value)]
kvs ]
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
pad Int
d Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"}"

    pad :: Int -> Text
pad Int
d = Int -> Text -> Text
T.replicate (Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
d) Text
" "

str :: T.Text -> T.Text
str :: Text -> Text
str Text
s = Text
"\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Char -> Text) -> Text -> Text
T.concatMap Char -> Text
esc Text
s Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\""
  where
    esc :: Char -> Text
esc Char
c = case Char
c of
      Char
'"' -> Text
"\\\""
      Char
'\\' -> Text
"\\\\"
      Char
'\n' -> Text
"\\n"
      Char
'\r' -> Text
"\\r"
      Char
'\t' -> Text
"\\t"
      Char
_ | Char -> Int
ord Char
c Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0x20 ->
            let h :: String
h = Int -> ShowS
forall a. Integral a => a -> ShowS
showHex (Char -> Int
ord Char
c) String
""
            in String -> Text
T.pack (String
"\\u" String -> ShowS
forall a. Semigroup a => a -> a -> a
<> Int -> Char -> String
forall a. Int -> a -> [a]
replicate (Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
- String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length String
h) Char
'0' String -> ShowS
forall a. Semigroup a => a -> a -> a
<> String
h)
        | Bool
otherwise -> Char -> Text
T.singleton Char
c