-- Copyright 2009-2010 Corey O'Connor
module Graphics.Vty.Debug
  ( MockWindow(..)
  , SpanConstructLog
  , regionForWindow
  , allSpansHaveWidth
  , spanOpsAffectedColumns
  , spanOpsAffectedRows
  , rowOpsAffectedColumns
  , isSetAttr
  )
where

import Graphics.Vty.Attributes
import Graphics.Vty.Image (DisplayRegion)
import Graphics.Vty.Span

import qualified Data.Vector as Vector

rowOpsAffectedColumns :: DisplayOps -> [Int]
rowOpsAffectedColumns :: DisplayOps -> [Int]
rowOpsAffectedColumns DisplayOps
ops
    = forall a. Vector a -> [a]
Vector.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
Vector.map SpanOps -> Int
spanOpsAffectedColumns DisplayOps
ops

allSpansHaveWidth :: DisplayOps -> Int -> Bool
allSpansHaveWidth :: DisplayOps -> Int -> Bool
allSpansHaveWidth DisplayOps
ops Int
expected
    = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all (forall a. Eq a => a -> a -> Bool
== Int
expected) forall a b. (a -> b) -> a -> b
$ forall a. Vector a -> [a]
Vector.toList forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> Vector a -> Vector b
Vector.map SpanOps -> Int
spanOpsAffectedColumns DisplayOps
ops

spanOpsAffectedRows :: DisplayOps -> Int
spanOpsAffectedRows :: DisplayOps -> Int
spanOpsAffectedRows DisplayOps
ops
    = forall a. Enum a => Int -> a
toEnum forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Vector a -> [a]
Vector.toList) (forall a. Vector a -> [a]
Vector.toList DisplayOps
ops))

type SpanConstructLog = [SpanConstructEvent]
data SpanConstructEvent = SpanSetAttr Attr

isSetAttr :: Attr -> SpanConstructEvent -> Bool
isSetAttr :: Attr -> SpanConstructEvent -> Bool
isSetAttr Attr
expectedAttr (SpanSetAttr Attr
inAttr)
    | Attr
inAttr forall a. Eq a => a -> a -> Bool
== Attr
expectedAttr = Bool
True
isSetAttr Attr
_attr SpanConstructEvent
_event = Bool
False

data MockWindow = MockWindow Int Int
    deriving (Int -> MockWindow -> ShowS
[MockWindow] -> ShowS
MockWindow -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MockWindow] -> ShowS
$cshowList :: [MockWindow] -> ShowS
show :: MockWindow -> String
$cshow :: MockWindow -> String
showsPrec :: Int -> MockWindow -> ShowS
$cshowsPrec :: Int -> MockWindow -> ShowS
Show, MockWindow -> MockWindow -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MockWindow -> MockWindow -> Bool
$c/= :: MockWindow -> MockWindow -> Bool
== :: MockWindow -> MockWindow -> Bool
$c== :: MockWindow -> MockWindow -> Bool
Eq)

regionForWindow :: MockWindow -> DisplayRegion
regionForWindow :: MockWindow -> DisplayRegion
regionForWindow (MockWindow Int
w Int
h) = (Int
w,Int
h)