{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE CPP #-}
{-# LANGUAGE ViewPatterns #-}

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

import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Reader
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 :: 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 a1 a2 c (m :: * -> *) a3.
(MonadReader (a1, a2, c) m, Num a2) =>
a2 -> m a3 -> m a3
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 (m :: * -> *) c 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 a1 a2 c (m :: * -> *) a3.
(MonadReader (a1, a2, c) m, Num a2) =>
a2 -> m a3 -> m a3
withBumpIndent' (String -> 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 (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 (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 a1 a2 c (m :: * -> *) a3.
(MonadReader (a1, a2, c) m, Num a2) =>
a2 -> m a3 -> m a3
withBumpIndent' (String -> 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 (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 a1 a2 c (m :: * -> *) a3.
(MonadReader (a1, a2, c) m, Num a2) =>
a2 -> m a3 -> m a3
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 :: (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 (m :: * -> *) c 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 :: 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