{-# LANGUAGE CPP #-}

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 :: forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty (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 (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 (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
  forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
indentFirst Value
v
  forall {a1} {b} {c} {m :: * -> *} {a2}.
(MonadReader (a1, b, c) m, Num b) =>
b -> m a2 -> m a2
withBumpIndent' Int
4 forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
pairs forall a b. (a -> b) -> a -> b
$ \(String
name, Value
val) -> do
      forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
constructorNameColor String
name
      forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
" "
      forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
val
      forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
#endif
printPretty (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 (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 (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 (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 forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic else forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc) Colour Float
recordNameColor String
name
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pcn Colour Float
braceColor String
" {"
  forall {m :: * -> *} {c} {b}.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent forall a b. (a -> b) -> a -> b
$
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [(String, Value)]
tuples forall a b. (a -> b) -> a -> b
$ \(String
name, Value
val) -> do
      forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic Colour Float
fieldNameColor String
name
      forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
" = "
      forall {a1} {b} {c} {m :: * -> *} {a2}.
(MonadReader (a1, b, c) m, Num b) =>
b -> m a2 -> m a2
withBumpIndent' (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
name forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String
" = " :: String)) forall a b. (a -> b) -> a -> b
$ do
        forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
val
        forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  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 forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic else forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc) Colour Float
constructorNameColor (String
name forall a. Semigroup a => a -> a -> a
<> String
" ")
  case [Value]
values of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    (Value
x:[Value]
xs) -> do
      forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
x
      forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
      forall {a1} {b} {c} {m :: * -> *} {a2}.
(MonadReader (a1, b, c) m, Num b) =>
b -> m a2 -> m a2
withBumpIndent' (forall (t :: * -> *) a. Foldable t => t a -> Int
L.length String
name forall a. Num a => a -> a -> a
+ forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (String
" " :: String)) forall a b. (a -> b) -> a -> b
$ do
        forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a. [a] -> [[a]] -> [a]
L.intercalate [forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"] [[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) = 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) = 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
  forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
indentFirst Value
v1
  forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
picn Colour Float
slashColor String
"/"
  forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
True Value
v2
printPretty (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
"-"
  forall {a1} {b} {c} {m :: * -> *} {a2}.
(MonadReader (a1, b, c) m, Num b) =>
b -> m a2 -> m a2
withBumpIndent' Int
1 forall a b. (a -> b) -> a -> b
$
    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) (forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Colour Float -> String -> m ()
getPrintFn -> Colour Float -> String -> m ()
f) [Value]
values | 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
  forall (t :: * -> *) (m :: * -> *) a.
(Foldable t, Monad m) =>
t (m a) -> m ()
sequence_ (forall a. [a] -> [[a]] -> [a]
L.intercalate [forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
", "] [[forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
False Value
v] | Value
v <- [Value]
values])
  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) (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
  forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  forall {m :: * -> *} {c} {b}.
MonadReader (PrintFormatter, Int, c) m =>
m b -> m b
withBumpIndent forall a b. (a -> b) -> a -> b
$ do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [Value]
values forall a b. (a -> b) -> a -> b
$ \Value
v -> do
      forall (m :: * -> *).
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Bool -> Value -> m ()
printPretty Bool
True Value
v
      forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
String -> m ()
p String
"\n"
  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 = forall {m :: * -> *}.
(MonadReader (PrintFormatter, Int, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pic
getPrintFn Bool
False = forall {b} {m :: * -> *}.
(MonadReader (PrintFormatter, b, Handle) m, MonadIO m) =>
Colour Float -> String -> m ()
pc