{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE RankNTypes #-}
module Waargonaut.Prettier
(
InlineOption (..)
, NumSpaces (..)
, IndentStep (..)
, prettyJson
, simpleEncodePretty
, module Natural
) where
import Prelude (Eq, Show, (+), (-))
import Control.Applicative (Applicative, (<$>))
import Control.Category (id, (.))
import Control.Lens (Traversal', over,
traverseOf, (%~), (.~),
_1, _2, _Just, _Wrapped)
import Natural (Natural, minus,
successor', zero',
_Natural)
import qualified Data.Text.Lazy as LT
import qualified Data.Text.Lazy.Builder as TB
import Data.Bool (Bool, bool)
import Data.Foldable (elem, length)
import Data.Function (($))
import Data.Functor (fmap)
import Data.Maybe (maybe)
import Data.Semigroup ((<>))
import Data.Traversable (traverse)
import qualified Data.Vector as V
import qualified Control.Lens as L
import qualified Control.Lens.Plated as P
import Waargonaut.Encode (Encoder, runEncoder)
import Waargonaut.Types.CommaSep (Elems)
import qualified Waargonaut.Types.CommaSep as CS
import Waargonaut.Types.JObject (HasJAssoc (..), JAssoc)
import Waargonaut.Types.Json (AsJType (..), JType (..),
Json, jsonTraversal)
import Waargonaut.Types.Whitespace (WS (..), Whitespace (..))
import Waargonaut.Encode.Builder (textBuilder,
waargonautBuilder)
import Waargonaut.Encode.Builder.Whitespace (wsBuilder)
data InlineOption
= ArrayOnly
| ObjectOnly
| Both
| Neither
deriving (Int -> InlineOption -> ShowS
[InlineOption] -> ShowS
InlineOption -> String
(Int -> InlineOption -> ShowS)
-> (InlineOption -> String)
-> ([InlineOption] -> ShowS)
-> Show InlineOption
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [InlineOption] -> ShowS
$cshowList :: [InlineOption] -> ShowS
show :: InlineOption -> String
$cshow :: InlineOption -> String
showsPrec :: Int -> InlineOption -> ShowS
$cshowsPrec :: Int -> InlineOption -> ShowS
Show, InlineOption -> InlineOption -> Bool
(InlineOption -> InlineOption -> Bool)
-> (InlineOption -> InlineOption -> Bool) -> Eq InlineOption
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: InlineOption -> InlineOption -> Bool
$c/= :: InlineOption -> InlineOption -> Bool
== :: InlineOption -> InlineOption -> Bool
$c== :: InlineOption -> InlineOption -> Bool
Eq)
newtype NumSpaces = NumSpaces Natural
deriving (NumSpaces -> NumSpaces -> Bool
(NumSpaces -> NumSpaces -> Bool)
-> (NumSpaces -> NumSpaces -> Bool) -> Eq NumSpaces
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: NumSpaces -> NumSpaces -> Bool
$c/= :: NumSpaces -> NumSpaces -> Bool
== :: NumSpaces -> NumSpaces -> Bool
$c== :: NumSpaces -> NumSpaces -> Bool
Eq, Int -> NumSpaces -> ShowS
[NumSpaces] -> ShowS
NumSpaces -> String
(Int -> NumSpaces -> ShowS)
-> (NumSpaces -> String)
-> ([NumSpaces] -> ShowS)
-> Show NumSpaces
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [NumSpaces] -> ShowS
$cshowList :: [NumSpaces] -> ShowS
show :: NumSpaces -> String
$cshow :: NumSpaces -> String
showsPrec :: Int -> NumSpaces -> ShowS
$cshowsPrec :: Int -> NumSpaces -> ShowS
Show)
newtype IndentStep = IndentStep Natural
deriving (IndentStep -> IndentStep -> Bool
(IndentStep -> IndentStep -> Bool)
-> (IndentStep -> IndentStep -> Bool) -> Eq IndentStep
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IndentStep -> IndentStep -> Bool
$c/= :: IndentStep -> IndentStep -> Bool
== :: IndentStep -> IndentStep -> Bool
$c== :: IndentStep -> IndentStep -> Bool
Eq, Int -> IndentStep -> ShowS
[IndentStep] -> ShowS
IndentStep -> String
(Int -> IndentStep -> ShowS)
-> (IndentStep -> String)
-> ([IndentStep] -> ShowS)
-> Show IndentStep
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndentStep] -> ShowS
$cshowList :: [IndentStep] -> ShowS
show :: IndentStep -> String
$cshow :: IndentStep -> String
showsPrec :: Int -> IndentStep -> ShowS
$cshowsPrec :: Int -> IndentStep -> ShowS
Show)
simpleEncodePretty
:: Applicative f
=> InlineOption
-> IndentStep
-> NumSpaces
-> Encoder f a
-> a
-> f LT.Text
simpleEncodePretty :: InlineOption
-> IndentStep -> NumSpaces -> Encoder f a -> a -> f Text
simpleEncodePretty InlineOption
io IndentStep
step NumSpaces
ind Encoder f a
enc =
(Json -> Text) -> f Json -> f Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Builder -> Text
TB.toLazyText (Builder -> Text) -> (Json -> Builder) -> Json -> Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Builder Text Builder -> WS -> Builder)
-> Builder Text Builder -> Json -> Builder
forall t b.
(IsString t, Monoid b) =>
(Builder t b -> WS -> b) -> Builder t b -> Json -> b
waargonautBuilder Builder Text Builder -> WS -> Builder
forall b t. Monoid b => Builder t b -> WS -> b
wsBuilder Builder Text Builder
textBuilder (Json -> Builder) -> (Json -> Json) -> Json -> Builder
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. InlineOption -> IndentStep -> NumSpaces -> Json -> Json
prettyJson InlineOption
io IndentStep
step NumSpaces
ind)
(f Json -> f Text) -> (a -> f Json) -> a -> f Text
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Encoder f a -> a -> f Json
forall (f :: * -> *) i a.
Functor f =>
EncoderFns i f a -> a -> f Json
runEncoder Encoder f a
enc
objelems :: AsJType r WS a => Traversal' r (Elems WS (JAssoc WS a))
objelems :: Traversal' r (Elems WS (JAssoc WS a))
objelems = ((JObject WS a, WS) -> f (JObject WS a, WS)) -> r -> f r
forall r ws a. AsJType r ws a => Prism' r (JObject ws a, ws)
_JObj (((JObject WS a, WS) -> f (JObject WS a, WS)) -> r -> f r)
-> ((Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> (JObject WS a, WS) -> f (JObject WS a, WS))
-> (Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> r
-> f r
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JObject WS a -> f (JObject WS a))
-> (JObject WS a, WS) -> f (JObject WS a, WS)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JObject WS a -> f (JObject WS a))
-> (JObject WS a, WS) -> f (JObject WS a, WS))
-> ((Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> JObject WS a -> f (JObject WS a))
-> (Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> (JObject WS a, WS)
-> f (JObject WS a, WS)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CommaSeparated WS (JAssoc WS a)
-> f (CommaSeparated WS (JAssoc WS a)))
-> JObject WS a -> f (JObject WS a)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((CommaSeparated WS (JAssoc WS a)
-> f (CommaSeparated WS (JAssoc WS a)))
-> JObject WS a -> f (JObject WS a))
-> ((Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> CommaSeparated WS (JAssoc WS a)
-> f (CommaSeparated WS (JAssoc WS a)))
-> (Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> JObject WS a
-> f (JObject WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((WS, Maybe (Elems WS (JAssoc WS a)))
-> f (WS, Maybe (Elems WS (JAssoc WS a))))
-> CommaSeparated WS (JAssoc WS a)
-> f (CommaSeparated WS (JAssoc WS a))
forall ws a ws' b.
Iso
(CommaSeparated ws a)
(CommaSeparated ws' b)
(ws, Maybe (Elems ws a))
(ws', Maybe (Elems ws' b))
CS._CommaSeparated (((WS, Maybe (Elems WS (JAssoc WS a)))
-> f (WS, Maybe (Elems WS (JAssoc WS a))))
-> CommaSeparated WS (JAssoc WS a)
-> f (CommaSeparated WS (JAssoc WS a)))
-> ((Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> (WS, Maybe (Elems WS (JAssoc WS a)))
-> f (WS, Maybe (Elems WS (JAssoc WS a))))
-> (Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> CommaSeparated WS (JAssoc WS a)
-> f (CommaSeparated WS (JAssoc WS a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (Elems WS (JAssoc WS a))
-> f (Maybe (Elems WS (JAssoc WS a))))
-> (WS, Maybe (Elems WS (JAssoc WS a)))
-> f (WS, Maybe (Elems WS (JAssoc WS a)))
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Maybe (Elems WS (JAssoc WS a))
-> f (Maybe (Elems WS (JAssoc WS a))))
-> (WS, Maybe (Elems WS (JAssoc WS a)))
-> f (WS, Maybe (Elems WS (JAssoc WS a))))
-> ((Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> Maybe (Elems WS (JAssoc WS a))
-> f (Maybe (Elems WS (JAssoc WS a))))
-> (Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> (WS, Maybe (Elems WS (JAssoc WS a)))
-> f (WS, Maybe (Elems WS (JAssoc WS a)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Elems WS (JAssoc WS a) -> f (Elems WS (JAssoc WS a)))
-> Maybe (Elems WS (JAssoc WS a))
-> f (Maybe (Elems WS (JAssoc WS a)))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just
immediateTrailingWS :: Traversal' Json WS
immediateTrailingWS :: (WS -> f WS) -> Json -> f Json
immediateTrailingWS WS -> f WS
f = LensLike f Json Json (JType WS Json) (JType WS Json)
-> LensLike f Json Json (JType WS Json) (JType WS Json)
forall (f :: * -> *) s t a b.
LensLike f s t a b -> LensLike f s t a b
traverseOf LensLike f Json Json (JType WS Json) (JType WS Json)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped LensLike f Json Json (JType WS Json) (JType WS Json)
-> LensLike f Json Json (JType WS Json) (JType WS Json)
forall a b. (a -> b) -> a -> b
$ \case
JNull WS
ws -> WS -> JType WS Json
forall ws a. ws -> JType ws a
JNull (WS -> JType WS Json) -> f WS -> f (JType WS Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> f WS
f WS
ws
JBool Bool
b WS
ws -> Bool -> WS -> JType WS Json
forall ws a. Bool -> ws -> JType ws a
JBool Bool
b (WS -> JType WS Json) -> f WS -> f (JType WS Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> f WS
f WS
ws
JNum JNumber
n WS
ws -> JNumber -> WS -> JType WS Json
forall ws a. JNumber -> ws -> JType ws a
JNum JNumber
n (WS -> JType WS Json) -> f WS -> f (JType WS Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> f WS
f WS
ws
JStr JString
s WS
ws -> JString -> WS -> JType WS Json
forall ws a. JString -> ws -> JType ws a
JStr JString
s (WS -> JType WS Json) -> f WS -> f (JType WS Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> f WS
f WS
ws
JArr JArray WS Json
a WS
ws -> JArray WS Json -> WS -> JType WS Json
forall ws a. JArray ws a -> ws -> JType ws a
JArr JArray WS Json
a (WS -> JType WS Json) -> f WS -> f (JType WS Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> f WS
f WS
ws
JObj JObject WS Json
o WS
ws -> JObject WS Json -> WS -> JType WS Json
forall ws a. JObject ws a -> ws -> JType ws a
JObj JObject WS Json
o (WS -> JType WS Json) -> f WS -> f (JType WS Json)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> WS -> f WS
f WS
ws
prettyCommaSep
:: L.Traversal' b (CS.CommaSeparated WS a)
-> L.Traversal' a Json
-> Bool
-> Natural
-> Natural
-> b
-> b
prettyCommaSep :: Traversal' b (CommaSeparated WS a)
-> Traversal' a Json -> Bool -> Natural -> Natural -> b -> b
prettyCommaSep Traversal' b (CommaSeparated WS a)
csWrapper Traversal' a Json
nested Bool
inline Natural
step Natural
w =
b -> b
setheadleadingws (b -> b) -> (b -> b) -> b -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. b -> b
stepaftercomma
where
spaces :: Natural -> Vector Whitespace
spaces Natural
x = Int -> Whitespace -> Vector Whitespace
forall a. Int -> a -> Vector a
V.replicate (Tagged Natural (Identity Natural) -> Tagged Int (Identity Int)
forall a. AsNatural a => Prism' a Natural
_Natural (Tagged Natural (Identity Natural) -> Tagged Int (Identity Int))
-> Natural -> Int
forall t b. AReview t b -> b -> t
L.# Natural
x) Whitespace
Space
ws' :: Natural -> WS
ws' Natural
x = (WS -> WS) -> (WS -> WS) -> Bool -> WS -> WS
forall a. a -> a -> Bool -> a
bool (Vector Whitespace -> WS
WS (Whitespace -> Vector Whitespace
forall a. a -> Vector a
V.singleton Whitespace
NewLine) WS -> WS -> WS
forall a. Semigroup a => a -> a -> a
<>) WS -> WS
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id Bool
inline (WS -> WS) -> WS -> WS
forall a b. (a -> b) -> a -> b
$ Vector Whitespace -> WS
WS (Natural -> Vector Whitespace
spaces Natural
x)
i :: WS
i = Natural -> WS
ws' (Natural -> Natural -> Bool -> Natural
forall a. a -> a -> Bool -> a
bool Natural
w (Natural -> Natural
successor' Natural
zero') Bool
inline)
l :: WS
l = WS -> WS -> Bool -> WS
forall a. a -> a -> Bool -> a
bool (Natural -> WS
ws' (Natural
w Natural -> Natural -> Natural
`minus` Natural
step)) WS
i Bool
inline
setheadleadingws :: b -> b
setheadleadingws = (CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> b -> Identity b
Traversal' b (CommaSeparated WS a)
csWrapper ((CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> b -> Identity b)
-> ((WS -> Identity WS)
-> CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> (WS -> Identity WS)
-> b
-> Identity b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> CommaSeparated WS a -> Identity (CommaSeparated WS a)
forall ws a ws' b.
Iso
(CommaSeparated ws a)
(CommaSeparated ws' b)
(ws, Maybe (Elems ws a))
(ws', Maybe (Elems ws' b))
CS._CommaSeparated (((WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> ((WS -> Identity WS)
-> (WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> (WS -> Identity WS)
-> CommaSeparated WS a
-> Identity (CommaSeparated WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (WS -> Identity WS)
-> (WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a))
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((WS -> Identity WS) -> b -> Identity b) -> WS -> b -> b
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WS
i
stepaftercomma :: b -> b
stepaftercomma = (CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> b -> Identity b
Traversal' b (CommaSeparated WS a)
csWrapper ((CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> b -> Identity b)
-> ((Elems WS a -> Identity (Elems WS a))
-> CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> (Elems WS a -> Identity (Elems WS a))
-> b
-> Identity b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> CommaSeparated WS a -> Identity (CommaSeparated WS a)
forall ws a ws' b.
Iso
(CommaSeparated ws a)
(CommaSeparated ws' b)
(ws, Maybe (Elems ws a))
(ws', Maybe (Elems ws' b))
CS._CommaSeparated (((WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> CommaSeparated WS a -> Identity (CommaSeparated WS a))
-> ((Elems WS a -> Identity (Elems WS a))
-> (WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> (Elems WS a -> Identity (Elems WS a))
-> CommaSeparated WS a
-> Identity (CommaSeparated WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (Elems WS a) -> Identity (Maybe (Elems WS a)))
-> (WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a))
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((Maybe (Elems WS a) -> Identity (Maybe (Elems WS a)))
-> (WS, Maybe (Elems WS a)) -> Identity (WS, Maybe (Elems WS a)))
-> ((Elems WS a -> Identity (Elems WS a))
-> Maybe (Elems WS a) -> Identity (Maybe (Elems WS a)))
-> (Elems WS a -> Identity (Elems WS a))
-> (WS, Maybe (Elems WS a))
-> Identity (WS, Maybe (Elems WS a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Elems WS a -> Identity (Elems WS a))
-> Maybe (Elems WS a) -> Identity (Maybe (Elems WS a))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just ((Elems WS a -> Identity (Elems WS a)) -> b -> Identity b)
-> (Elems WS a -> Elems WS a) -> b -> b
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~ \Elems WS a
es -> Elems WS a
es
Elems WS a -> (Elems WS a -> Elems WS a) -> Elems WS a
forall a b. a -> (a -> b) -> b
L.& (Vector (Elem Identity WS a)
-> Identity (Vector (Elem Identity WS a)))
-> Elems WS a -> Identity (Elems WS a)
forall c ws a.
HasElems c ws a =>
Lens' c (Vector (Elem Identity ws a))
CS.elemsElems ((Vector (Elem Identity WS a)
-> Identity (Vector (Elem Identity WS a)))
-> Elems WS a -> Identity (Elems WS a))
-> ((WS -> Identity WS)
-> Vector (Elem Identity WS a)
-> Identity (Vector (Elem Identity WS a)))
-> (WS -> Identity WS)
-> Elems WS a
-> Identity (Elems WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Elem Identity WS a -> Identity (Elem Identity WS a))
-> Vector (Elem Identity WS a)
-> Identity (Vector (Elem Identity WS a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Elem Identity WS a -> Identity (Elem Identity WS a))
-> Vector (Elem Identity WS a)
-> Identity (Vector (Elem Identity WS a)))
-> ((WS -> Identity WS)
-> Elem Identity WS a -> Identity (Elem Identity WS a))
-> (WS -> Identity WS)
-> Vector (Elem Identity WS a)
-> Identity (Vector (Elem Identity WS a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Identity (Comma, WS) -> Identity (Identity (Comma, WS)))
-> Elem Identity WS a -> Identity (Elem Identity WS a)
forall c (f :: * -> *) ws a.
HasElem c f ws a =>
Lens' c (f (Comma, ws))
CS.elemTrailing ((Identity (Comma, WS) -> Identity (Identity (Comma, WS)))
-> Elem Identity WS a -> Identity (Elem Identity WS a))
-> ((WS -> Identity WS)
-> Identity (Comma, WS) -> Identity (Identity (Comma, WS)))
-> (WS -> Identity WS)
-> Elem Identity WS a
-> Identity (Elem Identity WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Comma, WS) -> Identity (Comma, WS))
-> Identity (Comma, WS) -> Identity (Identity (Comma, WS))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (((Comma, WS) -> Identity (Comma, WS))
-> Identity (Comma, WS) -> Identity (Identity (Comma, WS)))
-> ((WS -> Identity WS) -> (Comma, WS) -> Identity (Comma, WS))
-> (WS -> Identity WS)
-> Identity (Comma, WS)
-> Identity (Identity (Comma, WS))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (WS -> Identity WS) -> (Comma, WS) -> Identity (Comma, WS)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((WS -> Identity WS) -> Elems WS a -> Identity (Elems WS a))
-> WS -> Elems WS a -> Elems WS a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WS
i
Elems WS a -> (Elems WS a -> Elems WS a) -> Elems WS a
forall a b. a -> (a -> b) -> b
L.& (Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> Elems WS a -> Identity (Elems WS a)
forall c ws a. HasElems c ws a => Lens' c (Elem Maybe ws a)
CS.elemsLast ((Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> Elems WS a -> Identity (Elems WS a))
-> ((WS -> Identity WS)
-> Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> (WS -> Identity WS)
-> Elems WS a
-> Identity (Elems WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Maybe (Comma, WS) -> Identity (Maybe (Comma, WS)))
-> Elem Maybe WS a -> Identity (Elem Maybe WS a)
forall c (f :: * -> *) ws a.
HasElem c f ws a =>
Lens' c (f (Comma, ws))
CS.elemTrailing ((Maybe (Comma, WS) -> Identity (Maybe (Comma, WS)))
-> Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> ((WS -> Identity WS)
-> Maybe (Comma, WS) -> Identity (Maybe (Comma, WS)))
-> (WS -> Identity WS)
-> Elem Maybe WS a
-> Identity (Elem Maybe WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ((Comma, WS) -> Identity (Comma, WS))
-> Maybe (Comma, WS) -> Identity (Maybe (Comma, WS))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just (((Comma, WS) -> Identity (Comma, WS))
-> Maybe (Comma, WS) -> Identity (Maybe (Comma, WS)))
-> ((WS -> Identity WS) -> (Comma, WS) -> Identity (Comma, WS))
-> (WS -> Identity WS)
-> Maybe (Comma, WS)
-> Identity (Maybe (Comma, WS))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (WS -> Identity WS) -> (Comma, WS) -> Identity (Comma, WS)
forall s t a b. Field2 s t a b => Lens s t a b
_2 ((WS -> Identity WS) -> Elems WS a -> Identity (Elems WS a))
-> WS -> Elems WS a -> Elems WS a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WS
l
Elems WS a -> (Elems WS a -> Elems WS a) -> Elems WS a
forall a b. a -> (a -> b) -> b
L.& (Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> Elems WS a -> Identity (Elems WS a)
forall c ws a. HasElems c ws a => Lens' c (Elem Maybe ws a)
CS.elemsLast ((Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> Elems WS a -> Identity (Elems WS a))
-> ((WS -> Identity WS)
-> Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> (WS -> Identity WS)
-> Elems WS a
-> Identity (Elems WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (a -> Identity a) -> Elem Maybe WS a -> Identity (Elem Maybe WS a)
forall c (f :: * -> *) ws a. HasElem c f ws a => Lens' c a
CS.elemVal ((a -> Identity a)
-> Elem Maybe WS a -> Identity (Elem Maybe WS a))
-> ((WS -> Identity WS) -> a -> Identity a)
-> (WS -> Identity WS)
-> Elem Maybe WS a
-> Identity (Elem Maybe WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Json -> Identity Json) -> a -> Identity a
Traversal' a Json
nested ((Json -> Identity Json) -> a -> Identity a)
-> ((WS -> Identity WS) -> Json -> Identity Json)
-> (WS -> Identity WS)
-> a
-> Identity a
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (WS -> Identity WS) -> Json -> Identity Json
Traversal' Json WS
immediateTrailingWS ((WS -> Identity WS) -> Elems WS a -> Identity (Elems WS a))
-> WS -> Elems WS a -> Elems WS a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ WS
l
prettyJson :: InlineOption -> IndentStep -> NumSpaces -> Json -> Json
prettyJson :: InlineOption -> IndentStep -> NumSpaces -> Json -> Json
prettyJson InlineOption
inlineOpt (IndentStep Natural
step) (NumSpaces Natural
w) = ASetter Json Json Json Json -> (Json -> Json) -> Json -> Json
forall a b. ASetter a b a b -> (b -> b) -> a -> b
P.transformOf ASetter Json Json Json Json
Traversal' Json Json
jsonTraversal (
Traversal' Json (CommaSeparated WS Json)
-> Traversal' Json Json
-> Bool
-> Natural
-> Natural
-> Json
-> Json
forall b a.
Traversal' b (CommaSeparated WS a)
-> Traversal' a Json -> Bool -> Natural -> Natural -> b -> b
prettyCommaSep (((JArray WS Json, WS) -> f (JArray WS Json, WS)) -> Json -> f Json
forall r ws a. AsJType r ws a => Prism' r (JArray ws a, ws)
_JArr (((JArray WS Json, WS) -> f (JArray WS Json, WS))
-> Json -> f Json)
-> ((CommaSeparated WS Json -> f (CommaSeparated WS Json))
-> (JArray WS Json, WS) -> f (JArray WS Json, WS))
-> (CommaSeparated WS Json -> f (CommaSeparated WS Json))
-> Json
-> f Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JArray WS Json -> f (JArray WS Json))
-> (JArray WS Json, WS) -> f (JArray WS Json, WS)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JArray WS Json -> f (JArray WS Json))
-> (JArray WS Json, WS) -> f (JArray WS Json, WS))
-> ((CommaSeparated WS Json -> f (CommaSeparated WS Json))
-> JArray WS Json -> f (JArray WS Json))
-> (CommaSeparated WS Json -> f (CommaSeparated WS Json))
-> (JArray WS Json, WS)
-> f (JArray WS Json, WS)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CommaSeparated WS Json -> f (CommaSeparated WS Json))
-> JArray WS Json -> f (JArray WS Json)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped) forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
Traversal' Json Json
id Bool
inlineArr Natural
step Natural
w (Json -> Json) -> (Json -> Json) -> Json -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Traversal' Json (CommaSeparated WS (JAssoc WS Json))
-> Traversal' (JAssoc WS Json) Json
-> Bool
-> Natural
-> Natural
-> Json
-> Json
forall b a.
Traversal' b (CommaSeparated WS a)
-> Traversal' a Json -> Bool -> Natural -> Natural -> b -> b
prettyCommaSep (((JObject WS Json, WS) -> f (JObject WS Json, WS))
-> Json -> f Json
forall r ws a. AsJType r ws a => Prism' r (JObject ws a, ws)
_JObj (((JObject WS Json, WS) -> f (JObject WS Json, WS))
-> Json -> f Json)
-> ((CommaSeparated WS (JAssoc WS Json)
-> f (CommaSeparated WS (JAssoc WS Json)))
-> (JObject WS Json, WS) -> f (JObject WS Json, WS))
-> (CommaSeparated WS (JAssoc WS Json)
-> f (CommaSeparated WS (JAssoc WS Json)))
-> Json
-> f Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JObject WS Json -> f (JObject WS Json))
-> (JObject WS Json, WS) -> f (JObject WS Json, WS)
forall s t a b. Field1 s t a b => Lens s t a b
_1 ((JObject WS Json -> f (JObject WS Json))
-> (JObject WS Json, WS) -> f (JObject WS Json, WS))
-> ((CommaSeparated WS (JAssoc WS Json)
-> f (CommaSeparated WS (JAssoc WS Json)))
-> JObject WS Json -> f (JObject WS Json))
-> (CommaSeparated WS (JAssoc WS Json)
-> f (CommaSeparated WS (JAssoc WS Json)))
-> (JObject WS Json, WS)
-> f (JObject WS Json, WS)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (CommaSeparated WS (JAssoc WS Json)
-> f (CommaSeparated WS (JAssoc WS Json)))
-> JObject WS Json -> f (JObject WS Json)
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped) forall c ws a. HasJAssoc c ws a => Lens' c a
Traversal' (JAssoc WS Json) Json
jsonAssocVal Bool
inlineObj Natural
step Natural
w (Json -> Json) -> (Json -> Json) -> Json -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Json -> Json
setnested (Json -> Json) -> (Json -> Json) -> Json -> Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.
Json -> Json
forall s a a. (AsJType s WS a, AsJType s WS a) => s -> s
alignafterkey
)
where
inlineArr :: Bool
inlineArr = InlineOption
inlineOpt InlineOption -> [InlineOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InlineOption
ArrayOnly, InlineOption
Both]
inlineObj :: Bool
inlineObj = InlineOption
inlineOpt InlineOption -> [InlineOption] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [InlineOption
ObjectOnly, InlineOption
Both]
spaces :: Int -> Vector Whitespace
spaces Int
x = Int -> Whitespace -> Vector Whitespace
forall a. Int -> a -> Vector a
V.replicate Int
x Whitespace
Space
alignafterkey :: s -> s
alignafterkey s
j = ASetter s s (JAssoc WS a) (JAssoc WS a)
-> (JAssoc WS a -> JAssoc WS a) -> s -> s
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
over ((Elems WS (JAssoc WS a) -> Identity (Elems WS (JAssoc WS a)))
-> s -> Identity s
forall r a. AsJType r WS a => Traversal' r (Elems WS (JAssoc WS a))
objelems ((Elems WS (JAssoc WS a) -> Identity (Elems WS (JAssoc WS a)))
-> s -> Identity s)
-> ((JAssoc WS a -> Identity (JAssoc WS a))
-> Elems WS (JAssoc WS a) -> Identity (Elems WS (JAssoc WS a)))
-> ASetter s s (JAssoc WS a) (JAssoc WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JAssoc WS a -> Identity (JAssoc WS a))
-> Elems WS (JAssoc WS a) -> Identity (Elems WS (JAssoc WS a))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse) (\JAssoc WS a
ja ->
let
kl :: Int
kl = JAssoc WS a
ja JAssoc WS a -> Getting Int (JAssoc WS a) Int -> Int
forall s a. s -> Getting a s a -> a
L.^. (JString -> Const Int JString)
-> JAssoc WS a -> Const Int (JAssoc WS a)
forall c ws a. HasJAssoc c ws a => Lens' c JString
jsonAssocKey ((JString -> Const Int JString)
-> JAssoc WS a -> Const Int (JAssoc WS a))
-> ((Int -> Const Int Int) -> JString -> Const Int JString)
-> Getting Int (JAssoc WS a) Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Vector (JChar HeXDigit) -> Const Int (Vector (JChar HeXDigit)))
-> JString -> Const Int JString
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Vector (JChar HeXDigit) -> Const Int (Vector (JChar HeXDigit)))
-> JString -> Const Int JString)
-> ((Int -> Const Int Int)
-> Vector (JChar HeXDigit) -> Const Int (Vector (JChar HeXDigit)))
-> (Int -> Const Int Int)
-> JString
-> Const Int JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Vector (JChar HeXDigit) -> Int)
-> (Int -> Const Int Int)
-> Vector (JChar HeXDigit)
-> Const Int (Vector (JChar HeXDigit))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to Vector (JChar HeXDigit) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length
in
JAssoc WS a
ja JAssoc WS a -> (JAssoc WS a -> JAssoc WS a) -> JAssoc WS a
forall a b. a -> (a -> b) -> b
L.& (WS -> Identity WS) -> JAssoc WS a -> Identity (JAssoc WS a)
forall c ws a. HasJAssoc c ws a => Lens' c ws
jsonAssocValPreceedingWS ((WS -> Identity WS) -> JAssoc WS a -> Identity (JAssoc WS a))
-> WS -> JAssoc WS a -> JAssoc WS a
forall s t a b. ASetter s t a b -> b -> s -> t
.~ (Vector Whitespace -> WS
WS (Vector Whitespace -> WS)
-> (Int -> Vector Whitespace) -> Int -> WS
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int -> Vector Whitespace
spaces (Int -> WS) -> Int -> WS
forall a b. (a -> b) -> a -> b
$ Int
longestKey Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
kl)
) s
j
where
longestKey :: Int
longestKey = Int -> (Int -> Int) -> Maybe Int -> Int
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Int
1 (Int -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1) (Maybe Int -> Int) -> Maybe Int -> Int
forall a b. (a -> b) -> a -> b
$ Getting (Endo (Endo (Maybe Int))) s Int -> s -> Maybe Int
forall a s.
Ord a =>
Getting (Endo (Endo (Maybe a))) s a -> s -> Maybe a
L.maximumOf ((Elems WS (JAssoc WS a)
-> Const (Endo (Endo (Maybe Int))) (Elems WS (JAssoc WS a)))
-> s -> Const (Endo (Endo (Maybe Int))) s
forall r a. AsJType r WS a => Traversal' r (Elems WS (JAssoc WS a))
objelems ((Elems WS (JAssoc WS a)
-> Const (Endo (Endo (Maybe Int))) (Elems WS (JAssoc WS a)))
-> s -> Const (Endo (Endo (Maybe Int))) s)
-> ((Int -> Const (Endo (Endo (Maybe Int))) Int)
-> Elems WS (JAssoc WS a)
-> Const (Endo (Endo (Maybe Int))) (Elems WS (JAssoc WS a)))
-> Getting (Endo (Endo (Maybe Int))) s Int
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JAssoc WS a -> Const (Endo (Endo (Maybe Int))) (JAssoc WS a))
-> Elems WS (JAssoc WS a)
-> Const (Endo (Endo (Maybe Int))) (Elems WS (JAssoc WS a))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
L.folded ((JAssoc WS a -> Const (Endo (Endo (Maybe Int))) (JAssoc WS a))
-> Elems WS (JAssoc WS a)
-> Const (Endo (Endo (Maybe Int))) (Elems WS (JAssoc WS a)))
-> ((Int -> Const (Endo (Endo (Maybe Int))) Int)
-> JAssoc WS a -> Const (Endo (Endo (Maybe Int))) (JAssoc WS a))
-> (Int -> Const (Endo (Endo (Maybe Int))) Int)
-> Elems WS (JAssoc WS a)
-> Const (Endo (Endo (Maybe Int))) (Elems WS (JAssoc WS a))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JString -> Const (Endo (Endo (Maybe Int))) JString)
-> JAssoc WS a -> Const (Endo (Endo (Maybe Int))) (JAssoc WS a)
forall c ws a. HasJAssoc c ws a => Lens' c JString
jsonAssocKey ((JString -> Const (Endo (Endo (Maybe Int))) JString)
-> JAssoc WS a -> Const (Endo (Endo (Maybe Int))) (JAssoc WS a))
-> ((Int -> Const (Endo (Endo (Maybe Int))) Int)
-> JString -> Const (Endo (Endo (Maybe Int))) JString)
-> (Int -> Const (Endo (Endo (Maybe Int))) Int)
-> JAssoc WS a
-> Const (Endo (Endo (Maybe Int))) (JAssoc WS a)
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Vector (JChar HeXDigit)
-> Const (Endo (Endo (Maybe Int))) (Vector (JChar HeXDigit)))
-> JString -> Const (Endo (Endo (Maybe Int))) JString
forall s t. Rewrapping s t => Iso s t (Unwrapped s) (Unwrapped t)
_Wrapped ((Vector (JChar HeXDigit)
-> Const (Endo (Endo (Maybe Int))) (Vector (JChar HeXDigit)))
-> JString -> Const (Endo (Endo (Maybe Int))) JString)
-> ((Int -> Const (Endo (Endo (Maybe Int))) Int)
-> Vector (JChar HeXDigit)
-> Const (Endo (Endo (Maybe Int))) (Vector (JChar HeXDigit)))
-> (Int -> Const (Endo (Endo (Maybe Int))) Int)
-> JString
-> Const (Endo (Endo (Maybe Int))) JString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Vector (JChar HeXDigit) -> Int)
-> (Int -> Const (Endo (Endo (Maybe Int))) Int)
-> Vector (JChar HeXDigit)
-> Const (Endo (Endo (Maybe Int))) (Vector (JChar HeXDigit))
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
L.to Vector (JChar HeXDigit) -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length) s
j
setnested :: Json -> Json
setnested = (Elems WS (JAssoc WS Json) -> Identity (Elems WS (JAssoc WS Json)))
-> Json -> Identity Json
forall r a. AsJType r WS a => Traversal' r (Elems WS (JAssoc WS a))
objelems ((Elems WS (JAssoc WS Json)
-> Identity (Elems WS (JAssoc WS Json)))
-> Json -> Identity Json)
-> ((Json -> Identity Json)
-> Elems WS (JAssoc WS Json)
-> Identity (Elems WS (JAssoc WS Json)))
-> ASetter Json Json Json Json
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (JAssoc WS Json -> Identity (JAssoc WS Json))
-> Elems WS (JAssoc WS Json)
-> Identity (Elems WS (JAssoc WS Json))
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((JAssoc WS Json -> Identity (JAssoc WS Json))
-> Elems WS (JAssoc WS Json)
-> Identity (Elems WS (JAssoc WS Json)))
-> ((Json -> Identity Json)
-> JAssoc WS Json -> Identity (JAssoc WS Json))
-> (Json -> Identity Json)
-> Elems WS (JAssoc WS Json)
-> Identity (Elems WS (JAssoc WS Json))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. (Json -> Identity Json)
-> JAssoc WS Json -> Identity (JAssoc WS Json)
forall c ws a. HasJAssoc c ws a => Lens' c a
jsonAssocVal ASetter Json Json Json Json -> (Json -> Json) -> Json -> Json
forall s t a b. ASetter s t a b -> (a -> b) -> s -> t
%~
InlineOption -> IndentStep -> NumSpaces -> Json -> Json
prettyJson InlineOption
inlineOpt (Natural -> IndentStep
IndentStep Natural
step) (Natural -> NumSpaces
NumSpaces (Natural -> NumSpaces) -> Natural -> NumSpaces
forall a b. (a -> b) -> a -> b
$ Natural
w Natural -> Natural -> Natural
forall a. Semigroup a => a -> a -> a
<> Natural
step)