    -- Copyright Corey O'Connor
    {-# LANGUAGE FlexibleInstances #-}
    {-# LANGUAGE TypeFamilies #-}
    -- | This provides a mock terminal implementation that is nice for testing. This transforms the
    -- output operations to visible characters. Which is nice for some tests.
    module Graphics.Vty.Output.Mock ( MockData, mockTerminal )
        where

    import Graphics.Vty.Prelude

    import Graphics.Vty.Output.Interface

    import Blaze.ByteString.Builder.Word (writeWord8)

    import Control.Monad.Trans

    import qualified Data.ByteString as BS
    import Data.IORef
    import qualified Data.String.UTF8 as UTF8

    type MockData = IORef (UTF8.UTF8 BS.ByteString)

    -- | The mock display terminal produces a string representation of the requested picture.  There is
    -- *not* an isomorphism between the string representation and the picture.  The string
    -- representation is a simplification of the picture that is only useful in debugging VTY without
    -- considering terminal specific issues.
    --
    -- The mock implementation is useful in manually determining if the sequence of terminal operations
    -- matches the expected sequence. So requirement of the produced representation is simplicity in
    -- parsing the text representation and determining how the picture was mapped to terminal
    -- operations.
    --
    -- The string representation is a sequence of identifiers where each identifier is the name of an
    -- operation in the algebra.
    mockTerminal :: (Applicative m, MonadIO m) => DisplayRegion -> m (MockData, Output)
    mockTerminal r = liftIO $ do
        outRef <- newIORef undefined
        newAssumedStateRef <- newIORef initialAssumedState
        let t = Output
                { terminalID = "mock terminal"
                , releaseTerminal = return ()
                , reserveDisplay = return ()
                , releaseDisplay = return ()
                , displayBounds = return r
                , outputByteBuffer = \bytes -> do
                    putStrLn $ "mock outputByteBuffer of " ++ show (BS.length bytes) ++ " bytes"
                    writeIORef outRef $ UTF8.fromRep bytes
                , contextColorCount = 16
                , supportsCursorVisibility = True
                , assumedStateRef = newAssumedStateRef
                , mkDisplayContext = \tActual rActual -> return $ DisplayContext
                    { contextRegion = rActual
                    , contextDevice = tActual
                    -- A cursor move is always visualized as the single character 'M'
                    , writeMoveCursor = \_x _y -> writeWord8 $ toEnum $ fromEnum 'M'
                    -- Show cursor is always visualized as the single character 'S'
                    , writeShowCursor =  writeWord8 $ toEnum $ fromEnum 'S'
                    -- Hide cursor is always visualized as the single character 'H'
                    , writeHideCursor = writeWord8 $ toEnum $ fromEnum 'H'
                    -- An attr change is always visualized as the single character 'A'
                    , writeSetAttr = \_fattr _diffs _attr -> writeWord8 $ toEnum $ fromEnum 'A'
                    -- default attr is always visualized as the single character 'D'
                    , writeDefaultAttr = writeWord8 $ toEnum $ fromEnum 'D'
                    -- row end is always visualized as the single character 'E'
                    , writeRowEnd = writeWord8 $ toEnum $ fromEnum 'E'
                    , inlineHack = return ()
                    }
                }
        return (outRef, t)