-- |Data types for floating window API codec.
module Ribosome.Data.FloatOptions where

import Ribosome.Host.Class.Msgpack.Encode (MsgpackEncode (toMsgpack))
import Ribosome.Host.Class.Msgpack.Map (msgpackMap)

-- |The reference point to which a floating window's position is defined.
data FloatRelative =
  Editor
  |
  Win
  |
  Cursor
  deriving stock (FloatRelative -> FloatRelative -> Bool
(FloatRelative -> FloatRelative -> Bool)
-> (FloatRelative -> FloatRelative -> Bool) -> Eq FloatRelative
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatRelative -> FloatRelative -> Bool
$c/= :: FloatRelative -> FloatRelative -> Bool
== :: FloatRelative -> FloatRelative -> Bool
$c== :: FloatRelative -> FloatRelative -> Bool
Eq, Int -> FloatRelative -> ShowS
[FloatRelative] -> ShowS
FloatRelative -> String
(Int -> FloatRelative -> ShowS)
-> (FloatRelative -> String)
-> ([FloatRelative] -> ShowS)
-> Show FloatRelative
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatRelative] -> ShowS
$cshowList :: [FloatRelative] -> ShowS
show :: FloatRelative -> String
$cshow :: FloatRelative -> String
showsPrec :: Int -> FloatRelative -> ShowS
$cshowsPrec :: Int -> FloatRelative -> ShowS
Show)

instance MsgpackEncode FloatRelative where
  toMsgpack :: FloatRelative -> Object
toMsgpack FloatRelative
Editor = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"editor" :: Text)
  toMsgpack FloatRelative
Win = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"win" :: Text)
  toMsgpack FloatRelative
Cursor = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"cursor" :: Text)

instance Default FloatRelative where
  def :: FloatRelative
def = FloatRelative
Cursor

-- |The corner of a floating window that is positioned at the specified coordinates.
data FloatAnchor =
  NW
  |
  NE
  |
  SW
  |
  SE
  deriving stock (FloatAnchor -> FloatAnchor -> Bool
(FloatAnchor -> FloatAnchor -> Bool)
-> (FloatAnchor -> FloatAnchor -> Bool) -> Eq FloatAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatAnchor -> FloatAnchor -> Bool
$c/= :: FloatAnchor -> FloatAnchor -> Bool
== :: FloatAnchor -> FloatAnchor -> Bool
$c== :: FloatAnchor -> FloatAnchor -> Bool
Eq, Int -> FloatAnchor -> ShowS
[FloatAnchor] -> ShowS
FloatAnchor -> String
(Int -> FloatAnchor -> ShowS)
-> (FloatAnchor -> String)
-> ([FloatAnchor] -> ShowS)
-> Show FloatAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatAnchor] -> ShowS
$cshowList :: [FloatAnchor] -> ShowS
show :: FloatAnchor -> String
$cshow :: FloatAnchor -> String
showsPrec :: Int -> FloatAnchor -> ShowS
$cshowsPrec :: Int -> FloatAnchor -> ShowS
Show)

instance MsgpackEncode FloatAnchor where
  toMsgpack :: FloatAnchor -> Object
toMsgpack FloatAnchor
NW = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"NW" :: Text)
  toMsgpack FloatAnchor
NE = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"NE" :: Text)
  toMsgpack FloatAnchor
SW = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"SW" :: Text)
  toMsgpack FloatAnchor
SE = Text -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack (Text
"SE" :: Text)

instance Default FloatAnchor where
  def :: FloatAnchor
def = FloatAnchor
NW

