{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings   #-}
{-# LANGUAGE DeriveGeneric       #-}
{-# LANGUAGE StandaloneDeriving  #-}
{-# LANGUAGE ViewPatterns        #-}
{-# LANGUAGE CPP                 #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}

-- | Instances of @Text.PrettyPrint.Out@ class to visualize
-- Aeson @Value@ data structure.
module Data.Aeson.AutoType.Pretty() where

import qualified Data.HashMap.Strict as Hash
import           Data.HashMap.Strict(HashMap)
import           Data.Aeson
import qualified Data.Text                  as Text
import           Data.Text                 (Text)
import           Data.Set                   as Set(Set, toList)
import           Data.Scientific
import           Data.Vector                as V(Vector, toList)
import           Text.PrettyPrint.GenericPretty
import           Text.PrettyPrint

formatPair :: (Out a, Out b) => (a, b) -> Doc
formatPair :: (a, b) -> Doc
formatPair (a :: a
a, b :: b
b) = Int -> Doc -> Doc
nest 1 (a -> Doc
forall a. Out a => a -> Doc
doc a
a Doc -> Doc -> Doc
<+> ": " Doc -> Doc -> Doc
<+> b -> Doc
forall a. Out a => a -> Doc
doc b
b Doc -> Doc -> Doc
<+> ",")

-- * This is to make prettyprinting possible for Aeson @Value@ type.
instance Out Scientific where
  doc :: Scientific -> Doc
doc = String -> Doc
forall a. Out a => a -> Doc
doc (String -> Doc) -> (Scientific -> String) -> Scientific -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Scientific -> String
forall a. Show a => a -> String
show
  docPrec :: Int -> Scientific -> Doc
docPrec _ = Scientific -> Doc
forall a. Out a => a -> Doc
doc

instance (Out a) => Out (Vector a) where
  doc :: Vector a -> Doc
doc (Vector a -> [a]
forall a. Vector a -> [a]
V.toList -> [a]
v) = "<" Doc -> Doc -> Doc
<+> [a] -> Doc
forall a. Out a => a -> Doc
doc [a]
v Doc -> Doc -> Doc
<+> ">"
  docPrec :: Int -> Vector a -> Doc
docPrec _ = Vector a -> Doc
forall a. Out a => a -> Doc
doc

instance Out Value

instance (Out a) => Out (Set a) where
  doc :: Set a -> Doc
doc     (Set a -> [a]
forall a. Set a -> [a]
Set.toList -> [a]
s) = "{" Doc -> Doc -> Doc
<+> [a] -> Doc
forall a. Out a => a -> Doc
doc [a]
s Doc -> Doc -> Doc
<+> "}"
  docPrec :: Int -> Set a -> Doc
docPrec _                 = Set a -> Doc
forall a. Out a => a -> Doc
doc

instance (Out a, Out b) => Out (HashMap a b) where
  doc :: HashMap a b -> Doc
doc (HashMap a b -> [(a, b)]
forall k v. HashMap k v -> [(k, v)]
Hash.toList -> [(a, b)]
dict) = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
($$) "{" (((a, b) -> Doc) -> [(a, b)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (a, b) -> Doc
forall a b. (Out a, Out b) => (a, b) -> Doc
formatPair [(a, b)]
dict) Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest 1 "}"
  docPrec :: Int -> HashMap a b -> Doc
docPrec _ = HashMap a b -> Doc
forall a. Out a => a -> Doc
doc

instance Out Text where
  doc :: Text -> Doc
doc       = String -> Doc
text (String -> Doc) -> (Text -> String) -> Text -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> String
Text.unpack -- TODO: check if there may be direct way?
  docPrec :: Int -> Text -> Doc
docPrec _ = Text -> Doc
forall a. Out a => a -> Doc
doc