    {-# LANGUAGE CPP #-}
    #ifndef NO_SAFE_HASKELL
    {-# LANGUAGE Safe #-}
    #endif
    {-# OPTIONS_HADDOCK hide #-}
    -- | Terminal control and text helper functions. Internal QuickCheck module.
    module Test.QuickCheck.Text
      ( Str(..)
      , ranges

      , number
      , short
      , showErr
      , oneLine
      , isOneLine
      , bold
      , ljust, rjust, centre, lpercent, rpercent, lpercentage, rpercentage
      , drawTable, Cell(..)
      , paragraphs

      , newTerminal
      , withStdioTerminal
      , withHandleTerminal
      , withNullTerminal
      , terminalOutput
      , handle
      , Terminal
      , putTemp
      , putPart
      , putLine
      )
     where

    --------------------------------------------------------------------------
    -- imports

    import System.IO
      ( hFlush
      , hPutStr
      , stdout
      , stderr
      , Handle
      , BufferMode (..)
      , hGetBuffering
      , hSetBuffering
      , hIsTerminalDevice
      )

    import Data.IORef
    import Data.List (intersperse, transpose)
    import Text.Printf
    import Test.QuickCheck.Exception

    --------------------------------------------------------------------------
    -- literal string

    newtype Str = MkStr String

    instance Show Str where
      show :: Str -> String
    show (MkStr String
    s) = String
    s

    ranges :: (Show a, Integral a) => a -> a -> Str
    ranges :: forall a. (Show a, Integral a) => a -> a -> Str
    ranges a
    k a
    n = String -> Str
    MkStr (a -> String
    forall a. Show a => a -> String
    show a
    n' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " -- " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ a -> String
    forall a. Show a => a -> String
    show (a
    n'a -> a -> a
    forall a. Num a => a -> a -> a
    +a
    ka -> a -> a
    forall a. Num a => a -> a -> a
    -a
    1))
     where
      n' :: a
    n' = a
    k a -> a -> a
    forall a. Num a => a -> a -> a
    * (a
    n a -> a -> a
    forall a. Integral a => a -> a -> a
    `div` a
    k)

    --------------------------------------------------------------------------
    -- formatting

    number :: Int -> String -> String
    number :: Int -> ShowS
    number Int
    n String
    s = Int -> String
    forall a. Show a => a -> String
    show Int
    n String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    " " String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ if Int
    n Int -> Int -> Bool
    forall a. Eq a => a -> a -> Bool
    == Int
    1 then String
    "" else String
    "s"

    short :: Int -> String -> String
    short :: Int -> ShowS
    short Int
    n String
    s
      | Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    < Int
    k     = Int -> ShowS
    forall a. Int -> [a] -> [a]
    take (Int
    nInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    2Int -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    i) String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    ".." String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> ShowS
    forall a. Int -> [a] -> [a]
    drop (Int
    kInt -> Int -> Int
    forall a. Num a => a -> a -> a
    -Int
    i) String
    s
      | Bool
    otherwise = String
    s
     where
      k :: Int
    k = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s
      i :: Int
    i = if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    5 then Int
    3 else Int
    0

    showErr :: Show a => a -> String
    showErr :: forall a. Show a => a -> String
    showErr = [String] -> String
    unwords ([String] -> String) -> (a -> [String]) -> a -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words (String -> [String]) -> (a -> String) -> a -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . a -> String
    forall a. Show a => a -> String
    show

    oneLine :: String -> String
    oneLine :: ShowS
    oneLine = [String] -> String
    unwords ([String] -> String) -> (String -> [String]) -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> [String]
    words

    isOneLine :: String -> Bool
    isOneLine :: String -> Bool
    isOneLine String
    xs = Char
    '\n' Char -> String -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` String
    xs

    ljust :: Int -> ShowS
    ljust Int
    n String
    xs = String
    xs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    xs) Char
    ' '
    rjust :: Int -> ShowS
    rjust Int
    n String
    xs = Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate (Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    xs) Char
    ' ' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    xs
    centre :: Int -> ShowS
    centre Int
    n String
    xs =
      Int -> ShowS
    ljust Int
    n ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $
      Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate ((Int
    n Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    xs) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `div` Int
    2) Char
    ' ' String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    xs

    lpercent, rpercent :: (Integral a, Integral b) => a -> b -> String
    lpercent :: forall a b. (Integral a, Integral b) => a -> b -> String
    lpercent a
    n b
    k =
      Double -> b -> String
    forall a. Integral a => Double -> a -> String
    lpercentage (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    n Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / b -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral b
    k) b
    k

    rpercent :: forall a b. (Integral a, Integral b) => a -> b -> String
    rpercent a
    n b
    k =
      Double -> b -> String
    forall a. Integral a => Double -> a -> String
    rpercentage (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    n Double -> Double -> Double
    forall a. Fractional a => a -> a -> a
    / b -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral b
    k) b
    k

    lpercentage, rpercentage :: Integral a => Double -> a -> String
    lpercentage :: forall a. Integral a => Double -> a -> String
    lpercentage Double
    p a
    n =
      String -> Integer -> Double -> String
    forall r. PrintfType r => String -> r
    printf String
    "%.*f" Integer
    places (Double
    100Double -> Double -> Double
    forall a. Num a => a -> a -> a
    *Double
    p) String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "%"
      where
        -- Show no decimal places if k <= 100,
        -- one decimal place if k <= 1000,
        -- two decimal places if k <= 10000, and so on.
        places :: Integer
        places :: Integer
    places =
          Double -> Integer
    forall b. Integral b => Double -> b
    forall a b. (RealFrac a, Integral b) => a -> b
    ceiling (Double -> Double -> Double
    forall a. Floating a => a -> a -> a
    logBase Double
    10 (a -> Double
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral a
    n) Double -> Double -> Double
    forall a. Num a => a -> a -> a
    - Double
    2 :: Double) Integer -> Integer -> Integer
    forall a. Ord a => a -> a -> a
    `max` Integer
    0

    rpercentage :: forall a. Integral a => Double -> a -> String
    rpercentage Double
    p a
    n = String
    padding String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Double -> a -> String
    forall a. Integral a => Double -> a -> String
    lpercentage Double
    p a
    n
      where
        padding :: String
    padding = if Double
    p Double -> Double -> Bool
    forall a. Ord a => a -> a -> Bool
    < Double
    0.1 then String
    " " else String
    ""

    data Cell = LJust String | RJust String | Centred String deriving Int -> Cell -> ShowS
    [Cell] -> ShowS
    Cell -> String
    (Int -> Cell -> ShowS)
    -> (Cell -> String) -> ([Cell] -> ShowS) -> Show Cell
    forall a.
    (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
    $cshowsPrec :: Int -> Cell -> ShowS
    showsPrec :: Int -> Cell -> ShowS
    $cshow :: Cell -> String
    show :: Cell -> String
    $cshowList :: [Cell] -> ShowS
    showList :: [Cell] -> ShowS
    Show

    text :: Cell -> String
    text :: Cell -> String
    text (LJust String
    xs) = String
    xs
    text (RJust String
    xs) = String
    xs
    text (Centred String
    xs) = String
    xs

    -- Flatten a table into a list of rows
    flattenRows :: [[Cell]] -> [String]
    flattenRows :: [[Cell]] -> [String]
    flattenRows [[Cell]]
    rows = ([Cell] -> String) -> [[Cell]] -> [String]
    forall a b. (a -> b) -> [a] -> [b]
    map [Cell] -> String
    row [[Cell]]
    rows
      where
        cols :: [[Cell]]
    cols = [[Cell]] -> [[Cell]]
    forall a. [[a]] -> [[a]]
    transpose [[Cell]]
    rows
        widths :: [Int]
    widths = ([Cell] -> Int) -> [[Cell]] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map ([Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum ([Int] -> Int) -> ([Cell] -> [Int]) -> [Cell] -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Cell -> Int) -> [Cell] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length (String -> Int) -> (Cell -> String) -> Cell -> Int
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Cell -> String
    text)) [[Cell]]
    cols

        row :: [Cell] -> String
    row [Cell]
    cells = [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat (String -> [String] -> [String]
    forall a. a -> [a] -> [a]
    intersperse String
    " " ((Int -> Cell -> String) -> [Int] -> [Cell] -> [String]
    forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
    zipWith Int -> Cell -> String
    cell [Int]
    widths [Cell]
    cells))
        cell :: Int -> Cell -> String
    cell Int
    n (LJust String
    xs) = Int -> ShowS
    ljust Int
    n String
    xs
        cell Int
    n (RJust String
    xs) = Int -> ShowS
    rjust Int
    n String
    xs
        cell Int
    n (Centred String
    xs) = Int -> ShowS
    centre Int
    n String
    xs

    -- Draw a table given a header and contents
    drawTable :: [String] -> [[Cell]] -> [String]
    drawTable :: [String] -> [[Cell]] -> [String]
    drawTable [String]
    headers [[Cell]]
    table =
      [String
    line] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
      [Char -> Char -> ShowS
    border Char
    '|' Char
    ' ' String
    header | String
    header <- [String]
    headers] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
      [String
    line | Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    headers) Bool -> Bool -> Bool
    && Bool -> Bool
    not ([String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null [String]
    rows)] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
      [Char -> Char -> ShowS
    border Char
    '|' Char
    ' ' String
    row | String
    row <- [String]
    rows] [String] -> [String] -> [String]
    forall a. [a] -> [a] -> [a]
    ++
      [String
    line]
      where
        rows :: [String]
    rows = [[Cell]] -> [String]
    flattenRows [[Cell]]
    table

        headerwidth :: Int
    headerwidth = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Int
    0Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :(String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    headers)
        bodywidth :: Int
    bodywidth = [Int] -> Int
    forall a. Ord a => [a] -> a
    forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
    maximum (Int
    0Int -> [Int] -> [Int]
    forall a. a -> [a] -> [a]
    :(String -> Int) -> [String] -> [Int]
    forall a b. (a -> b) -> [a] -> [b]
    map String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length [String]
    rows)
        width :: Int
    width = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    headerwidth Int
    bodywidth

        line :: String
    line = Char -> Char -> ShowS
    border Char
    '+' Char
    '-' ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ Int -> Char -> String
    forall a. Int -> a -> [a]
    replicate Int
    width Char
    '-'
        border :: Char -> Char -> ShowS
    border Char
    x Char
    y String
    xs = [Char
    x, Char
    y] String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ Int -> ShowS
    centre Int
    width String
    xs String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ [Char
    y, Char
    x]

    paragraphs :: [[String]] -> [String]
    paragraphs :: [[String]] -> [String]
    paragraphs = [[String]] -> [String]
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat ([[String]] -> [String])
    -> ([[String]] -> [[String]]) -> [[String]] -> [String]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> [[String]] -> [[String]]
    forall a. a -> [a] -> [a]
    intersperse [String
    ""] ([[String]] -> [[String]])
    -> ([[String]] -> [[String]]) -> [[String]] -> [[String]]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . ([String] -> Bool) -> [[String]] -> [[String]]
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Bool -> Bool
    not (Bool -> Bool) -> ([String] -> Bool) -> [String] -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [String] -> Bool
    forall a. [a] -> Bool
    forall (t :: * -> *) a. Foldable t => t a -> Bool
    null)

    bold :: String -> String
    -- not portable:
    --bold s = "\ESC[1m" ++ s ++ "\ESC[0m"
    bold :: ShowS
    bold String
    s = String
    s -- for now

    --------------------------------------------------------------------------
    -- putting strings

    data Terminal
      = MkTerminal (IORef ShowS) (IORef Int) (String -> IO ()) (String -> IO ())

    newTerminal :: (String -> IO ()) -> (String -> IO ()) -> IO Terminal
    newTerminal :: (String -> IO ()) -> (String -> IO ()) -> IO Terminal
    newTerminal String -> IO ()
    out String -> IO ()
    err =
      do res <- ShowS -> IO (IORef ShowS)
    forall a. a -> IO (IORef a)
    newIORef (String -> ShowS
    showString String
    "")
         tmp <- newIORef 0
         return (MkTerminal res tmp out err)

    withBuffering :: IO a -> IO a
    withBuffering :: forall a. IO a -> IO a
    withBuffering IO a
    action = do
      mode <- Handle -> IO BufferMode
    hGetBuffering Handle
    stderr
      -- By default stderr is unbuffered.  This is very slow, hence we explicitly
      -- enable line buffering.
      hSetBuffering stderr LineBuffering
      action `finally` hSetBuffering stderr mode

    withHandleTerminal :: Handle -> Maybe Handle -> (Terminal -> IO a) -> IO a
    withHandleTerminal :: forall a. Handle -> Maybe Handle -> (Terminal -> IO a) -> IO a
    withHandleTerminal Handle
    outh Maybe Handle
    merrh Terminal -> IO a
    action = do
      let
        err :: String -> IO ()
    err =
          case Maybe Handle
    merrh of
            Maybe Handle
    Nothing -> IO () -> String -> IO ()
    forall a b. a -> b -> a
    const (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())
            Just Handle
    errh -> Handle -> String -> IO ()
    handle Handle
    errh
      (String -> IO ()) -> (String -> IO ()) -> IO Terminal
    newTerminal (Handle -> String -> IO ()
    handle Handle
    outh) String -> IO ()
    err IO Terminal -> (Terminal -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Terminal -> IO a
    action

    withStdioTerminal :: (Terminal -> IO a) -> IO a
    withStdioTerminal :: forall a. (Terminal -> IO a) -> IO a
    withStdioTerminal Terminal -> IO a
    action = do
      isatty <- Handle -> IO Bool
    hIsTerminalDevice Handle
    stderr
      if isatty then
        withBuffering (withHandleTerminal stdout (Just stderr) action)
       else
        withBuffering (withHandleTerminal stdout Nothing action)

    withNullTerminal :: (Terminal -> IO a) -> IO a
    withNullTerminal :: forall a. (Terminal -> IO a) -> IO a
    withNullTerminal Terminal -> IO a
    action =
      (String -> IO ()) -> (String -> IO ()) -> IO Terminal
    newTerminal (IO () -> String -> IO ()
    forall a b. a -> b -> a
    const (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())) (IO () -> String -> IO ()
    forall a b. a -> b -> a
    const (() -> IO ()
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ())) IO Terminal -> (Terminal -> IO a) -> IO a
    forall a b. IO a -> (a -> IO b) -> IO b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= Terminal -> IO a
    action

    terminalOutput :: Terminal -> IO String
    terminalOutput :: Terminal -> IO String
    terminalOutput (MkTerminal IORef ShowS
    res IORef Int
    _ String -> IO ()
    _ String -> IO ()
    _) = (ShowS -> String) -> IO ShowS -> IO String
    forall a b. (a -> b) -> IO a -> IO b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap (ShowS -> ShowS
    forall a b. (a -> b) -> a -> b
    $ String
    "") (IORef ShowS -> IO ShowS
    forall a. IORef a -> IO a
    readIORef IORef ShowS
    res)

    handle :: Handle -> String -> IO ()
    handle :: Handle -> String -> IO ()
    handle Handle
    h String
    s = do
      Handle -> String -> IO ()
    hPutStr Handle
    h String
    s
      Handle -> IO ()
    hFlush Handle
    h

    putPart, putTemp, putLine :: Terminal -> String -> IO ()
    putPart :: Terminal -> String -> IO ()
    putPart tm :: Terminal
    tm@(MkTerminal IORef ShowS
    res IORef Int
    _ String -> IO ()
    out String -> IO ()
    _) String
    s =
      do Terminal -> String -> IO ()
    putTemp Terminal
    tm String
    ""
         String -> IO ()
    forall a. [a] -> IO ()
    force String
    s
         String -> IO ()
    out String
    s
         IORef ShowS -> (ShowS -> ShowS) -> IO ()
    forall a. IORef a -> (a -> a) -> IO ()
    modifyIORef IORef ShowS
    res (ShowS -> ShowS -> ShowS
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ShowS
    showString String
    s)
      where
        force :: [a] -> IO ()
        force :: forall a. [a] -> IO ()
    force = () -> IO ()
    forall a. a -> IO a
    evaluate (() -> IO ()) -> ([a] -> ()) -> [a] -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [a] -> ()
    forall a. [a] -> ()
    seqList

        seqList :: [a] -> ()
        seqList :: forall a. [a] -> ()
    seqList [] = ()
        seqList (a
    x:[a]
    xs) = a
    x a -> () -> ()
    forall a b. a -> b -> b
    `seq` [a] -> ()
    forall a. [a] -> ()
    seqList [a]
    xs

    putLine :: Terminal -> String -> IO ()
    putLine Terminal
    tm String
    s = Terminal -> String -> IO ()
    putPart Terminal
    tm (String
    s String -> ShowS
    forall a. [a] -> [a] -> [a]
    ++ String
    "\n")

    putTemp :: Terminal -> String -> IO ()
    putTemp tm :: Terminal
    tm@(MkTerminal IORef ShowS
    _ IORef Int
    tmp String -> IO ()
    _ String -> IO ()
    err) String
    s =
      do oldLen <- IORef Int -> IO Int
    forall a. IORef a -> IO a
    readIORef IORef Int
    tmp
         let newLen = String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s
             maxLen = Int -> Int -> Int
    forall a. Ord a => a -> a -> a
    max Int
    newLen Int
    oldLen
         err $ s ++ replicate (maxLen - newLen) ' ' ++ replicate maxLen '\b'
         writeIORef tmp newLen

    --------------------------------------------------------------------------
    -- the end.