-- |The border style of a floating window.
data FloatBorder =
  None
  |
  Single
  |
  Double
  |
  Rounded
  |
  Solid
  |
  Shadow
  |
  -- |A list of characters that is drawn for the border, starting with the top left corner, going clockwise, repeating
  -- if too short.
  Manual [Text]
  deriving stock (FloatBorder -> FloatBorder -> Bool
(FloatBorder -> FloatBorder -> Bool)
-> (FloatBorder -> FloatBorder -> Bool) -> Eq FloatBorder
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatBorder -> FloatBorder -> Bool
$c/= :: FloatBorder -> FloatBorder -> Bool
== :: FloatBorder -> FloatBorder -> Bool
$c== :: FloatBorder -> FloatBorder -> Bool
Eq, Int -> FloatBorder -> ShowS
[FloatBorder] -> ShowS
FloatBorder -> String
(Int -> FloatBorder -> ShowS)
-> (FloatBorder -> String)
-> ([FloatBorder] -> ShowS)
-> Show FloatBorder
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatBorder] -> ShowS
$cshowList :: [FloatBorder] -> ShowS
show :: FloatBorder -> String
$cshow :: FloatBorder -> String
showsPrec :: Int -> FloatBorder -> ShowS
$cshowsPrec :: Int -> FloatBorder -> ShowS
Show, (forall x. FloatBorder -> Rep FloatBorder x)
-> (forall x. Rep FloatBorder x -> FloatBorder)
-> Generic FloatBorder
forall x. Rep FloatBorder x -> FloatBorder
forall x. FloatBorder -> Rep FloatBorder x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FloatBorder x -> FloatBorder
$cfrom :: forall x. FloatBorder -> Rep FloatBorder x
Generic)

instance MsgpackEncode FloatBorder where
  toMsgpack :: FloatBorder -> Object
toMsgpack = \case
    FloatBorder
None -> forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"none"
    FloatBorder
Single -> forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"single"
    FloatBorder
Double -> forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"double"
    FloatBorder
Rounded -> forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"rounded"
    FloatBorder
Solid -> forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"solid"
    FloatBorder
Shadow -> forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"shadow"
    Manual [Text]
cs -> [Text] -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack [Text]
cs

instance Default FloatBorder where
  def :: FloatBorder
def =
    FloatBorder
Rounded

-- |Neovim has a style option for floating windows that sets a few options in bulk, with only one possible value.
data FloatStyle =
  FloatStyleMinimal
  deriving stock (FloatStyle -> FloatStyle -> Bool
(FloatStyle -> FloatStyle -> Bool)
-> (FloatStyle -> FloatStyle -> Bool) -> Eq FloatStyle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatStyle -> FloatStyle -> Bool
$c/= :: FloatStyle -> FloatStyle -> Bool
== :: FloatStyle -> FloatStyle -> Bool
$c== :: FloatStyle -> FloatStyle -> Bool
Eq, Int -> FloatStyle -> ShowS
[FloatStyle] -> ShowS
FloatStyle -> String
(Int -> FloatStyle -> ShowS)
-> (FloatStyle -> String)
-> ([FloatStyle] -> ShowS)
-> Show FloatStyle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatStyle] -> ShowS
$cshowList :: [FloatStyle] -> ShowS
show :: FloatStyle -> String
$cshow :: FloatStyle -> String
showsPrec :: Int -> FloatStyle -> ShowS
$cshowsPrec :: Int -> FloatStyle -> ShowS
Show)

instance Default FloatStyle where
  def :: FloatStyle
def =
    FloatStyle
FloatStyleMinimal

instance MsgpackEncode FloatStyle where
  toMsgpack :: FloatStyle -> Object
toMsgpack FloatStyle
FloatStyleMinimal =
    forall a. MsgpackEncode a => a -> Object
toMsgpack @Text Text
"minimal"

