{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}
module Aeson.Match.QQ.Internal.PrettyPrint
  ( pp
  ) where

import qualified Data.Aeson as Aeson
import           Data.Bool (bool)
import qualified Data.ByteString.Lazy as ByteString.Lazy
import           Data.CaseInsensitive (CI)
import qualified Data.CaseInsensitive as CI
import qualified Data.Char as Char
import           Data.Foldable (toList)
import           Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import           Data.Int (Int64)
import qualified Data.List as List
import           Data.Scientific (Scientific, floatingOrInteger)
import           Data.String (fromString)
import qualified Data.Text as Text
import qualified Data.Text.Encoding as Text
import           Data.Text (Text)
import           Data.Vector (Vector)
import           Text.PrettyPrint ((<+>))
import qualified Text.PrettyPrint as PP

import           Aeson.Match.QQ.Internal.Value
  ( Matcher(..)
  , HoleSig(..)
  , Type(..)
  , Box(..)
  )


pp :: Matcher Aeson.Value -> PP.Doc
pp :: Matcher Value -> Doc
pp Matcher Value
value =
  [Doc] -> Doc
PP.vcat
    [ Doc
"[qq|"
    , Int -> Doc -> Doc
PP.nest Int
2 (Matcher Value -> Doc
rValue Matcher Value
value)
    , Doc
"|]"
    ]

rValue :: Matcher Aeson.Value -> PP.Doc
rValue :: Matcher Value -> Doc
rValue = \case
  Hole Maybe HoleSig
sig Maybe Text
name ->
    Maybe HoleSig -> Maybe Text -> Doc
rHole Maybe HoleSig
sig Maybe Text
name
  Matcher Value
Null ->
    Doc
rNull
  Bool Bool
b ->
    Bool -> Doc
rBool Bool
b
  Number Scientific
n ->
    Scientific -> Doc
rNumber Scientific
n
  String Text
str ->
    Text -> Doc
rString Text
str
  StringCI CI Text
str ->
    CI Text -> Doc
rStringCI CI Text
str
  Array Array Value
xs ->
    Array Value -> Doc
rArray Array Value
xs
  ArrayUO Array Value
xs ->
    Array Value -> Doc
rArrayUO Array Value
xs
  Object Object Value
o ->
    Object Value -> Doc
rObject Object Value
o
  Ext Value
ext ->
    Value -> Doc
rExt Value
ext

rHole :: Maybe HoleSig -> Maybe Text -> PP.Doc
rHole :: Maybe HoleSig -> Maybe Text -> Doc
rHole Maybe HoleSig
sig Maybe Text
name =
  (Doc
"_" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
PP.empty Text -> Doc
rName Maybe Text
name) Doc -> Doc -> Doc
<+> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Doc
PP.empty HoleSig -> Doc
rSig Maybe HoleSig
sig

rName :: Text -> PP.Doc
rName :: Text -> Doc
rName Text
name =
  String -> Doc
PP.text (forall a. a -> a -> Bool -> a
bool (Text -> String
Text.unpack Text
name) (forall a. Show a => a -> String
show Text
name) (Text -> Bool
hasSpaces Text
name))
 where
  hasSpaces :: Text -> Bool
hasSpaces =
    (Char -> Bool) -> Text -> Bool
Text.any Char -> Bool
Char.isSpace

rSig :: HoleSig -> PP.Doc
rSig :: HoleSig -> Doc
rSig HoleSig {Type
type_ :: HoleSig -> Type
type_ :: Type
type_, Bool
nullable :: HoleSig -> Bool
nullable :: Bool
nullable} =
  (Doc
":" Doc -> Doc -> Doc
<+> Type -> Doc
rType Type
type_) forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool Doc
PP.empty Doc
"?" Bool
nullable
 where
  rType :: Type -> Doc
rType = \case
    Type
BoolT -> Doc
"bool"
    Type
NumberT -> Doc
"number"
    Type
StringT -> Doc
"string"
    Type
StringCIT -> Doc
"ci-string"
    Type
ArrayT -> Doc
"array"
    Type
ArrayUOT -> Doc
"unordered-array"
    Type
