{-# LANGUAGE CPP #-}

module Test.Sandwich.Formatters.Print.Util where

import Control.Monad.Reader
import qualified Data.List as L
import Test.Sandwich.Formatters.Print.Types
import Text.Show.Pretty as P


isSingleLine :: P.Value -> Bool
isSingleLine :: Value -> Bool
isSingleLine (Con {}) = Bool
False
isSingleLine (InfixCons Value
op [(Name, Value)]
tuples) = Value -> Bool
isSingleLine Value
op Bool -> Bool -> Bool
&& (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Value -> Bool
isSingleLine (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd [(Name, Value)]
tuples))
isSingleLine (Rec {}) = Bool
False
isSingleLine (Tuple [Value]
values) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Value -> Bool
isSingleLine [Value]
values
isSingleLine (List [Value]
values) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Value -> Bool
isSingleLine [Value]
values
isSingleLine (Neg Value
value) = Value -> Bool
isSingleLine Value
value
isSingleLine (Ratio Value
v1 Value
v2) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Value -> Bool
isSingleLine [Value
v1, Value
v2]
isSingleLine (String Name
s) = Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.notElem` Name
s

#if MIN_VERSION_pretty_show(1,10,0)
isSingleLine (Quote Name
s) = Char
'\n' forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`L.notElem` Name
s
#endif

isSingleLine Value
_ = Bool
True

withBumpIndent :: m b -> m b
withBumpIndent m b
action = do
  (PrintFormatter {Bool
Int
Maybe LogLevel
printFormatterIndentSize :: PrintFormatter -> Int
printFormatterIncludeCallStacks :: PrintFormatter -> Bool
printFormatterVisibilityThreshold :: PrintFormatter -> Int
printFormatterLogLevel :: PrintFormatter -> Maybe LogLevel
printFormatterUseColor :: PrintFormatter -> Bool
printFormatterIndentSize :: Int
printFormatterIncludeCallStacks :: Bool
printFormatterVisibilityThreshold :: Int
printFormatterLogLevel :: Maybe LogLevel
printFormatterUseColor :: Bool
..}, Int
_, c
_) <- forall r (m :: * -> *). MonadReader r m => m r
ask
  forall {a} {b} {c} {m :: * -> *} {a}.
(MonadReader (a, b, c) m, Num b) =>
b -> m a -> m a
withBumpIndent' Int
printFormatterIndentSize m b
action

withBumpIndent' :: b -> m a -> m a
withBumpIndent' b
n = forall r (m :: * -> *) a. MonadReader r m => (r -> r) -> m a -> m a
local (\(a
pf, b
indent, c
h) -> (a
pf, b
indent forall a. Num a => a -> a -> a
+ b
n, c
h))


fst3 :: (a, b, c) -> a
fst3 (a
x, b
_, c
_) = a
x