{-# 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 JsonToType.Pretty() where

import qualified Data.HashMap.Strict as Hash
import           Data.HashMap.Strict(HashMap)
import           Data.Aeson
import qualified Data.Aeson.KeyMap          as KM
import           JsonToType.Type  (Dict(..), Type)
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 :: forall a b. (Out a, Out b) => (a, b) -> Doc
formatPair (a
a, b
b) = Int -> Doc -> Doc
nest Int
1 (a -> Doc
forall a. Out a => a -> Doc
doc a
a Doc -> Doc -> Doc
<+> Doc
": " Doc -> Doc -> Doc
<+> b -> Doc
forall a. Out a => a -> Doc
doc b
b Doc -> 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 Int
_ = 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 -> Doc
<+> [a] -> Doc
forall a. Out a => a -> Doc
doc [a]
v Doc -> Doc -> Doc
<+> Doc
">"
  docPrec :: Int -> Vector a -> Doc
docPrec Int
_ = 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 -> Doc
<+> [a] -> Doc
forall a. Out a => a -> Doc
doc [a]
s Doc -> Doc -> Doc
<+> Doc
"}"
  docPrec :: Int -> Set a -> Doc
docPrec Int
_                 = 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 b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> 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 Int
1 Doc
"}"
  docPrec :: Int -> HashMap a b -> Doc
docPrec Int
_ = HashMap a b -> Doc
forall a. Out a => a -> Doc
doc

instance (Out v) => Out (KM.KeyMap v) where
  doc :: KeyMap v -> Doc
doc (KeyMap v -> [(Key, v)]
forall v. KeyMap v -> [(Key, v)]
KM.toList -> [(Key, v)]
dict) = (Doc -> Doc -> Doc) -> Doc -> [Doc] -> Doc
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl Doc -> Doc -> Doc
($$) Doc
"{" (((Key, v) -> Doc) -> [(Key, v)] -> [Doc]
forall a b. (a -> b) -> [a] -> [b]
map (Key, v) -> Doc
forall {a} {a}. (Show a, Out a) => (a, a) -> Doc
formatKeyValPair [(Key, v)]
dict) Doc -> Doc -> Doc
$$ Int -> Doc -> Doc
nest Int
1 Doc
"}"
    where
      formatKeyValPair :: (a, a) -> Doc
formatKeyValPair (a
k, a
v) = Int -> Doc -> Doc
nest Int
1 (String -> Doc
forall a. Out a => a -> Doc
doc (a -> String
forall a. Show a => a -> String
show a
k) Doc -> Doc -> Doc
<+> Doc
": " Doc -> Doc -> Doc
<+> a -> Doc
forall a. Out a => a -> Doc
doc a
v Doc -> Doc -> Doc
<+> Doc
",")
  docPrec :: Int -> KeyMap v -> Doc
docPrec Int
_ = KeyMap v -> Doc
forall a. Out a => a -> Doc
doc

instance Out Dict where
  doc :: Dict -> Doc
doc = Map Text Type -> Doc
forall a. Out a => a -> Doc
doc (Map Text Type -> Doc) -> (Dict -> Map Text Type) -> Dict -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Dict -> Map Text Type
unDict

instance Out Type where
  doc :: Type -> Doc
doc = String -> Doc
forall a. Out a => a -> Doc
doc (String -> Doc) -> (Type -> String) -> Type -> Doc
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Type -> String
forall a. Show a => a -> String
show

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 Int
_ = Text -> Doc
forall a. Out a => a -> Doc
doc