Blame src/Test/HUnit/Terminal.hs

Packit bc3140
-- | This module handles the complexities of writing information to the
Packit bc3140
-- terminal, including modifying text in place.
Packit bc3140
Packit bc3140
module Test.HUnit.Terminal (
Packit bc3140
        terminalAppearance
Packit bc3140
    ) where
Packit bc3140
Packit bc3140
import Data.Char (isPrint)
Packit bc3140
Packit bc3140
Packit bc3140
-- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters
Packit bc3140
-- specially so that the result string has the same final (or /terminal/,
Packit bc3140
-- pun intended) appearance as would the input string when written to a
Packit bc3140
-- terminal that overwrites character positions following carriage
Packit bc3140
-- returns and backspaces.
Packit bc3140
Packit bc3140
terminalAppearance :: String -> String
Packit bc3140
terminalAppearance str = ta id "" "" str
Packit bc3140
Packit bc3140
-- | The helper function @ta@ takes an accumulating @ShowS@-style function
Packit bc3140
-- that holds /committed/ lines of text, a (reversed) list of characters
Packit bc3140
-- on the current line /before/ the cursor, a (normal) list of characters
Packit bc3140
-- on the current line /after/ the cursor, and the remaining input.
Packit bc3140
Packit bc3140
ta
Packit bc3140
    :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function
Packit bc3140
                     -- that holds /committed/ lines of text
Packit bc3140
    -> [Char] -- ^ A (reversed) list of characters
Packit bc3140
              -- on the current line /before/ the cursor
Packit bc3140
    -> [Char] -- ^ A (normal) list of characters
Packit bc3140
              -- on the current line /after/ the cursor
Packit bc3140
    -> [Char] -- ^ The remaining input
Packit bc3140
    -> t
Packit bc3140
ta f    bs  as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs
Packit bc3140
ta f    bs  as ('\r':cs) = ta f "" (reverse bs ++ as) cs
Packit bc3140
ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs
Packit bc3140
ta _    ""   _ ('\b': _) = error "'\\b' at beginning of line"
Packit bc3140
ta f    bs  as (c:cs)
Packit bc3140
    | not (isPrint c)    = error "invalid nonprinting character"
Packit bc3140
    | null as            = ta f (c:bs) ""        cs
Packit bc3140
    | otherwise          = ta f (c:bs) (tail as) cs
Packit bc3140
ta f    bs  as       ""  = f (reverse bs ++ as)