mirror of
https://github.com/xmonad/xmonad-contrib.git
synced 2025-08-01 12:41:52 -07:00
Remove all derivations of Typeable
Typeable has been automatically derived for every type since GHC 7.10,
so remove these obsolete derivations. This also allows us to get rid of
the `DeriveDataTypeable` pragma quite naturally.
Related: https://github.com/xmonad/xmonad/pull/299 (xmonad/xmonad@9e5b16ed8a)
Related: bd5b969d9b
Fixes: https://github.com/xmonad/xmonad-contrib/issues/548
This commit is contained in:
@@ -1,7 +1,7 @@
|
||||
{-# LANGUAGE PatternGuards #-}
|
||||
{-# LANGUAGE PatternSynonyms #-}
|
||||
{-# LANGUAGE DoAndIfThenElse #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses, DeriveDataTypeable #-}
|
||||
{-# LANGUAGE FlexibleInstances, MultiParamTypeClasses #-}
|
||||
-----------------------------------------------------------------------------
|
||||
-- |
|
||||
-- Module : XMonad.Layout.BinarySpacePartition
|
||||
@@ -112,18 +112,18 @@ import Data.Ratio ((%))
|
||||
--
|
||||
|
||||
-- | Message for rotating the binary tree around the parent node of the window to the left or right
|
||||
data TreeRotate = RotateL | RotateR deriving Typeable
|
||||
data TreeRotate = RotateL | RotateR
|
||||
instance Message TreeRotate
|
||||
|
||||
-- | Message to balance the tree in some way (Balance retiles the windows, Equalize changes ratios)
|
||||
data TreeBalance = Balance | Equalize deriving Typeable
|
||||
data TreeBalance = Balance | Equalize
|
||||
instance Message TreeBalance
|
||||
|
||||
-- | Message for resizing one of the cells in the BSP
|
||||
data ResizeDirectional =
|
||||
ExpandTowardsBy Direction2D Rational
|
||||
| ShrinkFromBy Direction2D Rational
|
||||
| MoveSplitBy Direction2D Rational deriving Typeable
|
||||
| MoveSplitBy Direction2D Rational
|
||||
instance Message ResizeDirectional
|
||||
|
||||
-- | @ExpandTowards x@ is now the equivalent of @ExpandTowardsBy x 0.05@
|
||||
@@ -139,25 +139,25 @@ pattern MoveSplit :: Direction2D -> ResizeDirectional
|
||||
pattern MoveSplit d = MoveSplitBy d 0.05
|
||||
|
||||
-- | Message for rotating a split (horizontal/vertical) in the BSP
|
||||
data Rotate = Rotate deriving Typeable
|
||||
data Rotate = Rotate
|
||||
instance Message Rotate
|
||||
|
||||
-- | Message for swapping the left child of a split with the right child of split
|
||||
data Swap = Swap deriving Typeable
|
||||
data Swap = Swap
|
||||
instance Message Swap
|
||||
|
||||
-- | Message to cyclically select the parent node instead of the leaf
|
||||
data FocusParent = FocusParent deriving Typeable
|
||||
data FocusParent = FocusParent
|
||||
instance Message FocusParent
|
||||
|
||||
-- | Message to move nodes inside the tree
|
||||
data SelectMoveNode = SelectNode | MoveNode deriving Typeable
|
||||
data SelectMoveNode = SelectNode | MoveNode
|
||||
instance Message SelectMoveNode
|
||||
|
||||
data Axis = Horizontal | Vertical deriving (Show, Read, Eq)
|
||||
|
||||
-- | Message for shifting window by splitting its neighbour
|
||||
newtype SplitShiftDirectional = SplitShift Direction1D deriving Typeable
|
||||
newtype SplitShiftDirectional = SplitShift Direction1D
|
||||
instance Message SplitShiftDirectional
|
||||
|
||||
oppositeDirection :: Direction2D -> Direction2D
|
||||
|
Reference in New Issue
Block a user