{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Test.Hspec.Core.Formatters.Pretty ( pretty2 #ifdef TEST , pretty , recoverString , recoverMultiLineString #endif ) where import Prelude () import Test.Hspec.Core.Compat hiding (shows, intercalate) import Data.Char import Data.String import Data.List (intersperse) import qualified Text.Show as Show import Test.Hspec.Core.Formatters.Pretty.Unicode import Test.Hspec.Core.Formatters.Pretty.Parser pretty2 :: Bool -> String -> String -> (String, String) pretty2 :: Bool -> String -> String -> (String, String) pretty2 Bool unicode String expected String actual = case (Bool -> String -> Maybe String recoverMultiLineString Bool unicode String expected, Bool -> String -> Maybe String recoverMultiLineString Bool unicode String actual) of (Just String expected_, Just String actual_) -> (String expected_, String actual_) (Maybe String, Maybe String) _ -> case (Bool -> String -> Maybe String pretty Bool unicode String expected, Bool -> String -> Maybe String pretty Bool unicode String actual) of (Just String expected_, Just String actual_) | String expected_ String -> String -> Bool forall a. Eq a => a -> a -> Bool /= String actual_ -> (String expected_, String actual_) (Maybe String, Maybe String) _ -> (String expected, String actual) recoverString :: String -> Maybe String recoverString :: String -> Maybe String recoverString String xs = case String xs of Char '"' : String _ -> case String -> String forall a. [a] -> [a] reverse String xs of Char '"' : String _ -> String -> Maybe String forall a. Read a => String -> Maybe a readMaybe String xs String _ -> Maybe String forall a. Maybe a Nothing String _ -> Maybe String forall a. Maybe a Nothing recoverMultiLineString :: Bool -> String -> Maybe String recoverMultiLineString :: Bool -> String -> Maybe String recoverMultiLineString Bool unicode String input = case String -> Maybe String recoverString String input of Just String r | String -> Bool shouldParseBack String r -> String -> Maybe String forall a. a -> Maybe a Just String r Maybe String _ -> Maybe String forall a. Maybe a Nothing where shouldParseBack :: String -> Bool shouldParseBack = Bool -> Bool -> Bool (&&) (Bool -> Bool -> Bool) -> (String -> Bool) -> String -> Bool -> Bool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> (Char -> Bool) -> String -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Char -> Bool isSafe (String -> Bool -> Bool) -> (String -> Bool) -> String -> Bool forall a b. (String -> a -> b) -> (String -> a) -> String -> b forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> String -> Bool isMultiLine isMultiLine :: String -> Bool isMultiLine = String -> [String] lines (String -> [String]) -> ([String] -> Bool) -> String -> Bool forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> [String] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length ([String] -> Int) -> (Int -> Bool) -> [String] -> Bool forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (Int -> Int -> Bool forall a. Ord a => a -> a -> Bool > Int 1) isSafe :: Char -> Bool isSafe Char c = (Bool unicode Bool -> Bool -> Bool || Char -> Bool isAscii Char c) Bool -> Bool -> Bool && Bool -> Bool not (Char -> Bool isControl Char c) Bool -> Bool -> Bool || Char c Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n' pretty :: Bool -> String -> Maybe String pretty :: Bool -> String -> Maybe String pretty Bool unicode = String -> Maybe Value parseValue (String -> Maybe Value) -> (Value -> Maybe String) -> String -> Maybe String forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> Value -> Maybe String render_ where render_ :: Value -> Maybe String render_ :: Value -> Maybe String render_ Value value = Bool -> Maybe () forall (f :: * -> *). Alternative f => Bool -> f () guard (Value -> Bool shouldParseBack Value value) Maybe () -> Maybe String -> Maybe String forall a b. Maybe a -> Maybe b -> Maybe b forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> String -> Maybe String forall a. a -> Maybe a Just (Bool -> Value -> String renderValue Bool unicode Value value) shouldParseBack :: Value -> Bool shouldParseBack :: Value -> Bool shouldParseBack = Value -> Bool go where go :: Value -> Bool go Value value = case Value value of Char Char _ -> Bool False String String _ -> Bool True Rational Value _ Value _ -> Bool False Number String _ -> Bool False Record String _ [(String, Value)] _ -> Bool True Constructor String _ [Value] xs -> (Value -> Bool) -> [Value] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Value -> Bool go [Value] xs Tuple [Value] xs -> (Value -> Bool) -> [Value] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Value -> Bool go [Value] xs List [Value] xs -> (Value -> Bool) -> [Value] -> Bool forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Value -> Bool go [Value] xs newtype Builder = Builder ShowS instance Monoid Builder where mempty :: Builder mempty = (String -> String) -> Builder Builder String -> String forall a. a -> a id #if MIN_VERSION_base(4,11,0) instance Semigroup Builder where #endif Builder String -> String xs #if MIN_VERSION_base(4,11,0) <> :: Builder -> Builder -> Builder <> #else `mappend` #endif Builder String -> String ys = (String -> String) -> Builder Builder (String -> String xs (String -> String) -> (String -> String) -> String -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String ys) runBuilder :: Builder -> String runBuilder :: Builder -> String runBuilder (Builder String -> String xs) = String -> String xs String "" intercalate :: Builder -> [Builder] -> Builder intercalate :: Builder -> [Builder] -> Builder intercalate Builder x [Builder] xs = [Builder] -> Builder forall a. Monoid a => [a] -> a mconcat ([Builder] -> Builder) -> [Builder] -> Builder forall a b. (a -> b) -> a -> b $ Builder -> [Builder] -> [Builder] forall a. a -> [a] -> [a] intersperse Builder x [Builder] xs shows :: Show a => a -> Builder shows :: forall a. Show a => a -> Builder shows = (String -> String) -> Builder Builder ((String -> String) -> Builder) -> (a -> String -> String) -> a -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String -> String forall a. Show a => a -> String -> String Show.shows instance IsString Builder where fromString :: String -> Builder fromString = (String -> String) -> Builder Builder ((String -> String) -> Builder) -> (String -> String -> String) -> String -> Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . String -> String -> String showString renderValue :: Bool -> Value -> String renderValue :: Bool -> Value -> String renderValue Bool unicode = Builder -> String runBuilder (Builder -> String) -> (Value -> Builder) -> Value -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . Value -> Builder render where render :: Value -> Builder render :: Value -> Builder render Value value = case Value value of Char Char c -> Char -> Builder forall a. Show a => a -> Builder shows Char c String String str -> if Bool unicode then (String -> String) -> Builder Builder ((String -> String) -> Builder) -> (String -> String) -> Builder forall a b. (a -> b) -> a -> b $ String -> String -> String ushows String str else String -> Builder forall a. Show a => a -> Builder shows String str Rational Value n Value d -> Value -> Builder render Value n Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder " % " Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Value -> Builder render Value d Number String n -> String -> Builder forall a. IsString a => String -> a fromString String n Record String name [(String, Value)] fields -> String -> Builder forall a. IsString a => String -> a fromString String name Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder " {\n " Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> (Builder -> [Builder] -> Builder intercalate Builder ",\n " ([Builder] -> Builder) -> [Builder] -> Builder forall a b. (a -> b) -> a -> b $ ((String, Value) -> Builder) -> [(String, Value)] -> [Builder] forall a b. (a -> b) -> [a] -> [b] map (String, Value) -> Builder renderField [(String, Value)] fields) Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder "\n}" Constructor String name [Value] values -> Builder -> [Builder] -> Builder intercalate Builder " " (String -> Builder forall a. IsString a => String -> a fromString String name Builder -> [Builder] -> [Builder] forall a. a -> [a] -> [a] : (Value -> Builder) -> [Value] -> [Builder] forall a b. (a -> b) -> [a] -> [b] map Value -> Builder render [Value] values) Tuple [e :: Value e@Record{}] -> Value -> Builder render Value e Tuple [Value] xs -> Builder "(" Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder -> [Builder] -> Builder intercalate Builder ", " ((Value -> Builder) -> [Value] -> [Builder] forall a b. (a -> b) -> [a] -> [b] map Value -> Builder render [Value] xs) Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder ")" List [Value] xs -> Builder "[" Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder -> [Builder] -> Builder intercalate Builder ", " ((Value -> Builder) -> [Value] -> [Builder] forall a b. (a -> b) -> [a] -> [b] map Value -> Builder render [Value] xs) Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder "]" renderField :: (String, Value) -> Builder renderField (String name, Value value) = String -> Builder forall a. IsString a => String -> a fromString String name Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Builder " = " Builder -> Builder -> Builder forall a. Semigroup a => a -> a -> a <> Value -> Builder render Value value