{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Aeson.Match.QQ.Internal.AesonUtils
  ( toJSONE
  , pp
  ) where

import qualified Data.Aeson as Aeson
import qualified Data.Aeson.Encoding.Internal as Aeson (encodingToLazyByteString)
import qualified Data.Aeson.KeyMap as Aeson.KeyMap
import           Data.Bool (bool)
import           Data.Foldable (toList)
import qualified Data.List as List
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.Int (Int64)
import           Data.Scientific (Scientific, floatingOrInteger)
import           Data.String (fromString)
import           Data.Text (Text)
import           Data.Vector (Vector)
import           Text.PrettyPrint ((<+>))
import qualified Text.PrettyPrint as PP


-- | This is a round-about way to produce a 'Aeson.Value' from a 'ToJSON' instance.
-- it is written this way to avoid calling 'Aeson.toJSON' which might be undefined
-- for some datatypes that only implement 'toEncoding'.
--
-- It is defined in a separate module due to the TH stage restrictions as we need
-- to 'lift' 'toJSONE' eventually.
toJSONE :: Aeson.ToJSON x => x -> Aeson.Value
toJSONE :: forall x. ToJSON x => x -> Value
toJSONE x
x =
  let
    ~(Just Value
val) = x -> Maybe Value
conv x
x
    -- ^ the pattern is irrefutable because we assume that it is always possible
    -- to recover a Value from an Encoding generated by Aeson.toEncoding
  in
    Value
val
 where
  conv :: x -> Maybe Value
conv =
    forall a. FromJSON a => ByteString -> Maybe a
Aeson.decode forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Encoding' a -> ByteString
Aeson.encodingToLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Encoding
Aeson.toEncoding

-- | A super-basic re-implementation of aeson-pretty. This function attains 2 goals:
--
--   - we avoid another dependency
--   - it uses the same prettyprinter everything else uses, and thus
--   it is easily integrated.
pp :: Aeson.Value -> PP.Doc
pp :: Value -> Doc
pp = \case
  Value
Aeson.Null ->
    Doc
rNull
  Aeson.Bool Bool
b ->
    Bool -> Doc
rBool Bool
b
  Aeson.Number Scientific
n ->
    Scientific -> Doc
rNumber Scientific
n
  Aeson.String Text
str ->
    Text -> Doc
rString Text
str
  Aeson.Array Array
xs ->
    Array -> Doc
rArray Array
xs
  Aeson.Object Object
o ->
    HashMap Text Value -> Doc
rObject (forall v. KeyMap v -> HashMap Text v
Aeson.KeyMap.toHashMapText Object
o)
 where
  rNull :: PP.Doc
  rNull :: Doc
rNull =
    Doc
"null"

  rBool :: Bool -> PP.Doc
  rBool :: Bool -> Doc
rBool =
    forall a. a -> a -> Bool -> a
bool Doc
"false" Doc
"true"

  rNumber :: Scientific -> PP.Doc
  rNumber :: Scientific -> Doc
rNumber =
    forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall a. Show a => a -> String
show @Double) (forall a. Show a => a -> String
show @Int64) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall r i. (RealFloat r, Integral i) => Scientific -> Either r i
floatingOrInteger

  rString :: Text -> PP.Doc
  rString :: Text -> Doc
rString =
    forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show

  rArray :: Vector Aeson.Value -> PP.Doc
  rArray :: Array -> Doc
rArray Array
values =
    case forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Array
values of
      [] ->
        Doc
"[]"
      Value
x : [Value]
xs ->
        [Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
          [Doc
"[" Doc -> Doc -> Doc
<+> Value -> Doc
pp Value
x] forall a. Semigroup a => a -> a -> a
<>
          forall a b. (a -> b) -> [a] -> [b]
map (\Value
x' -> Doc
"," Doc -> Doc -> Doc
<+> Value -> Doc
pp Value
x') [Value]
xs forall a. Semigroup a => a -> a -> a
<>
          [Doc
"]"]

  rObject :: HashMap Text Aeson.Value -> PP.Doc
  rObject :: HashMap Text Value -> Doc
rObject HashMap Text Value
values =
    case forall b a. Ord b => (a -> b) -> [a] -> [a]
List.sortOn forall a b. (a, b) -> a
fst (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
values) of
      [] ->
        Doc
"{}"
      (Text, Value)
kv : [(Text, Value)]
kvs ->
        [Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
          [Doc
"{" Doc -> Doc -> Doc
<+> (Text, Value) -> Doc
rKeyValue (Text, Value)
kv] forall a. Semigroup a => a -> a -> a
<>
          forall a b. (a -> b) -> [a] -> [b]
map (\(Text, Value)
kv' -> Doc
"," Doc -> Doc -> Doc
<+> (Text, Value) -> Doc
rKeyValue (Text, Value)
kv') [(Text, Value)]
kvs forall a. Semigroup a => a -> a -> a
<>
          [Doc
"}"]
   where
    rKeyValue :: (Text, Value) -> Doc
rKeyValue (Text
key, Value
value) =
      if Value -> Bool
simpleValue Value
value then
        (Text -> Doc
rString Text
key forall a. Semigroup a => a -> a -> a
<> Doc
":") Doc -> Doc -> Doc
<+> Value -> Doc
pp Value
value
      else
        [Doc] -> Doc
PP.vcat
          [ Text -> Doc
rString Text
key forall a. Semigroup a => a -> a -> a
<> Doc
":"
          , Value -> Doc
pp Value
value
          ]

  simpleValue :: Aeson.Value -> Bool
  simpleValue :: Value -> Bool
simpleValue = \case
    Aeson.Null {} ->
      Bool
True
    Aeson.Bool {} ->
      Bool
True
    Aeson.Number {} ->
      Bool
True
    Aeson.String {} ->
      Bool
True
    Aeson.Array {} ->
      Bool
False
    Aeson.Object {} ->
      Bool
False