{-# LANGUAGE OverloadedStrings, GeneralizedNewtypeDeriving #-}
module Clay.Display
(
-- * Float.

  float
, FloatStyle
, floatLeft
, floatRight
, clear
, Clear
, both
, clearLeft
, clearRight

-- * Position.

, Position
, position
, static, absolute, fixed, relative, sticky

-- * Display

, Display
, display
, inline, block, listItem, runIn, inlineBlock, table, displayTable, inlineTable, tableRowGroup
, tableHeaderGroup, tableFooterGroup, tableRow, tableColumnGroup, tableColumn
, tableCell, tableCaption, displayNone, displayInherit, flex
, inlineFlex, grid, inlineGrid

-- * Overlow

, Overflow
, scroll
, overflow, overflowX, overflowY

-- * Visibility.

, Visibility
, collapse, separate

, visibility

-- Clipping.

, Clip
, clip
, rect

-- * Opacity.

, opacity

-- * Z-index.

, zIndex

-- * Pointer-events.

, PointerEvents
, pointerEvents
, visiblePainted, visibleFill, visibleStroke, painted
, fillEvents, strokeEvents, allEvents

-- * Vertical align.

, VerticalAlign(..)
, middle, vAlignSub, vAlignSuper, textTop, textBottom, vAlignTop, vAlignBottom, vAlignBaseline

-- * Cursor

, Cursor(..)
, cursorUrl
, cursorDefault
, contextMenu, help, pointer, cursorProgress, wait
, cell, crosshair, cursorText, vText
, alias, cursorCopy, move, noDrop, notAllowed, grab, grabbing
, allScroll, colResize, rowResize, nResize, eResize, sResize, wResize
, neResize, nwResize, seResize, swResize, ewResize, nsResize, neswResize, nwseResize
, zoomIn, zoomOut
)
where

import Data.String

import Clay.Size
import Clay.Property
import Clay.Stylesheet
import Clay.Common
import Data.Text (Text)

-------------------------------------------------------------------------------

float :: FloatStyle -> Css
float :: FloatStyle -> Css
float = Key FloatStyle -> FloatStyle -> Css
forall a. Val a => Key a -> a -> Css
key Key FloatStyle
"float"

newtype FloatStyle = FloatStyle Value
  deriving (FloatStyle -> Value
(FloatStyle -> Value) -> Val FloatStyle
forall a. (a -> Value) -> Val a
value :: FloatStyle -> Value
$cvalue :: FloatStyle -> Value
Val,FloatStyle
FloatStyle -> None FloatStyle
forall a. a -> None a
none :: FloatStyle
$cnone :: FloatStyle
None,FloatStyle
FloatStyle -> Inherit FloatStyle
forall a. a -> Inherit a
inherit :: FloatStyle
$cinherit :: FloatStyle
Inherit)

floatLeft, floatRight :: FloatStyle
floatLeft :: FloatStyle
floatLeft = Value -> FloatStyle
FloatStyle Value
"left"
floatRight :: FloatStyle
floatRight = Value -> FloatStyle
FloatStyle Value
"right"

newtype Clear = Clear Value
  deriving (Clear -> Value
(Clear -> Value) -> Val Clear
forall a. (a -> Value) -> Val a
value :: Clear -> Value
$cvalue :: Clear -> Value
Val, Value -> Clear
(Value -> Clear) -> Other Clear
forall a. (Value -> a) -> Other a
other :: Value -> Clear
$cother :: Value -> Clear
Other, Clear
Clear -> None Clear
forall a. a -> None a
none :: Clear
$cnone :: Clear
None, Clear
Clear -> Inherit Clear
forall a. a -> Inherit a
inherit :: Clear
$cinherit :: Clear
Inherit)

both :: Clear
both :: Clear
both = Value -> Clear
Clear Value
"both"

clearLeft :: Clear
clearLeft :: Clear
clearLeft = Value -> Clear
Clear Value
"left"

clearRight :: Clear
clearRight :: Clear
clearRight = Value -> Clear
Clear Value
"right"

clear :: Clear -> Css
clear :: Clear -> Css
clear = Key Clear -> Clear -> Css
forall a. Val a => Key a -> a -> Css
key Key Clear
"clear"

-------------------------------------------------------------------------------

newtype Position = Position Value
  deriving (Position -> Value
(Position -> Value) -> Val Position
forall a. (a -> Value) -> Val a
value :: Position -> Value
$cvalue :: Position -> Value
Val, Value -> Position
(Value -> Position) -> Other Position
forall a. (Value -> a) -> Other a
other :: Value -> Position
$cother :: Value -> Position
Other, Position
Position -> Inherit Position
forall a. a -> Inherit a
inherit :: Position
$cinherit :: Position
Inherit)

static, absolute, fixed, relative, sticky :: Position

static :: Position
static   = Value -> Position
Position Value
"static"
absolute :: Position
absolute = Value -> Position
Position Value
"absolute"
fixed :: Position
fixed    = Value -> Position
Position Value
"fixed"
relative :: Position
relative = Value -> Position
Position Value
"relative"
sticky :: Position
sticky = Value -> Position
Position (Value -> Position) -> Value -> Position
forall a b. (a -> b) -> a -> b
$ Prefixed -> Value
Value (Prefixed
webkit Prefixed -> Prefixed -> Prefixed
forall a. Semigroup a => a -> a -> a
<> Text -> Prefixed
Plain Text
"sticky")

position :: Position -> Css
position :: Position -> Css
position = Key Position -> Position -> Css
forall a. Val a => Key a -> a -> Css
key Key Position
"position"

-------------------------------------------------------------------------------

newtype Display = Display Value
  deriving (Display -> Value
(Display -> Value) -> Val Display
forall a. (a -> Value) -> Val a
value :: Display -> Value
$cvalue :: Display -> Value
Val, Value -> Display
(Value -> Display) -> Other Display
forall a. (Value -> a) -> Other a
other :: Value -> Display
$cother :: Value -> Display
Other, Display
Display -> None Display
forall a. a -> None a
none :: Display
$cnone :: Display
None, Display
Display -> Inherit Display
forall a. a -> Inherit a
inherit :: Display
$cinherit :: Display
Inherit)

inline, block, listItem, runIn, inlineBlock, table, displayTable, inlineTable, tableRowGroup,
  tableHeaderGroup, tableFooterGroup, tableRow, tableColumnGroup, tableColumn,
  tableCell, tableCaption, displayNone, displayInherit, flex, inlineFlex, grid,
  inlineGrid :: Display

inline :: Display
inline           = Value -> Display
Display Value
"inline"
block :: Display
block            = Value -> Display
Display Value
"block"
listItem :: Display
listItem         = Value -> Display
Display Value
"list-item"
runIn :: Display
runIn            = Value -> Display
Display Value
"runIn"
inlineBlock :: Display
inlineBlock      = Value -> Display
Display Value
"inline-block"
displayTable :: Display
displayTable     = Value -> Display
Display Value
"table"
{-# DEPRECATED table "Use `displayTable` instead." #-}
table :: Display
table            = Value -> Display
Display Value
"table"
inlineTable :: Display
inlineTable      = Value -> Display
Display Value
"inline-table"
tableRowGroup :: Display
tableRowGroup    = Value -> Display
Display Value
"table-row-Group"
tableHeaderGroup :: Display
tableHeaderGroup = Value -> Display
Display Value
"table-header-group"
tableFooterGroup :: Display
tableFooterGroup = Value -> Display
Display Value
"table-footer-group"
tableRow :: Display
tableRow         = Value -> Display
Display Value
"table-row"
tableColumnGroup :: Display
tableColumnGroup = Value -> Display
Display Value
"table-column-group"
tableColumn :: Display
tableColumn      = Value -> Display
Display Value
"table-column"
tableCell :: Display
tableCell        = Value -> Display
Display Value
"table-cell"
tableCaption :: Display
tableCaption     = Value -> Display
Display Value
"table-caption"
displayNone :: Display
displayNone      = Value -> Display
Display Value
"none"
displayInherit :: Display
displayInherit   = Value -> Display
Display Value
"inherit"
flex :: Display
flex             = Value -> Display
Display Value
"flex"
inlineFlex :: Display
inlineFlex       = Value -> Display
Display Value
"inline-flex"
grid :: Display
grid             = Value -> Display
Display Value
"grid"
inlineGrid :: Display
inlineGrid       = Value -> Display
Display Value
"inline-grid"

display :: Display -> Css
display :: Display -> Css
display = Key Display -> Display -> Css
forall a. Val a => Key a -> a -> Css
key Key Display
"display"

-------------------------------------------------------------------------------

newtype Overflow = Overflow Value
  deriving (Overflow -> Value
(Overflow -> Value) -> Val Overflow
forall a. (a -> Value) -> Val a
value :: Overflow -> Value
$cvalue :: Overflow -> Value
Val, Value -> Overflow
(Value -> Overflow) -> Other Overflow
forall a. (Value -> a) -> Other a
other :: Value -> Overflow
$cother :: Value -> Overflow
Other, Overflow
Overflow -> Auto Overflow
forall a. a -> Auto a
auto :: Overflow
$cauto :: Overflow
Auto, Overflow
Overflow -> Inherit Overflow
forall a. a -> Inherit a
inherit :: Overflow
$cinherit :: Overflow
Inherit, Overflow
Overflow -> Hidden Overflow
forall a. a -> Hidden a
hidden :: Overflow
$chidden :: Overflow
Hidden, Overflow
Overflow -> Visible Overflow
forall a. a -> Visible a
visible :: Overflow
$cvisible :: Overflow
Visible)

scroll :: Overflow
scroll :: Overflow
scroll = Value -> Overflow
Overflow Value
"scroll"

overflow, overflowX, overflowY :: Overflow -> Css

overflow :: Overflow -> Css
overflow  = Key Overflow -> Overflow -> Css
forall a. Val a => Key a -> a -> Css
key Key Overflow
"overflow"
overflowX :: Overflow -> Css
overflowX = Key Overflow -> Overflow -> Css
forall a. Val a => Key a -> a -> Css
key Key Overflow
"overflow-x"
overflowY :: Overflow -> Css
overflowY = Key Overflow -> Overflow -> Css
forall a. Val a => Key a -> a -> Css
key Key Overflow
"overflow-y"

-------------------------------------------------------------------------------

newtype Visibility = Visibility Value
  deriving (Visibility -> Value
(Visibility -> Value) -> Val Visibility
forall a. (a -> Value) -> Val a
value :: Visibility -> Value
$cvalue :: Visibility -> Value
Val, Value -> Visibility
(Value -> Visibility) -> Other Visibility
forall a. (Value -> a) -> Other a
other :: Value -> Visibility
$cother :: Value -> Visibility
Other, Visibility
Visibility -> Inherit Visibility
forall a. a -> Inherit a
inherit :: Visibility
$cinherit :: Visibility
Inherit, Visibility
Visibility -> Hidden Visibility
forall a. a -> Hidden a
hidden :: Visibility
$chidden :: Visibility
Hidden, Visibility
Visibility -> Unset Visibility
forall a. a -> Unset a
unset :: Visibility
$cunset :: Visibility
Unset, Visibility
Visibility -> Visible Visibility
forall a. a -> Visible a
visible :: Visibility
$cvisible :: Visibility
Visible)

separate, collapse :: Visibility

collapse :: Visibility
collapse = Value -> Visibility
Visibility Value
"collapse"
separate :: Visibility
separate = Value -> Visibility
Visibility Value
"separate"

visibility :: Visibility -> Css
visibility :: Visibility -> Css
visibility = Key Visibility -> Visibility -> Css
forall a. Val a => Key a -> a -> Css
key Key Visibility
"visibility"

-------------------------------------------------------------------------------

newtype Clip = Clip Value
  deriving (Clip -> Value
(Clip -> Value) -> Val Clip
forall a. (a -> Value) -> Val a
value :: Clip -> Value
$cvalue :: Clip -> Value
Val, Value -> Clip
(Value -> Clip) -> Other Clip
forall a. (Value -> a) -> Other a
other :: Value -> Clip
$cother :: Value -> Clip
Other, Clip
Clip -> Auto Clip
forall a. a -> Auto a
auto :: Clip
$cauto :: Clip
Auto, Clip
Clip -> Inherit Clip
forall a. a -> Inherit a
inherit :: Clip
$cinherit :: Clip
Inherit)

clip :: Clip -> Css
clip :: Clip -> Css
clip = Key Clip -> Clip -> Css
forall a. Val a => Key a -> a -> Css
key Key Clip
"clip"

rect :: Size a -> Size a -> Size a -> Size a -> Clip
rect :: Size a -> Size a -> Size a -> Size a -> Clip
rect Size a
t Size a
r Size a
b Size a
l = Value -> Clip
Clip ([Value] -> Value
forall a. Monoid a => [a] -> a
mconcat [Value
"rect(", Size a -> Value
forall a. Val a => a -> Value
value Size a
t, Value
",", Size a -> Value
forall a. Val a => a -> Value
value Size a
r, Value
",", Size a -> Value
forall a. Val a => a -> Value
value Size a
b, Value
",", Size a -> Value
forall a. Val a => a -> Value
value Size a
l, Value
")"])

-------------------------------------------------------------------------------

opacity :: Double -> Css
opacity :: Double -> Css
opacity = Key Double -> Double -> Css
forall a. Val a => Key a -> a -> Css
key Key Double
"opacity"

zIndex :: Integer -> Css
zIndex :: Integer -> Css
zIndex Integer
i = Key Value -> Value -> Css
forall a. Val a => Key a -> a -> Css
key Key Value
"z-index" (String -> Value
forall a. IsString a => String -> a
fromString (Integer -> String
forall a. Show a => a -> String
show Integer
i) :: Value)

-------------------------------------------------------------------------------

newtype PointerEvents = PointerEvents Value
  deriving (PointerEvents -> Value
(PointerEvents -> Value) -> Val PointerEvents
forall a. (a -> Value) -> Val a
value :: PointerEvents -> Value
$cvalue :: PointerEvents -> Value
Val, Value -> PointerEvents
(Value -> PointerEvents) -> Other PointerEvents
forall a. (Value -> a) -> Other a
other :: Value -> PointerEvents
$cother :: Value -> PointerEvents
Other, PointerEvents
PointerEvents -> Auto PointerEvents
forall a. a -> Auto a
auto :: PointerEvents
$cauto :: PointerEvents
Auto, PointerEvents
PointerEvents -> Visible PointerEvents
forall a. a -> Visible a
visible :: PointerEvents
$cvisible :: PointerEvents
Visible, PointerEvents
PointerEvents -> None PointerEvents
forall a. a -> None a
none :: PointerEvents
$cnone :: PointerEvents
None, PointerEvents
PointerEvents -> Inherit PointerEvents
forall a. a -> Inherit a
inherit :: PointerEvents
$cinherit :: PointerEvents
Inherit)

visiblePainted, visibleFill, visibleStroke, painted,
  fillEvents, strokeEvents, allEvents :: PointerEvents

visiblePainted :: PointerEvents
visiblePainted = Value -> PointerEvents
PointerEvents Value
"visiblePainted"
visibleFill :: PointerEvents
visibleFill    = Value -> PointerEvents
PointerEvents Value
"visibleFill"
visibleStroke :: PointerEvents
visibleStroke  = Value -> PointerEvents
PointerEvents Value
"visibleStroke"
painted :: PointerEvents
painted        = Value -> PointerEvents
PointerEvents Value
"painted"
fillEvents :: PointerEvents
fillEvents     = Value -> PointerEvents
PointerEvents Value
"fill"
strokeEvents :: PointerEvents
strokeEvents   = Value -> PointerEvents
PointerEvents Value
"stroke"
allEvents :: PointerEvents
allEvents      = Value -> PointerEvents
PointerEvents Value
"all"

pointerEvents :: PointerEvents -> Css
pointerEvents :: PointerEvents -> Css
pointerEvents = Key PointerEvents -> PointerEvents -> Css
forall a. Val a => Key a -> a -> Css
key Key PointerEvents
"pointer-events"

-------------------------------------------------------------------------------

class (Val a) => VerticalAlign a where
    verticalAlign :: a -> Css
    verticalAlign = Key a -> a -> Css
forall a. Val a => Key a -> a -> Css
key Key a
"vertical-align"

newtype VerticalAlignValue = VerticalAlignValue Value deriving (VerticalAlignValue -> Value
(VerticalAlignValue -> Value) -> Val VerticalAlignValue
forall a. (a -> Value) -> Val a
value :: VerticalAlignValue -> Value
$cvalue :: VerticalAlignValue -> Value
Val, VerticalAlignValue
VerticalAlignValue -> Baseline VerticalAlignValue
forall a. a -> Baseline a
baseline :: VerticalAlignValue
$cbaseline :: VerticalAlignValue
Baseline)

instance VerticalAlign VerticalAlignValue
instance VerticalAlign (Size a)

middle,vAlignSub,vAlignSuper,textTop,textBottom,vAlignTop,vAlignBottom,vAlignBaseline :: VerticalAlignValue

middle :: VerticalAlignValue
middle = Value -> VerticalAlignValue
VerticalAlignValue Value
"middle"
vAlignSub :: VerticalAlignValue
vAlignSub = Value -> VerticalAlignValue
VerticalAlignValue Value
"sub"
vAlignBaseline :: VerticalAlignValue
vAlignBaseline = VerticalAlignValue
forall a. Baseline a => a
baseline
vAlignSuper :: VerticalAlignValue
vAlignSuper = Value -> VerticalAlignValue
VerticalAlignValue Value
"super"
textTop :: VerticalAlignValue
textTop = Value -> VerticalAlignValue
VerticalAlignValue Value
"text-top"
textBottom :: VerticalAlignValue
textBottom = Value -> VerticalAlignValue
VerticalAlignValue Value
"text-bottom"
vAlignTop :: VerticalAlignValue
vAlignTop = Value -> VerticalAlignValue
VerticalAlignValue Value
"top"
vAlignBottom :: VerticalAlignValue
vAlignBottom = Value -> VerticalAlignValue
VerticalAlignValue Value
"bottom"

-------------------------------------------------------------------------------

class (Val a) => Cursor a where
    cursor :: a -> Css
    cursor = Key a -> a -> Css
forall a. Val a => Key a -> a -> Css
key Key a
"cursor"

newtype CursorValue a = CursorValue Value deriving (CursorValue a -> Value
(CursorValue a -> Value) -> Val (CursorValue a)
forall a. CursorValue a -> Value
forall a. (a -> Value) -> Val a
value :: CursorValue a -> Value
$cvalue :: forall a. CursorValue a -> Value
Val,CursorValue a
CursorValue a -> Inherit (CursorValue a)
forall a. CursorValue a
forall a. a -> Inherit a
inherit :: CursorValue a
$cinherit :: forall a. CursorValue a
Inherit,CursorValue a
CursorValue a -> Auto (CursorValue a)
forall a. CursorValue a
forall a. a -> Auto a
auto :: CursorValue a
$cauto :: forall a. CursorValue a
Auto,CursorValue a
CursorValue a -> None (CursorValue a)
forall a. CursorValue a
forall a. a -> None a
none :: CursorValue a
$cnone :: forall a. CursorValue a
None)

instance Cursor (CursorValue a)

cursorUrl :: Text -> CursorValue Value
cursorUrl :: Text -> CursorValue Value
cursorUrl Text
u = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue (Value -> CursorValue Value) -> Value -> CursorValue Value
forall a b. (a -> b) -> a -> b
$ Text -> Value
forall a. Val a => a -> Value
value (Text
"url(\"" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
u Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\")")

-- Using the classification from https://developer.mozilla.org/en-US/docs/Web/CSS/cursor
cursorDefault
  , contextMenu, help, pointer, cursorProgress, wait
  , cell, crosshair, cursorText, vText
  , alias, cursorCopy, move, noDrop, notAllowed, grab, grabbing
  , allScroll, colResize, rowResize, nResize, eResize, sResize, wResize
  , neResize, nwResize, seResize, swResize, ewResize, nsResize, neswResize, nwseResize
  , zoomIn, zoomOut :: CursorValue Value

-- General
cursorDefault :: CursorValue Value
cursorDefault = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"default"

-- Links & status
contextMenu :: CursorValue Value
contextMenu = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"context-menu"
help :: CursorValue Value
help = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"help"
pointer :: CursorValue Value
pointer = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"pointer"
cursorProgress :: CursorValue Value
cursorProgress = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"progress"
wait :: CursorValue Value
wait = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"wait"

-- Selection
cell :: CursorValue Value
cell = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"cell"
crosshair :: CursorValue Value
crosshair = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"crosshair"
cursorText :: CursorValue Value
cursorText = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"text"
vText :: CursorValue Value
vText = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"vertical-text"

-- Drag & drop
alias :: CursorValue Value
alias = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"alias"
cursorCopy :: CursorValue Value
cursorCopy = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"copy"
move :: CursorValue Value
move = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"move"
noDrop :: CursorValue Value
noDrop = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"no-drop"
notAllowed :: CursorValue Value
notAllowed = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"not-allowed"
grab :: CursorValue Value
grab = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"grab"
grabbing :: CursorValue Value
grabbing = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"grabbing"

-- Resizing & scrolling
allScroll :: CursorValue Value
allScroll = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"all-scroll"
colResize :: CursorValue Value
colResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"col-resize"
rowResize :: CursorValue Value
rowResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"row-resize"
nResize :: CursorValue Value
nResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"n-resize"
eResize :: CursorValue Value
eResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"e-resize"
sResize :: CursorValue Value
sResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"s-resize"
wResize :: CursorValue Value
wResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"w-resize"

neResize :: CursorValue Value
neResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"ne-resize"
nwResize :: CursorValue Value
nwResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"nw-resize"
seResize :: CursorValue Value
seResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"se-resize"
swResize :: CursorValue Value
swResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"sw-resize"
ewResize :: CursorValue Value
ewResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"ew-resize"
nsResize :: CursorValue Value
nsResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"ns-resize"
neswResize :: CursorValue Value
neswResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"nesw-resize"
nwseResize :: CursorValue Value
nwseResize = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"nwse-resize"

-- Zooming
zoomIn :: CursorValue Value
zoomIn = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"zoom-in"
zoomOut :: CursorValue Value
zoomOut = Value -> CursorValue Value
forall a. Value -> CursorValue a
CursorValue Value
"zoom-out"