    {-# LANGUAGE CPP #-}
    {-# LANGUAGE LambdaCase #-}
    {-# 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
              Number String
    _ -> Bool
    False
              Operator Value
    _ String
    _ Value
    _ -> Bool
    True
              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
    . Int -> Value -> Builder
    render Int
    0
      where
        render :: Int -> Value -> Builder
        render :: Int -> Value -> Builder
    render Int
    indentation = \ case
          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
          Number String
    n -> String -> Builder
    forall a. IsString a => String -> a
    fromString String
    n
          Operator Value
    a String
    name Value
    b -> Int -> Value -> Builder
    render Int
    indentation Value
    a Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    " " Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> 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
    <> Int -> Value -> Builder
    render Int
    indentation Value
    b
          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
    <> [(String, Value)] -> Builder
    renderFields [(String, Value)]
    fields
          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 (Int -> Value -> Builder
    render Int
    indentation) [Value]
    values)
          Tuple [e :: Value
    e@Record{}] -> Int -> Value -> Builder
    render Int
    indentation 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 (Int -> Value -> Builder
    render Int
    indentation) [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 (Int -> Value -> Builder
    render Int
    indentation) [Value]
    xs) Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "]"
          where
            spaces :: Builder
            spaces :: Builder
    spaces = Int -> Builder
    indentBy (Int -> Int
    forall a. Enum a => a -> a
    succ Int
    indentation)

            renderFields :: [(String, Value)] -> Builder
            renderFields :: [(String, Value)] -> Builder
    renderFields [(String, Value)]
    fields = [Builder] -> Builder
    forall a. Monoid a => [a] -> a
    mconcat [
                Builder
    " {\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    spaces
              , Builder -> [Builder] -> Builder
    intercalate (Builder
    ",\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    spaces) ([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
    "\n" Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Int -> Builder
    indentBy Int
    indentation Builder -> Builder -> Builder
    forall a. Semigroup a => a -> a -> a
    <> Builder
    "}"
              ]

            renderField :: (String, Value) -> 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
    <> Int -> Value -> Builder
    render (Int -> Int
    forall a. Enum a => a -> a
    succ Int
    indentation) Value
    value

        indentBy :: Int -> Builder
        indentBy :: Int -> Builder
    indentBy Int
    n = String -> Builder
    forall a. IsString a => String -> a
    fromString (String -> Builder) -> String -> Builder
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    2 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    * Int
    n) Char
    ' '