-- |The z-index of a floating window, determining occlusion.
newtype FloatZindex =
  FloatZindex { FloatZindex -> Int
unFloatZindex :: Int }
  deriving stock (FloatZindex -> FloatZindex -> Bool
(FloatZindex -> FloatZindex -> Bool)
-> (FloatZindex -> FloatZindex -> Bool) -> Eq FloatZindex
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatZindex -> FloatZindex -> Bool
$c/= :: FloatZindex -> FloatZindex -> Bool
== :: FloatZindex -> FloatZindex -> Bool
$c== :: FloatZindex -> FloatZindex -> Bool
Eq, Int -> FloatZindex -> ShowS
[FloatZindex] -> ShowS
FloatZindex -> String
(Int -> FloatZindex -> ShowS)
-> (FloatZindex -> String)
-> ([FloatZindex] -> ShowS)
-> Show FloatZindex
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatZindex] -> ShowS
$cshowList :: [FloatZindex] -> ShowS
show :: FloatZindex -> String
$cshow :: FloatZindex -> String
showsPrec :: Int -> FloatZindex -> ShowS
$cshowsPrec :: Int -> FloatZindex -> ShowS
Show, (forall x. FloatZindex -> Rep FloatZindex x)
-> (forall x. Rep FloatZindex x -> FloatZindex)
-> Generic FloatZindex
forall x. Rep FloatZindex x -> FloatZindex
forall x. FloatZindex -> Rep FloatZindex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FloatZindex x -> FloatZindex
$cfrom :: forall x. FloatZindex -> Rep FloatZindex x
Generic)
  deriving newtype (Integer -> FloatZindex
FloatZindex -> FloatZindex
FloatZindex -> FloatZindex -> FloatZindex
(FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex)
-> (Integer -> FloatZindex)
-> Num FloatZindex
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> FloatZindex
$cfromInteger :: Integer -> FloatZindex
signum :: FloatZindex -> FloatZindex
$csignum :: FloatZindex -> FloatZindex
abs :: FloatZindex -> FloatZindex
$cabs :: FloatZindex -> FloatZindex
negate :: FloatZindex -> FloatZindex
$cnegate :: FloatZindex -> FloatZindex
* :: FloatZindex -> FloatZindex -> FloatZindex
$c* :: FloatZindex -> FloatZindex -> FloatZindex
- :: FloatZindex -> FloatZindex -> FloatZindex
$c- :: FloatZindex -> FloatZindex -> FloatZindex
+ :: FloatZindex -> FloatZindex -> FloatZindex
$c+ :: FloatZindex -> FloatZindex -> FloatZindex
Num, Num FloatZindex
Ord FloatZindex
Num FloatZindex
-> Ord FloatZindex -> (FloatZindex -> Rational) -> Real FloatZindex
FloatZindex -> Rational
forall a. Num a -> Ord a -> (a -> Rational) -> Real a
toRational :: FloatZindex -> Rational
$ctoRational :: FloatZindex -> Rational
Real, Int -> FloatZindex
FloatZindex -> Int
FloatZindex -> [FloatZindex]
FloatZindex -> FloatZindex
FloatZindex -> FloatZindex -> [FloatZindex]
FloatZindex -> FloatZindex -> FloatZindex -> [FloatZindex]
(FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex)
-> (Int -> FloatZindex)
-> (FloatZindex -> Int)
-> (FloatZindex -> [FloatZindex])
-> (FloatZindex -> FloatZindex -> [FloatZindex])
-> (FloatZindex -> FloatZindex -> [FloatZindex])
-> (FloatZindex -> FloatZindex -> FloatZindex -> [FloatZindex])
-> Enum FloatZindex
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: FloatZindex -> FloatZindex -> FloatZindex -> [FloatZindex]
$cenumFromThenTo :: FloatZindex -> FloatZindex -> FloatZindex -> [FloatZindex]
enumFromTo :: FloatZindex -> FloatZindex -> [FloatZindex]
$cenumFromTo :: FloatZindex -> FloatZindex -> [FloatZindex]
enumFromThen :: FloatZindex -> FloatZindex -> [FloatZindex]
$cenumFromThen :: FloatZindex -> FloatZindex -> [FloatZindex]
enumFrom :: FloatZindex -> [FloatZindex]
$cenumFrom :: FloatZindex -> [FloatZindex]
fromEnum :: FloatZindex -> Int
$cfromEnum :: FloatZindex -> Int
toEnum :: Int -> FloatZindex
$ctoEnum :: Int -> FloatZindex
pred :: FloatZindex -> FloatZindex
$cpred :: FloatZindex -> FloatZindex
succ :: FloatZindex -> FloatZindex
$csucc :: FloatZindex -> FloatZindex
Enum, Enum FloatZindex
Real FloatZindex
Real FloatZindex
-> Enum FloatZindex
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex))
-> (FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex))
-> (FloatZindex -> Integer)
-> Integral FloatZindex
FloatZindex -> Integer
FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex)
FloatZindex -> FloatZindex -> FloatZindex
forall a.
Real a
-> Enum a
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> (a, a))
-> (a -> a -> (a, a))
-> (a -> Integer)
-> Integral a
toInteger :: FloatZindex -> Integer
$ctoInteger :: FloatZindex -> Integer
divMod :: FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex)
$cdivMod :: FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex)
quotRem :: FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex)
$cquotRem :: FloatZindex -> FloatZindex -> (FloatZindex, FloatZindex)
mod :: FloatZindex -> FloatZindex -> FloatZindex
$cmod :: FloatZindex -> FloatZindex -> FloatZindex
div :: FloatZindex -> FloatZindex -> FloatZindex
$cdiv :: FloatZindex -> FloatZindex -> FloatZindex
rem :: FloatZindex -> FloatZindex -> FloatZindex
$crem :: FloatZindex -> FloatZindex -> FloatZindex
quot :: FloatZindex -> FloatZindex -> FloatZindex
$cquot :: FloatZindex -> FloatZindex -> FloatZindex
Integral, Eq FloatZindex
Eq FloatZindex
-> (FloatZindex -> FloatZindex -> Ordering)
-> (FloatZindex -> FloatZindex -> Bool)
-> (FloatZindex -> FloatZindex -> Bool)
-> (FloatZindex -> FloatZindex -> Bool)
-> (FloatZindex -> FloatZindex -> Bool)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> (FloatZindex -> FloatZindex -> FloatZindex)
-> Ord FloatZindex
FloatZindex -> FloatZindex -> Bool
FloatZindex -> FloatZindex -> Ordering
FloatZindex -> FloatZindex -> FloatZindex
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FloatZindex -> FloatZindex -> FloatZindex
$cmin :: FloatZindex -> FloatZindex -> FloatZindex
max :: FloatZindex -> FloatZindex -> FloatZindex
$cmax :: FloatZindex -> FloatZindex -> FloatZindex
>= :: FloatZindex -> FloatZindex -> Bool
$c>= :: FloatZindex -> FloatZindex -> Bool
> :: FloatZindex -> FloatZindex -> Bool
$c> :: FloatZindex -> FloatZindex -> Bool
<= :: FloatZindex -> FloatZindex -> Bool
$c<= :: FloatZindex -> FloatZindex -> Bool
< :: FloatZindex -> FloatZindex -> Bool
$c< :: FloatZindex -> FloatZindex -> Bool
compare :: FloatZindex -> FloatZindex -> Ordering
$ccompare :: FloatZindex -> FloatZindex -> Ordering
Ord)

