-- | This module handles the complexities of writing information to the
-- terminal, including modifying text in place.

module Test.HUnit.Terminal (
        terminalAppearance
    ) where

import Data.Char (isPrint)


-- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters
-- specially so that the result string has the same final (or /terminal/,
-- pun intended) appearance as would the input string when written to a
-- terminal that overwrites character positions following carriage
-- returns and backspaces.

terminalAppearance :: String -> String
terminalAppearance :: String -> String
terminalAppearance String
str = (String -> String) -> String -> String -> String -> String
forall t. (String -> t) -> String -> String -> String -> t
ta String -> String
forall a. a -> a
id String
"" String
"" String
str

-- | The helper function @ta@ takes an accumulating @ShowS@-style function
-- that holds /committed/ lines of text, a (reversed) list of characters
-- on the current line /before/ the cursor, a (normal) list of characters
-- on the current line /after/ the cursor, and the remaining input.

ta
    :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function
                     -- that holds /committed/ lines of text
    -> [Char] -- ^ A (reversed) list of characters
              -- on the current line /before/ the cursor
    -> [Char] -- ^ A (normal) list of characters
              -- on the current line /after/ the cursor
    -> [Char] -- ^ The remaining input
    -> t
ta :: forall t. (String -> t) -> String -> String -> String -> t
ta String -> t
f    String
bs  String
as (Char
'\n':String
cs) = (String -> t) -> String -> String -> String -> t
forall t. (String -> t) -> String -> String -> String -> t
ta (\String
t -> String -> t
f (String -> String
forall a. [a] -> [a]
reverse String
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
as String -> String -> String
forall a. [a] -> [a] -> [a]
++ Char
'\n' Char -> String -> String
forall a. a -> [a] -> [a]
: String
t)) String
"" String
"" String
cs
ta String -> t
f    String
bs  String
as (Char
'\r':String
cs) = (String -> t) -> String -> String -> String -> t
forall t. (String -> t) -> String -> String -> String -> t
ta String -> t
f String
"" (String -> String
forall a. [a] -> [a]
reverse String
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
as) String
cs
ta String -> t
f (Char
b:String
bs) String
as (Char
'\b':String
cs) = (String -> t) -> String -> String -> String -> t
forall t. (String -> t) -> String -> String -> String -> t
ta String -> t
f String
bs (Char
bChar -> String -> String
forall a. a -> [a] -> [a]
:String
as) String
cs
ta String -> t
_    String
""   String
_ (Char
'\b': String
_) = String -> t
forall a. HasCallStack => String -> a
error String
"'\\b' at beginning of line"
ta String -> t
f    String
bs  String
as (Char
c:String
cs)
    | Bool -> Bool
not (Char -> Bool
isPrint Char
c)    = String -> t
forall a. HasCallStack => String -> a
error String
"invalid nonprinting character"
    | String -> Bool
forall a. [a] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
as            = (String -> t) -> String -> String -> String -> t
forall t. (String -> t) -> String -> String -> String -> t
ta String -> t
f (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
bs) String
""        String
cs
    | Bool
otherwise          = (String -> t) -> String -> String -> String -> t
forall t. (String -> t) -> String -> String -> String -> t
ta String -> t
f (Char
cChar -> String -> String
forall a. a -> [a] -> [a]
:String
bs) (String -> String
forall a. HasCallStack => [a] -> [a]
tail String
as) String
cs
ta String -> t
f    String
bs  String
as       String
""  = String -> t
f (String -> String
forall a. [a] -> [a]
reverse String
bs String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
as)