module Data.Aeson.OneLine
    ( renderValue
    , renderObject
    , renderArray
    ) where

-- aeson
import qualified Data.Aeson.Text        as Aeson
import qualified Data.Aeson.Types       as Aeson

-- base
import qualified Data.Foldable          as Foldable
import           Prelude                hiding ((+))
import           Data.List              (sort)

-- text
import           Data.Text              (Text)
import qualified Data.Text              as Text
import qualified Data.Text.Lazy         as LText
import qualified Data.Text.Lazy.Builder as LText

-- unordered-containers
import qualified Data.HashMap.Lazy      as HashMap

(+) :: Text -> Text -> Text
+ :: Text -> Text -> Text
(+) = Text -> Text -> Text
Text.append

commaSeparate :: [Text] -> Text
commaSeparate :: [Text] -> Text
commaSeparate = Text -> [Text] -> Text
Text.intercalate (String -> Text
Text.pack String
", ")

-- | Show an aeson value is a one-line format with a single
-- space after each comma and colon, which should be suitable
-- for human reading as long as the value isn't too large.
--
-- >>> import Data.Aeson
--
-- >>> :{
-- >>> val = object [ Text.pack "name" .= Text.pack "Alonzo"
-- >>>              , Text.pack "age" .= 3 ]
-- >>> :}
--
-- >>> (putStrLn . Text.unpack . renderValue) val
-- {"age": 3, "name": "Alonzo"}

renderValue :: Aeson.Value -> Text
renderValue :: Value -> Text
renderValue Value
val =
    case Value
val of
        -- For objects and arrays, we customize the rendering.
        Aeson.Object Object
x -> Object -> Text
renderObject Object
x
        Aeson.Array  Array
x -> Array -> Text
renderArray Array
x

        -- For the rest of the constructors, we
        -- render the value just like Aeson does.
        Value
x              -> Value -> Text
renderTerse Value
x

-- | Show an aeson value the way the aeson library does it, in a
-- terse style not intended for human reading.

renderTerse :: Aeson.Value -> Text
renderTerse :: Value -> Text
renderTerse =
    Text -> Text
LText.toStrict (Text -> Text) -> (Value -> Text) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> Text
LText.toLazyText (Builder -> Text) -> (Value -> Builder) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Builder
forall a. ToJSON a => a -> Builder
Aeson.encodeToTextBuilder

renderObject :: Aeson.Object -> Text
renderObject :: Object -> Text
renderObject Object
obj =
    String -> Text
Text.pack String
"{" Text -> Text -> Text
+ Text
x Text -> Text -> Text
+ String -> Text
Text.pack String
"}"
    where
        x :: Text
x = [Text] -> Text
commaSeparate ((Text, Value) -> Text
f ((Text, Value) -> Text) -> [(Text, Value)] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Text, Value)] -> [(Text, Value)]
forall a. Ord a => [a] -> [a]
sort (Object -> [(Text, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList Object
obj))
        f :: (Text, Value) -> Text
f (Text
k, Value
v) = Value -> Text
renderTerse (Text -> Value
Aeson.String Text
k) Text -> Text -> Text
+
                   String -> Text
Text.pack String
": " Text -> Text -> Text
+ Value -> Text
renderValue Value
v

renderArray :: Aeson.Array -> Text
renderArray :: Array -> Text
renderArray Array
arr =
    String -> Text
Text.pack String
"[" Text -> Text -> Text
+ Text
x Text -> Text -> Text
+ String -> Text
Text.pack String
"]"
    where
        x :: Text
x = [Text] -> Text
commaSeparate (Value -> Text
renderValue (Value -> Text) -> [Value] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Array -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
Foldable.toList Array
arr)