{-# LANGUAGE CPP #-}

module Test.Sandwich.Formatters.Print.PrintPretty (
  printPretty
  ) where

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
import Data.Colour
import qualified Data.List as L
import System.IO
import Test.Sandwich.Formatters.Print.Color
import Test.Sandwich.Formatters.Print.Printing
import Test.Sandwich.Formatters.Print.Types
import Test.Sandwich.Formatters.Print.Util
import Text.Show.Pretty as P


printPretty :: (MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) => Bool -> Value -> m ()
#if MIN_VERSION_pretty_show(1,10,0)
printPretty :: forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Quote String
s) = Colour Float -> String -> m ()
f Colour Float
quoteColor String
s
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Time String
s) = Colour Float -> String -> m ()
f Colour Float
timeColor String
s
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Date String
s) = Colour Float -> String -> m ()
f Colour Float
dateColor String
s
printPretty Bool
indentFirst (InfixCons Value
v [(String, Value)]
pairs) = do
  -- TODO: make sure this looks good
  Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
indentFirst Value
v
  Int -> m () -> m ()
forall a c (m :: * -> *) b.
MonadReader (a, Int, c) m =>
Int -> m b -> m b
withBumpIndent' Int
4 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    [(String, Value)] -> ((String, Value) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
pairs (((String, Value) -> m ()) -> m ())
-> ((String, Value) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(String
name, Value
val) -> do
      Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
constructorNameColor String
name
      String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
" "
      Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
val
      String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
#endif
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (String String
s) = Colour Float -> String -> m ()
f Colour Float
stringColor String
s
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Char String
s) = Colour Float -> String -> m ()
f Colour Float
charColor String
s
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Float String
s) = Colour Float -> String -> m ()
f Colour Float
floatColor String
s
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Integer String
s) = Colour Float -> String -> m ()
f Colour Float
integerColor String
s
printPretty Bool
indentFirst (Rec String
name [(String, Value)]
tuples) = do
  (if Bool
indentFirst then Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic else Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc) Colour Float
recordNameColor String
name
  Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pcn Colour Float
braceColor String
" {"
  m () -> m ()
forall c (m :: * -> *) b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    [(String, Value)] -> ((String, Value) -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
tuples (((String, Value) -> m ()) -> m ())
-> ((String, Value) -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \(String
name', Value
val) -> do
      Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
fieldNameColor String
name'
      String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
" = "
      Int -> m () -> m ()
forall a c (m :: * -> *) b.
MonadReader (a, Int, c) m =>
Int -> m b -> m b
withBumpIndent' (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
name' Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String
" = " :: String)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
val
        String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
braceColor String
"}"
printPretty Bool
indentFirst (Con String
name [Value]
values) = do
  (if Bool
indentFirst then Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic else Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc) Colour Float
constructorNameColor (String
name String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
" ")
  case [Value]
values of
    [] -> () -> m ()
forall a. a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Value
x:[Value]
xs) -> do
      Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
x
      String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
      Int -> m () -> m ()
forall a c (m :: * -> *) b.
MonadReader (a, Int, c) m =>
Int -> m b -> m b
withBumpIndent' (String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
name Int -> Int -> Int
forall a. Num a => a -> a -> a
+ String -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String
" " :: String)) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
        [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> [[m ()]] -> [m ()]
forall a. [a] -> [[a]] -> [a]
L.intercalate [String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"] [[Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
True Value
v] | Value
v <- [Value]
xs])
printPretty Bool
indentFirst (List [Value]
values) = (String, String) -> Bool -> [Value] -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
(String, String) -> Bool -> [Value] -> m ()
printListWrappedIn (String
"[", String
"]") Bool
indentFirst [Value]
values
printPretty Bool
indentFirst (Tuple [Value]
values) = (String, String) -> Bool -> [Value] -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
(String, String) -> Bool -> [Value] -> m ()
printListWrappedIn (String
"(", String
")") Bool
indentFirst [Value]
values
printPretty Bool
indentFirst (Ratio Value
v1 Value
v2) = do
  Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
indentFirst Value
v1
  Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
slashColor String
"/"
  Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
True Value
v2
printPretty (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) (Neg Value
s) = do
  Colour Float -> String -> m ()
f Colour Float
negColor String
"-"
  Int -> m () -> m ()
forall a c (m :: * -> *) b.
MonadReader (a, Int, c) m =>
Int -> m b -> m b
withBumpIndent' Int
1 (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$
    Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
s


printListWrappedIn :: (
  MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
  ) => (String, String) -> Bool -> [Value] -> m ()
printListWrappedIn :: forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
(String, String) -> Bool -> [Value] -> m ()
printListWrappedIn (String
begin, String
end) (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) [Value]
values | (Value -> Bool) -> [Value] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Value -> Bool
isSingleLine [Value]
values = do
  Colour Float -> String -> m ()
f Colour Float
listBracketColor String
begin
  [m ()] -> m ()
forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ ([m ()] -> [[m ()]] -> [m ()]
forall a. [a] -> [[a]] -> [a]
L.intercalate [String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
", "] [[Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
v] | Value
v <- [Value]
values])
  Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc Colour Float
listBracketColor String
end
printListWrappedIn (String
begin, String
end) (Bool -> Colour Float -> String -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) [Value]
values = do
  Colour Float -> String -> m ()
f Colour Float
listBracketColor String
begin
  String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  m () -> m ()
forall c (m :: * -> *) b.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    [Value] -> (Value -> m ()) -> m ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value]
values ((Value -> m ()) -> m ()) -> (Value -> m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ \Value
v -> do
      Bool -> Value -> m ()
forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
True Value
v
      String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
listBracketColor String
end

getPrintFn :: (
  MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
  ) => Bool -> Colour Float -> String -> m ()
getPrintFn :: forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn Bool
True = Colour Float -> String -> m ()
forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic
getPrintFn Bool
False = Colour Float -> String -> m ()
forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc