{-# LANGUAGE CPP #-} {-# LANGUAGE OverloadedStrings #-} module Test.Hspec.Core.Formatters.Pretty ( pretty2 #ifdef TEST , pretty , recoverString #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 -> [Char] -> [Char] -> ([Char], [Char]) pretty2 Bool unicode [Char] expected [Char] actual = case (Bool -> [Char] -> Maybe [Char] recoverString Bool unicode [Char] expected, Bool -> [Char] -> Maybe [Char] recoverString Bool unicode [Char] actual) of (Just [Char] expected_, Just [Char] actual_) -> ([Char] expected_, [Char] actual_) (Maybe [Char], Maybe [Char]) _ -> case (Bool -> [Char] -> Maybe [Char] pretty Bool unicode [Char] expected, Bool -> [Char] -> Maybe [Char] pretty Bool unicode [Char] actual) of (Just [Char] expected_, Just [Char] actual_) -> ([Char] expected_, [Char] actual_) #if __GLASGOW_HASKELL__ >= 802 (Maybe [Char], Maybe [Char]) _ -> ([Char] expected, [Char] actual) #else _ -> (rec expected, rec actual) where rec = if unicode then urecover else id urecover :: String -> String urecover xs = maybe xs ushow $ readMaybe xs #endif recoverString :: Bool -> String -> Maybe String recoverString :: Bool -> [Char] -> Maybe [Char] recoverString Bool unicode [Char] input = case forall a. Read a => [Char] -> Maybe a readMaybe [Char] input of Just [Char] r | [Char] -> Bool shouldParseBack [Char] r -> forall a. a -> Maybe a Just [Char] r Maybe [Char] _ -> forall a. Maybe a Nothing where shouldParseBack :: [Char] -> Bool shouldParseBack = Bool -> Bool -> Bool (&&) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b <$> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool all Char -> Bool isSafe forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b <*> [Char] -> Bool isMultiLine isMultiLine :: [Char] -> Bool isMultiLine = [Char] -> [[Char]] lines forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> forall (t :: * -> *) a. Foldable t => t a -> Int length forall {k} (cat :: k -> k -> *) (a :: k) (b :: k) (c :: k). Category cat => cat a b -> cat b c -> cat a c >>> (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 forall a b. (a -> b) -> a -> b $ Char -> Bool isControl Char c) Bool -> Bool -> Bool || Char c forall a. Eq a => a -> a -> Bool == Char '\n' pretty :: Bool -> String -> Maybe String pretty :: Bool -> [Char] -> Maybe [Char] pretty Bool unicode = [Char] -> Maybe Expression parseExpression forall (m :: * -> *) a b c. Monad m => (a -> m b) -> (b -> m c) -> a -> m c >=> Expression -> Maybe [Char] render_ where render_ :: Expression -> Maybe String render_ :: Expression -> Maybe [Char] render_ Expression expr = forall (f :: * -> *). Alternative f => Bool -> f () guard (Expression -> Bool shouldParseBack Expression expr) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b >> forall a. a -> Maybe a Just (Bool -> Expression -> [Char] renderExpression Bool unicode Expression expr) shouldParseBack :: Expression -> Bool shouldParseBack :: Expression -> Bool shouldParseBack = Expression -> Bool go where go :: Expression -> Bool go Expression expr = case Expression expr of Literal (String [Char] _) -> Bool True Literal Literal _ -> Bool False Id [Char] _ -> Bool False App (Id [Char] _) Expression e -> Expression -> Bool go Expression e App Expression _ Expression _ -> Bool False Parentheses Expression e -> Expression -> Bool go Expression e Tuple [Expression] xs -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Expression -> Bool go [Expression] xs List [Expression] xs -> forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool any Expression -> Bool go [Expression] xs Record [Char] _ [([Char], Expression)] _ -> Bool True newtype Builder = Builder ShowS instance Monoid Builder where mempty :: Builder mempty = ShowS -> Builder Builder forall a. a -> a id #if MIN_VERSION_base(4,11,0) instance Semigroup Builder where #endif Builder ShowS xs #if MIN_VERSION_base(4,11,0) <> :: Builder -> Builder -> Builder <> #else `mappend` #endif Builder ShowS ys = ShowS -> Builder Builder (ShowS xs forall b c a. (b -> c) -> (a -> b) -> a -> c . ShowS ys) runBuilder :: Builder -> String runBuilder :: Builder -> [Char] runBuilder (Builder ShowS xs) = ShowS xs [Char] "" intercalate :: Builder -> [Builder] -> Builder intercalate :: Builder -> [Builder] -> Builder intercalate Builder x [Builder] xs = forall a. Monoid a => [a] -> a mconcat forall a b. (a -> b) -> a -> b $ forall a. a -> [a] -> [a] intersperse Builder x [Builder] xs shows :: Show a => a -> Builder shows :: forall a. Show a => a -> Builder shows = ShowS -> Builder Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . forall a. Show a => a -> ShowS Show.shows instance IsString Builder where fromString :: [Char] -> Builder fromString = ShowS -> Builder Builder forall b c a. (b -> c) -> (a -> b) -> a -> c . [Char] -> ShowS showString renderExpression :: Bool -> Expression -> String renderExpression :: Bool -> Expression -> [Char] renderExpression Bool unicode = Builder -> [Char] runBuilder forall b c a. (b -> c) -> (a -> b) -> a -> c . Expression -> Builder render where renderLiteral :: Literal -> Builder renderLiteral Literal lit = case Literal lit of Char Char c -> forall a. Show a => a -> Builder shows Char c String [Char] str -> if Bool unicode then ShowS -> Builder Builder forall a b. (a -> b) -> a -> b $ [Char] -> ShowS ushows [Char] str else forall a. Show a => a -> Builder shows [Char] str Integer Integer n -> forall a. Show a => a -> Builder shows Integer n Rational [Char] n -> forall a. IsString a => [Char] -> a fromString [Char] n render :: Expression -> Builder render :: Expression -> Builder render Expression expr = case Expression expr of Literal Literal lit -> Literal -> Builder renderLiteral Literal lit Id [Char] name -> forall a. IsString a => [Char] -> a fromString [Char] name App Expression a Expression b -> Expression -> Builder render Expression a forall a. Semigroup a => a -> a -> a <> Builder " " forall a. Semigroup a => a -> a -> a <> Expression -> Builder render Expression b Parentheses e :: Expression e@Record{} -> Expression -> Builder render Expression e Parentheses Expression e -> Builder "(" forall a. Semigroup a => a -> a -> a <> Expression -> Builder render Expression e forall a. Semigroup a => a -> a -> a <> Builder ")" Tuple [Expression] xs -> Builder "(" forall a. Semigroup a => a -> a -> a <> Builder -> [Builder] -> Builder intercalate Builder ", " (forall a b. (a -> b) -> [a] -> [b] map Expression -> Builder render [Expression] xs) forall a. Semigroup a => a -> a -> a <> Builder ")" List [Expression] xs -> Builder "[" forall a. Semigroup a => a -> a -> a <> Builder -> [Builder] -> Builder intercalate Builder ", " (forall a b. (a -> b) -> [a] -> [b] map Expression -> Builder render [Expression] xs) forall a. Semigroup a => a -> a -> a <> Builder "]" Record [Char] name [([Char], Expression)] fields -> forall a. IsString a => [Char] -> a fromString [Char] name forall a. Semigroup a => a -> a -> a <> Builder " {\n " forall a. Semigroup a => a -> a -> a <> (Builder -> [Builder] -> Builder intercalate Builder ",\n " forall a b. (a -> b) -> a -> b $ forall a b. (a -> b) -> [a] -> [b] map ([Char], Expression) -> Builder renderField [([Char], Expression)] fields) forall a. Semigroup a => a -> a -> a <> Builder "\n}" renderField :: ([Char], Expression) -> Builder renderField ([Char] name, Expression value) = forall a. IsString a => [Char] -> a fromString [Char] name forall a. Semigroup a => a -> a -> a <> Builder " = " forall a. Semigroup a => a -> a -> a <> Expression -> Builder render Expression value