ObjectT -> Doc
"object"

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

rStringCI :: CI Text -> PP.Doc
rStringCI :: CI Text -> Doc
rStringCI CI Text
str =
  [Doc] -> Doc
PP.vcat
    [ Doc
"(ci)"
    , Text -> Doc
rString (forall s. CI s -> s
CI.original CI Text
str)
    ]

rArray :: Box (Vector (Matcher Aeson.Value)) -> PP.Doc
rArray :: Array Value -> Doc
rArray Box {Vector (Matcher Value)
values :: forall a. Box a -> a
values :: Vector (Matcher Value)
values, Bool
extra :: forall a. Box a -> Bool
extra :: Bool
extra} =
  case forall (t :: * -> *) a. Foldable t => t a -> [a]
toList Vector (Matcher Value)
values of
    [] ->
      Doc
"[]"
    Matcher Value
x : [Matcher Value]
xs ->
      [Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
        [Doc
"[" Doc -> Doc -> Doc
<+> Matcher Value -> Doc
rValue Matcher Value
x] forall a. Semigroup a => a -> a -> a
<>
        forall a b. (a -> b) -> [a] -> [b]
map (\Matcher Value
x' -> Doc
"," Doc -> Doc -> Doc
<+> Matcher Value -> Doc
rValue Matcher Value
x') [Matcher Value]
xs forall a. Semigroup a => a -> a -> a
<>
        [forall a. a -> a -> Bool -> a
bool Doc
PP.empty Doc
", ..." Bool
extra, Doc
"]"]

rArrayUO :: Box (Vector (Matcher Aeson.Value)) -> PP.Doc
rArrayUO :: Array Value -> Doc
rArrayUO Array Value
box =
  [Doc] -> Doc
PP.vcat
    [ Doc
"(unordered)"
    , Array Value -> Doc
rArray Array Value
box
    ]

rExt :: Aeson.Value -> PP.Doc
rExt :: Value -> Doc
rExt =
  forall a. IsString a => String -> a
fromString forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
Text.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
ByteString.Lazy.toStrict forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
Aeson.encode

rObject :: Box (HashMap Text (Matcher Aeson.Value)) -> PP.Doc
rObject :: Object Value -> Doc
rObject Box {HashMap Text (Matcher Value)
values :: HashMap Text (Matcher Value)
values :: forall a. Box a -> a
values, Bool
extra :: Bool
extra :: forall a. Box a -> Bool
extra} =
  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 (Matcher Value)
values) of
    [] ->
      Doc
"{}"
    (Text, Matcher Value)
kv : [(Text, Matcher Value)]
kvs ->
      [Doc] -> Doc
PP.vcat forall a b. (a -> b) -> a -> b
$
        [Doc
"{" Doc -> Doc -> Doc
<+> (Text, Matcher Value) -> Doc
rKeyValue (Text, Matcher Value)
kv] forall a. Semigroup a => a -> a -> a
<>
        forall a b. (a -> b) -> [a] -> [b]
map (\(Text, Matcher Value)
kv' -> Doc
"," Doc -> Doc -> Doc
<+> (Text, Matcher Value) -> Doc
rKeyValue (Text, Matcher Value)
kv') [(Text, Matcher Value)]
kvs forall a. Semigroup a => a -> a -> a
<>
        [forall a. a -> a -> Bool -> a
bool Doc
PP.empty Doc
", ..." Bool
extra, Doc
"}"]
 where
  rKeyValue :: (Text, Matcher Value) -> Doc
rKeyValue (Text
key, Matcher Value
value) =
    if Matcher Value -> Bool
simpleValue Matcher Value
value then
      (Text -> Doc
rName Text
key forall a. Semigroup a => a -> a -> a
<> Doc
":") Doc -> Doc -> Doc
<+> Matcher Value -> Doc
rValue Matcher Value
value
    else
      [Doc] -> Doc
PP.vcat
        [ Text -> Doc
rName Text
key forall a. Semigroup a => a -> a -> a
<> Doc
":"
        , Matcher Value -> Doc
rValue Matcher Value
value
        ]

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