instance MsgpackEncode FloatZindex where
  toMsgpack :: FloatZindex -> Object
toMsgpack (FloatZindex Int
i) =
    Int -> Object
forall a. MsgpackEncode a => a -> Object
toMsgpack Int
i

-- |The set of options accepted by the @float@ key of the argument to @nvim_open_win@, configuring the appearance and
-- geometry of a floating window.
data FloatOptions =
  FloatOptions {
    FloatOptions -> FloatRelative
relative :: FloatRelative,
    FloatOptions -> Int
width :: Int,
    FloatOptions -> Int
height :: Int,
    FloatOptions -> Int
row :: Int,
    FloatOptions -> Int
col :: Int,
    FloatOptions -> Bool
focusable :: Bool,
    FloatOptions -> FloatAnchor
anchor :: FloatAnchor,
    FloatOptions -> Maybe (Int, Int)
bufpos :: Maybe (Int, Int),
    FloatOptions -> FloatBorder
border :: FloatBorder,
    FloatOptions -> Bool
noautocmd :: Bool,
    FloatOptions -> Bool
enter :: Bool,
    FloatOptions -> Maybe FloatStyle
style :: Maybe FloatStyle,
    FloatOptions -> Maybe FloatZindex
zindex :: Maybe FloatZindex
  }
  deriving stock (FloatOptions -> FloatOptions -> Bool
(FloatOptions -> FloatOptions -> Bool)
-> (FloatOptions -> FloatOptions -> Bool) -> Eq FloatOptions
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FloatOptions -> FloatOptions -> Bool
$c/= :: FloatOptions -> FloatOptions -> Bool
== :: FloatOptions -> FloatOptions -> Bool
$c== :: FloatOptions -> FloatOptions -> Bool
Eq, Int -> FloatOptions -> ShowS
[FloatOptions] -> ShowS
FloatOptions -> String
(Int -> FloatOptions -> ShowS)
-> (FloatOptions -> String)
-> ([FloatOptions] -> ShowS)
-> Show FloatOptions
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FloatOptions] -> ShowS
$cshowList :: [FloatOptions] -> ShowS
show :: FloatOptions -> String
$cshow :: FloatOptions -> String
showsPrec :: Int -> FloatOptions -> ShowS
$cshowsPrec :: Int -> FloatOptions -> ShowS
Show, (forall x. FloatOptions -> Rep FloatOptions x)
-> (forall x. Rep FloatOptions x -> FloatOptions)
-> Generic FloatOptions
forall x. Rep FloatOptions x -> FloatOptions
forall x. FloatOptions -> Rep FloatOptions x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FloatOptions x -> FloatOptions
$cfrom :: forall x. FloatOptions -> Rep FloatOptions x
Generic)

