1-- | This module handles the complexities of writing information to the 2-- terminal, including modifying text in place. 3 4module Test.HUnit.Terminal ( 5 terminalAppearance 6 ) where 7 8import Data.Char (isPrint) 9 10 11-- | Simplifies the input string by interpreting @\\r@ and @\\b@ characters 12-- specially so that the result string has the same final (or /terminal/, 13-- pun intended) appearance as would the input string when written to a 14-- terminal that overwrites character positions following carriage 15-- returns and backspaces. 16 17terminalAppearance :: String -> String 18terminalAppearance str = ta id "" "" str 19 20-- | The helper function @ta@ takes an accumulating @ShowS@-style function 21-- that holds /committed/ lines of text, a (reversed) list of characters 22-- on the current line /before/ the cursor, a (normal) list of characters 23-- on the current line /after/ the cursor, and the remaining input. 24 25ta 26 :: ([Char] -> t) -- ^ An accumulating @ShowS@-style function 27 -- that holds /committed/ lines of text 28 -> [Char] -- ^ A (reversed) list of characters 29 -- on the current line /before/ the cursor 30 -> [Char] -- ^ A (normal) list of characters 31 -- on the current line /after/ the cursor 32 -> [Char] -- ^ The remaining input 33 -> t 34ta f bs as ('\n':cs) = ta (\t -> f (reverse bs ++ as ++ '\n' : t)) "" "" cs 35ta f bs as ('\r':cs) = ta f "" (reverse bs ++ as) cs 36ta f (b:bs) as ('\b':cs) = ta f bs (b:as) cs 37ta _ "" _ ('\b': _) = error "'\\b' at beginning of line" 38ta f bs as (c:cs) 39 | not (isPrint c) = error "invalid nonprinting character" 40 | null as = ta f (c:bs) "" cs 41 | otherwise = ta f (c:bs) (tail as) cs 42ta f bs as "" = f (reverse bs ++ as) 43