module Test.IOTasks.Internal.Output ( Output, newOutput, putT, putLnT, printT, putP, putLnP, printP, oFlush ) where import Control.Monad.Extra (ifM) import System.Console.ANSI import System.IO (Handle, hPutStr, hFlush) import Data.IORef data Output = Output { Output -> Handle handle :: Handle , Output -> IORef TextDim _tempSize :: IORef TextDim , Output -> IORef TextDim -> Handle -> String -> IO () _tempOutput :: IORef TextDim -> Handle -> String -> IO () , Output -> IORef TextDim -> Handle -> String -> IO () _permanentOutput :: IORef TextDim -> Handle -> String -> IO () } oFlush :: Output -> IO () oFlush :: Output -> IO () oFlush = Handle -> IO () hFlush (Handle -> IO ()) -> (Output -> Handle) -> Output -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . Output -> Handle handle data TextDim = TextDim { TextDim -> Int width :: Int, TextDim -> Int height :: Int, TextDim -> Int offset :: Int } deriving (TextDim -> TextDim -> Bool (TextDim -> TextDim -> Bool) -> (TextDim -> TextDim -> Bool) -> Eq TextDim forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a $c== :: TextDim -> TextDim -> Bool == :: TextDim -> TextDim -> Bool $c/= :: TextDim -> TextDim -> Bool /= :: TextDim -> TextDim -> Bool Eq, Int -> TextDim -> ShowS [TextDim] -> ShowS TextDim -> String (Int -> TextDim -> ShowS) -> (TextDim -> String) -> ([TextDim] -> ShowS) -> Show TextDim forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a $cshowsPrec :: Int -> TextDim -> ShowS showsPrec :: Int -> TextDim -> ShowS $cshow :: TextDim -> String show :: TextDim -> String $cshowList :: [TextDim] -> ShowS showList :: [TextDim] -> ShowS Show) emptyDim :: TextDim emptyDim :: TextDim emptyDim = Int -> Int -> Int -> TextDim TextDim Int 0 Int 1 Int 0 stringDim :: String -> TextDim stringDim :: String -> TextDim stringDim String "" = TextDim emptyDim stringDim String s = Int -> Int -> Int -> TextDim TextDim ([Int] -> Int forall a. Ord a => [a] -> a forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a maximum ([Int] -> Int) -> [Int] -> Int forall a b. (a -> b) -> a -> b $ (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] ls) ([String] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [String] ls) (String -> Int nonEmptyLength (String -> Int) -> String -> Int forall a b. (a -> b) -> a -> b $ [String] -> String forall a. HasCallStack => [a] -> a last [String] ls) where ls :: [String] ls = String -> [String] lines' String s nonEmptyLength :: String -> Int nonEmptyLength :: String -> Int nonEmptyLength = String -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length (String -> Int) -> ShowS -> String -> Int forall b c a. (b -> c) -> (a -> b) -> a -> c . (Char -> Bool) -> ShowS forall a. (a -> Bool) -> [a] -> [a] dropWhile (Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char ' ') ShowS -> ShowS -> ShowS forall b c a. (b -> c) -> (a -> b) -> a -> c . ShowS forall a. [a] -> [a] reverse lines' :: String -> [String] lines' :: String -> [String] lines' String s | String -> Char forall a. HasCallStack => [a] -> a last String s Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n' = String -> [String] lines String s [String] -> [String] -> [String] forall a. [a] -> [a] -> [a] ++ [String ""] | Bool otherwise = String -> [String] lines String s shrinkDim :: TextDim -> TextDim -> TextDim shrinkDim :: TextDim -> TextDim -> TextDim shrinkDim (TextDim Int w Int h Int o) (TextDim Int x Int y Int z) = Int -> Int -> Int -> TextDim TextDim (Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 0 (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ Int wInt -> Int -> Int forall a. Num a => a -> a -> a -Int x) Int newHeight Int newOffset where newHeight :: Int newHeight = Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 1 (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ Int hInt -> Int -> Int forall a. Num a => a -> a -> a -(Int yInt -> Int -> Int forall a. Num a => a -> a -> a -Int 1) newOffset :: Int newOffset | Int newHeight Int -> Int -> Bool forall a. Ord a => a -> a -> Bool < Int h = Int z | Bool otherwise = Int -> Int -> Int forall a. Ord a => a -> a -> a max Int 0 (Int -> Int) -> Int -> Int forall a b. (a -> b) -> a -> b $ Int o Int -> Int -> Int forall a. Num a => a -> a -> a + Int z newOutput :: Handle -> IO Output newOutput :: Handle -> IO Output newOutput Handle h = do IORef TextDim dRef <- TextDim -> IO (IORef TextDim) forall a. a -> IO (IORef a) newIORef TextDim emptyDim IO Bool -> IO Output -> IO Output -> IO Output forall (m :: * -> *) a. Monad m => m Bool -> m a -> m a -> m a ifM (Handle -> IO Bool hSupportsANSI Handle h) (Output -> IO Output forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Output -> IO Output) -> Output -> IO Output forall a b. (a -> b) -> a -> b $ Handle -> IORef TextDim -> (IORef TextDim -> Handle -> String -> IO ()) -> (IORef TextDim -> Handle -> String -> IO ()) -> Output Output Handle h IORef TextDim dRef (Bool -> IORef TextDim -> Handle -> String -> IO () resetCursorAndWrite Bool False) (Bool -> IORef TextDim -> Handle -> String -> IO () resetCursorAndWrite Bool True)) (Output -> IO Output forall a. a -> IO a forall (f :: * -> *) a. Applicative f => a -> f a pure (Output -> IO Output) -> Output -> IO Output forall a b. (a -> b) -> a -> b $ Handle -> IORef TextDim -> (IORef TextDim -> Handle -> String -> IO ()) -> (IORef TextDim -> Handle -> String -> IO ()) -> Output Output Handle h IORef TextDim dRef ((Handle -> String -> IO ()) -> IORef TextDim -> Handle -> String -> IO () forall a b. a -> b -> a const Handle -> String -> IO () hPutStr') ((Handle -> String -> IO ()) -> IORef TextDim -> Handle -> String -> IO () forall a b. a -> b -> a const Handle -> String -> IO () hPutStr)) where hPutStr' :: Handle -> String -> IO () hPutStr' Handle h String s = Handle -> String -> IO () hPutStr Handle h (String -> IO ()) -> String -> IO () forall a b. (a -> b) -> a -> b $ if String -> Char forall a. HasCallStack => [a] -> a last String s Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n' then String s else String s String -> ShowS forall a. [a] -> [a] -> [a] ++ String "\n" resetCursorAndWrite :: Bool -> IORef TextDim -> Handle -> String -> IO () resetCursorAndWrite :: Bool -> IORef TextDim -> Handle -> String -> IO () resetCursorAndWrite Bool perm IORef TextDim dRef Handle h String s = do TextDim d <- IORef TextDim -> IO TextDim forall a. IORef a -> IO a readIORef IORef TextDim dRef Handle -> Int -> IO () hCursorUpLine Handle h (TextDim -> Int height TextDim d Int -> Int -> Int forall a. Num a => a -> a -> a - Int 1) Handle -> Int -> IO () hCursorForward Handle h (TextDim -> Int offset TextDim d) let s' :: String s' = TextDim -> ShowS padString TextDim d String s Handle -> String -> IO () hPutStr Handle h String s' IORef TextDim -> TextDim -> IO () forall a. IORef a -> a -> IO () writeIORef IORef TextDim dRef (TextDim -> IO ()) -> TextDim -> IO () forall a b. (a -> b) -> a -> b $ if Bool perm then TextDim -> TextDim -> TextDim shrinkDim TextDim d (String -> TextDim stringDim String s) else (String -> TextDim stringDim String s'){offset = offset d} padString :: TextDim -> String -> String padString :: TextDim -> ShowS padString TextDim d String s = [String] -> String unlines' ([String] -> String) -> ([String] -> [String]) -> [String] -> String forall b c a. (b -> c) -> (a -> b) -> a -> c . ShowS -> [String] -> [String] forall a b. (a -> b) -> [a] -> [b] map (Int -> Char -> ShowS forall a. Int -> a -> [a] -> [a] extendTo (TextDim -> Int width TextDim d) Char ' ') ([String] -> [String]) -> ([String] -> [String]) -> [String] -> [String] forall b c a. (b -> c) -> (a -> b) -> a -> c . Int -> String -> [String] -> [String] forall a. Int -> a -> [a] -> [a] extendTo (TextDim -> Int height TextDim d) String "" ([String] -> String) -> [String] -> String forall a b. (a -> b) -> a -> b $ String -> [String] lines' String s where extendTo :: Int -> a -> [a] -> [a] extendTo :: forall a. Int -> a -> [a] -> [a] extendTo Int n a x [a] xs = [a] xs [a] -> [a] -> [a] forall a. [a] -> [a] -> [a] ++ Int -> a -> [a] forall a. Int -> a -> [a] replicate (Int n Int -> Int -> Int forall a. Num a => a -> a -> a - [a] -> Int forall a. [a] -> Int forall (t :: * -> *) a. Foldable t => t a -> Int length [a] xs) a x unlines' :: [String] -> String unlines' :: [String] -> String unlines' [String] xs | Bool newLineTerminated = [String] -> String unlines ([String] -> [String] forall a. HasCallStack => [a] -> [a] init [String] xs) String -> ShowS forall a. [a] -> [a] -> [a] ++ [String] -> String forall a. HasCallStack => [a] -> a last [String] xs | Bool otherwise = ShowS forall a. HasCallStack => [a] -> [a] init ShowS -> ShowS forall a b. (a -> b) -> a -> b $ [String] -> String unlines [String] xs where newLineTerminated :: Bool newLineTerminated = String -> Char forall a. HasCallStack => [a] -> a last String s Char -> Char -> Bool forall a. Eq a => a -> a -> Bool == Char '\n' putT :: Output -> String -> IO () putT :: Output -> String -> IO () putT (Output Handle h IORef TextDim d IORef TextDim -> Handle -> String -> IO () f IORef TextDim -> Handle -> String -> IO () _) = IORef TextDim -> Handle -> String -> IO () f IORef TextDim d Handle h putLnT :: Output -> String -> IO () putLnT :: Output -> String -> IO () putLnT Output h = Output -> String -> IO () putT Output h (String -> IO ()) -> ShowS -> String -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> ShowS forall a. [a] -> [a] -> [a] ++ String "\n") printT :: Show a => Output -> a -> IO () printT :: forall a. Show a => Output -> a -> IO () printT Output h = Output -> String -> IO () putLnT Output h (String -> IO ()) -> (a -> String) -> a -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String forall a. Show a => a -> String show putP :: Output -> String -> IO () putP :: Output -> String -> IO () putP (Output Handle h IORef TextDim d IORef TextDim -> Handle -> String -> IO () _ IORef TextDim -> Handle -> String -> IO () g) = IORef TextDim -> Handle -> String -> IO () g IORef TextDim d Handle h putLnP :: Output -> String -> IO () putLnP :: Output -> String -> IO () putLnP Output h = Output -> String -> IO () putP Output h (String -> IO ()) -> ShowS -> String -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . (String -> ShowS forall a. [a] -> [a] -> [a] ++ String "\n") printP :: Show a => Output -> a -> IO () printP :: forall a. Show a => Output -> a -> IO () printP Output h = Output -> String -> IO () putLnP Output h (String -> IO ()) -> (a -> String) -> a -> IO () forall b c a. (b -> c) -> (a -> b) -> a -> c . a -> String forall a. Show a => a -> String show