instance MsgpackEncode FloatOptions where
  toMsgpack :: FloatOptions -> Object
toMsgpack FloatOptions {Bool
Int
Maybe (Int, Int)
Maybe FloatZindex
Maybe FloatStyle
FloatBorder
FloatAnchor
FloatRelative
zindex :: Maybe FloatZindex
style :: Maybe FloatStyle
enter :: Bool
noautocmd :: Bool
border :: FloatBorder
bufpos :: Maybe (Int, Int)
anchor :: FloatAnchor
focusable :: Bool
col :: Int
row :: Int
height :: Int
width :: Int
relative :: FloatRelative
$sel:zindex:FloatOptions :: FloatOptions -> Maybe FloatZindex
$sel:style:FloatOptions :: FloatOptions -> Maybe FloatStyle
$sel:enter:FloatOptions :: FloatOptions -> Bool
$sel:noautocmd:FloatOptions :: FloatOptions -> Bool
$sel:border:FloatOptions :: FloatOptions -> FloatBorder
$sel:bufpos:FloatOptions :: FloatOptions -> Maybe (Int, Int)
$sel:anchor:FloatOptions :: FloatOptions -> FloatAnchor
$sel:focusable:FloatOptions :: FloatOptions -> Bool
$sel:col:FloatOptions :: FloatOptions -> Int
$sel:row:FloatOptions :: FloatOptions -> Int
$sel:height:FloatOptions :: FloatOptions -> Int
$sel:width:FloatOptions :: FloatOptions -> Int
$sel:relative:FloatOptions :: FloatOptions -> FloatRelative
..} =
    (Text, FloatRelative)
-> (Text, Int)
-> (Text, Int)
-> (Text, Int)
-> (Text, Int)
-> (Text, Bool)
-> (Text, FloatAnchor)
-> (Text, Maybe (Int, Int))
-> (Text, FloatBorder)
-> (Text, Bool)
-> (Text, Maybe FloatStyle)
-> (Text, Maybe FloatZindex)
-> Object
forall a. MsgpackMap a => a
msgpackMap
    (Text
"relative", FloatRelative
relative)
    (Text
"width", Int
width)
    (Text
"height", Int
height)
    (Text
"row", Int
row)
    (Text
"col", Int
col)
    (Text
"focusable", Bool
focusable)
    (Text
"anchor", FloatAnchor
anchor)
    (Text
"bufpos", Maybe (Int, Int)
bufpos)
    (Text
"border", FloatBorder
border)
    (Text
"noautocmd", Bool
noautocmd)
    (Text
"style", Maybe FloatStyle
style)
    (Text
"zindex", Maybe FloatZindex
zindex)

instance Default FloatOptions where
  def :: FloatOptions
def =
    FloatRelative
-> Int
-> Int
-> Int
-> Int
-> Bool
-> FloatAnchor
-> Maybe (Int, Int)
-> FloatBorder
-> Bool
-> Bool
-> Maybe FloatStyle
-> Maybe FloatZindex
-> FloatOptions
FloatOptions FloatRelative
forall a. Default a => a
def Int
30 Int
10 Int
1 Int
1 Bool
False FloatAnchor
forall a. Default a => a
def Maybe (Int, Int)
forall a. Default a => a
def FloatBorder
forall a. Default a => a
def Bool
False Bool
True (FloatStyle -> Maybe FloatStyle
forall a. a -> Maybe a
Just FloatStyle
FloatStyleMinimal) Maybe FloatZindex
forall a. Maybe a
Nothing