-- GENERATED by C->Haskell Compiler, version 0.28.6 Switcheroo, 25 November 2017 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}
{-# LANGUAGE CPP, EmptyDataDecls, ExistentialQuantification, RoleAnnotations #-}


module Graphics.UI.FLTK.LowLevel.Fl_Types where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import qualified Foreign.Storable as C2HSImp






import Foreign
import Foreign.C hiding (CClock)
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import qualified Foreign.ForeignPtr.Unsafe as Unsafe
import Debug.Trace
import Control.Exception
import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import qualified Data.Text as T
import GHC.Stack
import qualified Data.ByteString as B
data SliderType = VertSliderType
                | HorSliderType
                | VertFillSliderType
                | HorFillSliderType
                | VertNiceSliderType
                | HorNiceSliderType
  deriving (Int -> SliderType -> ShowS
[SliderType] -> ShowS
SliderType -> String
(Int -> SliderType -> ShowS)
-> (SliderType -> String)
-> ([SliderType] -> ShowS)
-> Show SliderType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SliderType] -> ShowS
$cshowList :: [SliderType] -> ShowS
show :: SliderType -> String
$cshow :: SliderType -> String
showsPrec :: Int -> SliderType -> ShowS
$cshowsPrec :: Int -> SliderType -> ShowS
Show,SliderType -> SliderType -> Bool
(SliderType -> SliderType -> Bool)
-> (SliderType -> SliderType -> Bool) -> Eq SliderType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SliderType -> SliderType -> Bool
$c/= :: SliderType -> SliderType -> Bool
== :: SliderType -> SliderType -> Bool
$c== :: SliderType -> SliderType -> Bool
Eq,Eq SliderType
Eq SliderType =>
(SliderType -> SliderType -> Ordering)
-> (SliderType -> SliderType -> Bool)
-> (SliderType -> SliderType -> Bool)
-> (SliderType -> SliderType -> Bool)
-> (SliderType -> SliderType -> Bool)
-> (SliderType -> SliderType -> SliderType)
-> (SliderType -> SliderType -> SliderType)
-> Ord SliderType
SliderType -> SliderType -> Bool
SliderType -> SliderType -> Ordering
SliderType -> SliderType -> SliderType
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 :: SliderType -> SliderType -> SliderType
$cmin :: SliderType -> SliderType -> SliderType
max :: SliderType -> SliderType -> SliderType
$cmax :: SliderType -> SliderType -> SliderType
>= :: SliderType -> SliderType -> Bool
$c>= :: SliderType -> SliderType -> Bool
> :: SliderType -> SliderType -> Bool
$c> :: SliderType -> SliderType -> Bool
<= :: SliderType -> SliderType -> Bool
$c<= :: SliderType -> SliderType -> Bool
< :: SliderType -> SliderType -> Bool
$c< :: SliderType -> SliderType -> Bool
compare :: SliderType -> SliderType -> Ordering
$ccompare :: SliderType -> SliderType -> Ordering
$cp1Ord :: Eq SliderType
Ord)
instance Enum SliderType where
  succ :: SliderType -> SliderType
succ VertSliderType = SliderType
HorSliderType
  succ HorSliderType = SliderType
VertFillSliderType
  succ VertFillSliderType = SliderType
HorFillSliderType
  succ HorFillSliderType = SliderType
VertNiceSliderType
  succ VertNiceSliderType = SliderType
HorNiceSliderType
  succ HorNiceSliderType = String -> SliderType
forall a. HasCallStack => String -> a
error "SliderType.succ: HorNiceSliderType has no successor"

  pred :: SliderType -> SliderType
pred HorSliderType = SliderType
VertSliderType
  pred VertFillSliderType = SliderType
HorSliderType
  pred HorFillSliderType = SliderType
VertFillSliderType
  pred VertNiceSliderType = SliderType
HorFillSliderType
  pred HorNiceSliderType = SliderType
VertNiceSliderType
  pred VertSliderType = String -> SliderType
forall a. HasCallStack => String -> a
error "SliderType.pred: VertSliderType has no predecessor"

  enumFromTo :: SliderType -> SliderType -> [SliderType]
enumFromTo from :: SliderType
from to :: SliderType
to = SliderType -> [SliderType]
go SliderType
from
    where
      end :: Int
end = SliderType -> Int
forall a. Enum a => a -> Int
fromEnum SliderType
to
      go :: SliderType -> [SliderType]
go v :: SliderType
v = case Int -> Int -> Ordering
forall a. Ord a => a -> a -> Ordering
compare (SliderType -> Int
forall a. Enum a => a -> Int
fromEnum SliderType
v) Int
end of
                 LT -> SliderType
v SliderType -> [SliderType] -> [SliderType]
forall a. a -> [a] -> [a]
: SliderType -> [SliderType]
go (SliderType -> SliderType
forall a. Enum a => a -> a
succ SliderType
v)
                 EQ -> [SliderType
v]
                 GT -> []

  enumFrom :: SliderType -> [SliderType]
enumFrom from :: SliderType
from = SliderType -> SliderType -> [SliderType]
forall a. Enum a => a -> a -> [a]
enumFromTo SliderType
from SliderType
HorNiceSliderType

  fromEnum :: SliderType -> Int
fromEnum VertSliderType = 0
  fromEnum HorSliderType = 1
  fromEnum VertFillSliderType = 2
  fromEnum HorFillSliderType = 3
  fromEnum VertNiceSliderType = 4
  fromEnum HorNiceSliderType = 5

  toEnum :: Int -> SliderType
toEnum 0 = SliderType
VertSliderType
  toEnum 1 = SliderType
HorSliderType
  toEnum 2 = SliderType
VertFillSliderType
  toEnum 3 = SliderType
HorFillSliderType
  toEnum 4 = SliderType
VertNiceSliderType
  toEnum 5 = SliderType
HorNiceSliderType
  toEnum unmatched :: Int
unmatched = String -> SliderType
forall a. HasCallStack => String -> a
error ("SliderType.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 209 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data ScrollbarType = VertScrollbar
                   | HorScrollbar
  deriving (Int -> ScrollbarType -> ShowS
[ScrollbarType] -> ShowS
ScrollbarType -> String
(Int -> ScrollbarType -> ShowS)
-> (ScrollbarType -> String)
-> ([ScrollbarType] -> ShowS)
-> Show ScrollbarType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ScrollbarType] -> ShowS
$cshowList :: [ScrollbarType] -> ShowS
show :: ScrollbarType -> String
$cshow :: ScrollbarType -> String
showsPrec :: Int -> ScrollbarType -> ShowS
$cshowsPrec :: Int -> ScrollbarType -> ShowS
Show,ScrollbarType -> ScrollbarType -> Bool
(ScrollbarType -> ScrollbarType -> Bool)
-> (ScrollbarType -> ScrollbarType -> Bool) -> Eq ScrollbarType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ScrollbarType -> ScrollbarType -> Bool
$c/= :: ScrollbarType -> ScrollbarType -> Bool
== :: ScrollbarType -> ScrollbarType -> Bool
$c== :: ScrollbarType -> ScrollbarType -> Bool
Eq,Eq ScrollbarType
Eq ScrollbarType =>
(ScrollbarType -> ScrollbarType -> Ordering)
-> (ScrollbarType -> ScrollbarType -> Bool)
-> (ScrollbarType -> ScrollbarType -> Bool)
-> (ScrollbarType -> ScrollbarType -> Bool)
-> (ScrollbarType -> ScrollbarType -> Bool)
-> (ScrollbarType -> ScrollbarType -> ScrollbarType)
-> (ScrollbarType -> ScrollbarType -> ScrollbarType)
-> Ord ScrollbarType
ScrollbarType -> ScrollbarType -> Bool
ScrollbarType -> ScrollbarType -> Ordering
ScrollbarType -> ScrollbarType -> ScrollbarType
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 :: ScrollbarType -> ScrollbarType -> ScrollbarType
$cmin :: ScrollbarType -> ScrollbarType -> ScrollbarType
max :: ScrollbarType -> ScrollbarType -> ScrollbarType
$cmax :: ScrollbarType -> ScrollbarType -> ScrollbarType
>= :: ScrollbarType -> ScrollbarType -> Bool
$c>= :: ScrollbarType -> ScrollbarType -> Bool
> :: ScrollbarType -> ScrollbarType -> Bool
$c> :: ScrollbarType -> ScrollbarType -> Bool
<= :: ScrollbarType -> ScrollbarType -> Bool
$c<= :: ScrollbarType -> ScrollbarType -> Bool
< :: ScrollbarType -> ScrollbarType -> Bool
$c< :: ScrollbarType -> ScrollbarType -> Bool
compare :: ScrollbarType -> ScrollbarType -> Ordering
$ccompare :: ScrollbarType -> ScrollbarType -> Ordering
$cp1Ord :: Eq ScrollbarType
Ord)
instance Enum ScrollbarType where
  succ VertScrollbar = HorScrollbar
  succ HorScrollbar = error "ScrollbarType.succ: HorScrollbar has no successor"

  pred HorScrollbar = VertScrollbar
  pred VertScrollbar = error "ScrollbarType.pred: VertScrollbar has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from HorScrollbar

  fromEnum VertScrollbar = 0
  fromEnum HorScrollbar = 1

  toEnum 0 = VertScrollbar
  toEnum 1 = HorScrollbar
  toEnum unmatched = error ("ScrollbarType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 210 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data BrowserType = NormalBrowserType
                 | SelectBrowserType
                 | HoldBrowserType
                 | MultiBrowserType
  deriving (Show,Eq,Ord)
instance Enum BrowserType where
  succ NormalBrowserType = SelectBrowserType
  succ SelectBrowserType = HoldBrowserType
  succ HoldBrowserType = MultiBrowserType
  succ MultiBrowserType = error "BrowserType.succ: MultiBrowserType has no successor"

  pred SelectBrowserType = NormalBrowserType
  pred HoldBrowserType = SelectBrowserType
  pred MultiBrowserType = HoldBrowserType
  pred NormalBrowserType = error "BrowserType.pred: NormalBrowserType has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from MultiBrowserType

  fromEnum NormalBrowserType = 0
  fromEnum SelectBrowserType = 1
  fromEnum HoldBrowserType = 2
  fromEnum MultiBrowserType = 3

  toEnum 0 = NormalBrowserType
  toEnum 1 = SelectBrowserType
  toEnum 2 = HoldBrowserType
  toEnum 3 = MultiBrowserType
  toEnum unmatched = error ("BrowserType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 211 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data SortType = SortAscending
              | SortDescending
  deriving (Show,Eq,Ord)
instance Enum SortType where
  succ SortAscending = SortDescending
  succ SortDescending = error "SortType.succ: SortDescending has no successor"

  pred SortDescending = SortAscending
  pred SortAscending = error "SortType.pred: SortAscending has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SortDescending

  fromEnum SortAscending = 0
  fromEnum SortDescending = 1

  toEnum 0 = SortAscending
  toEnum 1 = SortDescending
  toEnum unmatched = error ("SortType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 212 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data FileBrowserType = FileBrowserFiles
                     | FileBrowserDirectories
  deriving (Show,Eq,Ord)
instance Enum FileBrowserType where
  succ FileBrowserFiles = FileBrowserDirectories
  succ FileBrowserDirectories = error "FileBrowserType.succ: FileBrowserDirectories has no successor"

  pred FileBrowserDirectories = FileBrowserFiles
  pred FileBrowserFiles = error "FileBrowserType.pred: FileBrowserFiles has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from FileBrowserDirectories

  fromEnum FileBrowserFiles = 0
  fromEnum FileBrowserDirectories = 1

  toEnum 0 = FileBrowserFiles
  toEnum 1 = FileBrowserDirectories
  toEnum unmatched = error ("FileBrowserType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 213 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data FileIconType = FileIconAny
                  | FileIconPlain
                  | FileIconFifo
                  | FileIconDevice
                  | FileIconLink
                  | FileIconDirectory
  deriving (Show,Eq,Ord)
instance Enum FileIconType where
  succ FileIconAny = FileIconPlain
  succ FileIconPlain = FileIconFifo
  succ FileIconFifo = FileIconDevice
  succ FileIconDevice = FileIconLink
  succ FileIconLink = FileIconDirectory
  succ FileIconDirectory = error "FileIconType.succ: FileIconDirectory has no successor"

  pred FileIconPlain = FileIconAny
  pred FileIconFifo = FileIconPlain
  pred FileIconDevice = FileIconFifo
  pred FileIconLink = FileIconDevice
  pred FileIconDirectory = FileIconLink
  pred FileIconAny = error "FileIconType.pred: FileIconAny has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from FileIconDirectory

  fromEnum FileIconAny = 0
  fromEnum FileIconPlain = 1
  fromEnum FileIconFifo = 2
  fromEnum FileIconDevice = 3
  fromEnum FileIconLink = 4
  fromEnum FileIconDirectory = 5

  toEnum 0 = FileIconAny
  toEnum 1 = FileIconPlain
  toEnum 2 = FileIconFifo
  toEnum 3 = FileIconDevice
  toEnum 4 = FileIconLink
  toEnum 5 = FileIconDirectory
  toEnum unmatched = error ("FileIconType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 214 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data FileIconProps = FileIconEnd
                   | FileIconColor
                   | FileIconLine
                   | FileIconClosedline
                   | FileIconPolygon
                   | FileIconOutlinepolygon
                   | FileIconVertex
  deriving (Show,Eq,Ord)
instance Enum FileIconProps where
  succ FileIconEnd = FileIconColor
  succ FileIconColor = FileIconLine
  succ FileIconLine = FileIconClosedline
  succ FileIconClosedline = FileIconPolygon
  succ FileIconPolygon = FileIconOutlinepolygon
  succ FileIconOutlinepolygon = FileIconVertex
  succ FileIconVertex = error "FileIconProps.succ: FileIconVertex has no successor"

  pred FileIconColor = FileIconEnd
  pred FileIconLine = FileIconColor
  pred FileIconClosedline = FileIconLine
  pred FileIconPolygon = FileIconClosedline
  pred FileIconOutlinepolygon = FileIconPolygon
  pred FileIconVertex = FileIconOutlinepolygon
  pred FileIconEnd = error "FileIconProps.pred: FileIconEnd has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from FileIconVertex

  fromEnum FileIconEnd = 0
  fromEnum FileIconColor = 1
  fromEnum FileIconLine = 2
  fromEnum FileIconClosedline = 3
  fromEnum FileIconPolygon = 4
  fromEnum FileIconOutlinepolygon = 5
  fromEnum FileIconVertex = 6

  toEnum 0 = FileIconEnd
  toEnum 1 = FileIconColor
  toEnum 2 = FileIconLine
  toEnum 3 = FileIconClosedline
  toEnum 4 = FileIconPolygon
  toEnum 5 = FileIconOutlinepolygon
  toEnum 6 = FileIconVertex
  toEnum unmatched = error ("FileIconProps.toEnum: Cannot match " ++ show unmatched)

{-# LINE 215 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data FileChooserType = FileChooserSingle
                     | FileChooserMulti
                     | FileChooserCreate
                     | FileChooserDirectory
  deriving (Show,Eq,Ord)
instance Enum FileChooserType where
  succ FileChooserSingle = FileChooserMulti
  succ FileChooserMulti = FileChooserCreate
  succ FileChooserCreate = FileChooserDirectory
  succ FileChooserDirectory = error "FileChooserType.succ: FileChooserDirectory has no successor"

  pred FileChooserMulti = FileChooserSingle
  pred FileChooserCreate = FileChooserMulti
  pred FileChooserDirectory = FileChooserCreate
  pred FileChooserSingle = error "FileChooserType.pred: FileChooserSingle has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from FileChooserDirectory

  fromEnum FileChooserSingle = 0
  fromEnum FileChooserMulti = 1
  fromEnum FileChooserCreate = 2
  fromEnum FileChooserDirectory = 4

  toEnum 0 = FileChooserSingle
  toEnum 1 = FileChooserMulti
  toEnum 2 = FileChooserCreate
  toEnum 4 = FileChooserDirectory
  toEnum unmatched = error ("FileChooserType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 216 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data ButtonType = NormalButtonType
                | ToggleButtonType
                | HiddenButtonType
                | RadioButtonType
  deriving (Show,Eq,Ord)
instance Enum ButtonType where
  succ NormalButtonType = ToggleButtonType
  succ ToggleButtonType = HiddenButtonType
  succ HiddenButtonType = RadioButtonType
  succ RadioButtonType = error "ButtonType.succ: RadioButtonType has no successor"

  pred ToggleButtonType = NormalButtonType
  pred HiddenButtonType = ToggleButtonType
  pred RadioButtonType = HiddenButtonType
  pred NormalButtonType = error "ButtonType.pred: NormalButtonType has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from RadioButtonType

  fromEnum NormalButtonType = 0
  fromEnum ToggleButtonType = 1
  fromEnum HiddenButtonType = 3
  fromEnum RadioButtonType = 102

  toEnum 0 = NormalButtonType
  toEnum 1 = ToggleButtonType
  toEnum 3 = HiddenButtonType
  toEnum 102 = RadioButtonType
  toEnum unmatched = error ("ButtonType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 217 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data TreeReasonType = TreeReasonNone
                    | TreeReasonSelected
                    | TreeReasonDeselected
                    | TreeReasonReselected
                    | TreeReasonOpened
                    | TreeReasonClosed
                    | TreeReasonDragged
  deriving (Show,Eq,Ord)
instance Enum TreeReasonType where
  succ TreeReasonNone = TreeReasonSelected
  succ TreeReasonSelected = TreeReasonDeselected
  succ TreeReasonDeselected = TreeReasonReselected
  succ TreeReasonReselected = TreeReasonOpened
  succ TreeReasonOpened = TreeReasonClosed
  succ TreeReasonClosed = TreeReasonDragged
  succ TreeReasonDragged = error "TreeReasonType.succ: TreeReasonDragged has no successor"

  pred TreeReasonSelected = TreeReasonNone
  pred TreeReasonDeselected = TreeReasonSelected
  pred TreeReasonReselected = TreeReasonDeselected
  pred TreeReasonOpened = TreeReasonReselected
  pred TreeReasonClosed = TreeReasonOpened
  pred TreeReasonDragged = TreeReasonClosed
  pred TreeReasonNone = error "TreeReasonType.pred: TreeReasonNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from TreeReasonDragged

  fromEnum TreeReasonNone = 0
  fromEnum TreeReasonSelected = 1
  fromEnum TreeReasonDeselected = 2
  fromEnum TreeReasonReselected = 3
  fromEnum TreeReasonOpened = 4
  fromEnum TreeReasonClosed = 5
  fromEnum TreeReasonDragged = 6

  toEnum 0 = TreeReasonNone
  toEnum 1 = TreeReasonSelected
  toEnum 2 = TreeReasonDeselected
  toEnum 3 = TreeReasonReselected
  toEnum 4 = TreeReasonOpened
  toEnum 5 = TreeReasonClosed
  toEnum 6 = TreeReasonDragged
  toEnum unmatched = error ("TreeReasonType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 218 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data MenuItemFlag = MenuItemNormal
                  | MenuItemInactive
                  | MenuItemToggle
                  | MenuItemValue
                  | MenuItemRadio
                  | MenuItemInvisible
                  | SubmenuPointer
                  | Submenu
                  | MenuItemDivider
                  | MenuItemHorizontal
  deriving (Show,Eq,Ord)
instance Enum MenuItemFlag where
  succ MenuItemNormal = MenuItemInactive
  succ MenuItemInactive = MenuItemToggle
  succ MenuItemToggle = MenuItemValue
  succ MenuItemValue = MenuItemRadio
  succ MenuItemRadio = MenuItemInvisible
  succ MenuItemInvisible = SubmenuPointer
  succ SubmenuPointer = Submenu
  succ Submenu = MenuItemDivider
  succ MenuItemDivider = MenuItemHorizontal
  succ MenuItemHorizontal = error "MenuItemFlag.succ: MenuItemHorizontal has no successor"

  pred MenuItemInactive = MenuItemNormal
  pred MenuItemToggle = MenuItemInactive
  pred MenuItemValue = MenuItemToggle
  pred MenuItemRadio = MenuItemValue
  pred MenuItemInvisible = MenuItemRadio
  pred SubmenuPointer = MenuItemInvisible
  pred Submenu = SubmenuPointer
  pred MenuItemDivider = Submenu
  pred MenuItemHorizontal = MenuItemDivider
  pred MenuItemNormal = error "MenuItemFlag.pred: MenuItemNormal has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from MenuItemHorizontal

  fromEnum MenuItemNormal = 0
  fromEnum MenuItemInactive = 1
  fromEnum MenuItemToggle = 2
  fromEnum MenuItemValue = 4
  fromEnum MenuItemRadio = 8
  fromEnum MenuItemInvisible = 16
  fromEnum SubmenuPointer = 32
  fromEnum Submenu = 64
  fromEnum MenuItemDivider = 128
  fromEnum MenuItemHorizontal = 256

  toEnum 0 = MenuItemNormal
  toEnum 1 = MenuItemInactive
  toEnum 2 = MenuItemToggle
  toEnum 4 = MenuItemValue
  toEnum 8 = MenuItemRadio
  toEnum 16 = MenuItemInvisible
  toEnum 32 = SubmenuPointer
  toEnum 64 = Submenu
  toEnum 128 = MenuItemDivider
  toEnum 256 = MenuItemHorizontal
  toEnum unmatched = error ("MenuItemFlag.toEnum: Cannot match " ++ show unmatched)

{-# LINE 219 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data ColorChooserMode = RgbMode
                      | ByteMode
                      | HexMode
                      | HsvMode
  deriving (Show,Eq,Ord)
instance Enum ColorChooserMode where
  succ RgbMode = ByteMode
  succ ByteMode = HexMode
  succ HexMode = HsvMode
  succ HsvMode = error "ColorChooserMode.succ: HsvMode has no successor"

  pred ByteMode = RgbMode
  pred HexMode = ByteMode
  pred HsvMode = HexMode
  pred RgbMode = error "ColorChooserMode.pred: RgbMode has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from HsvMode

  fromEnum RgbMode = 0
  fromEnum ByteMode = 1
  fromEnum HexMode = 2
  fromEnum HsvMode = 3

  toEnum 0 = RgbMode
  toEnum 1 = ByteMode
  toEnum 2 = HexMode
  toEnum 3 = HsvMode
  toEnum unmatched = error ("ColorChooserMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 220 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

newtype MenuItemFlags = MenuItemFlags [MenuItemFlag] deriving (Eq, Show, Ord)
allMenuItemFlags :: [MenuItemFlag]
allMenuItemFlags =
  [
     MenuItemInactive,
     MenuItemToggle,
     MenuItemValue,
     MenuItemRadio,
     MenuItemInvisible,
     SubmenuPointer,
     Submenu,
     MenuItemDivider,
     MenuItemHorizontal
  ]
data CursorType = NormalCursor
                | CaretCursor
                | DimCursor
                | BlockCursor
                | HeavyCursor
                | SimpleCursor
  deriving (Show,Eq,Ord)
instance Enum CursorType where
  succ NormalCursor = CaretCursor
  succ CaretCursor = DimCursor
  succ DimCursor = BlockCursor
  succ BlockCursor = HeavyCursor
  succ HeavyCursor = SimpleCursor
  succ SimpleCursor = error "CursorType.succ: SimpleCursor has no successor"

  pred CaretCursor = NormalCursor
  pred DimCursor = CaretCursor
  pred BlockCursor = DimCursor
  pred HeavyCursor = BlockCursor
  pred SimpleCursor = HeavyCursor
  pred NormalCursor = error "CursorType.pred: NormalCursor has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SimpleCursor

  fromEnum NormalCursor = 0
  fromEnum CaretCursor = 1
  fromEnum DimCursor = 2
  fromEnum BlockCursor = 3
  fromEnum HeavyCursor = 4
  fromEnum SimpleCursor = 5

  toEnum 0 = NormalCursor
  toEnum 1 = CaretCursor
  toEnum 2 = DimCursor
  toEnum 3 = BlockCursor
  toEnum 4 = HeavyCursor
  toEnum 5 = SimpleCursor
  toEnum unmatched = error ("CursorType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 235 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data PositionType = CursorPos
                  | CharacterPos
  deriving (Show,Eq,Ord)
instance Enum PositionType where
  succ CursorPos = CharacterPos
  succ CharacterPos = error "PositionType.succ: CharacterPos has no successor"

  pred CharacterPos = CursorPos
  pred CursorPos = error "PositionType.pred: CursorPos has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from CharacterPos

  fromEnum CursorPos = 0
  fromEnum CharacterPos = 1

  toEnum 0 = CursorPos
  toEnum 1 = CharacterPos
  toEnum unmatched = error ("PositionType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 236 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data DragType = DragNone
              | DragStartDnd
              | DragChar
              | DragWord
              | DragLine
  deriving (Show,Eq,Ord)
instance Enum DragType where
  succ DragNone = DragStartDnd
  succ DragStartDnd = DragChar
  succ DragChar = DragWord
  succ DragWord = DragLine
  succ DragLine = error "DragType.succ: DragLine has no successor"

  pred DragStartDnd = DragNone
  pred DragChar = DragStartDnd
  pred DragWord = DragChar
  pred DragLine = DragWord
  pred DragNone = error "DragType.pred: DragNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from DragLine

  fromEnum DragNone = (-2)
  fromEnum DragStartDnd = (-1)
  fromEnum DragChar = 0
  fromEnum DragWord = 1
  fromEnum DragLine = 2

  toEnum (-2) = DragNone
  toEnum (-1) = DragStartDnd
  toEnum 0 = DragChar
  toEnum 1 = DragWord
  toEnum 2 = DragLine
  toEnum unmatched = error ("DragType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 237 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data WrapTypeFl = WrapNoneFl
                | WrapAtColumnFl
                | WrapAtPixelFl
                | WrapAtBoundsFl
  deriving (Show,Eq,Ord)
instance Enum WrapTypeFl where
  succ WrapNoneFl = WrapAtColumnFl
  succ WrapAtColumnFl = WrapAtPixelFl
  succ WrapAtPixelFl = WrapAtBoundsFl
  succ WrapAtBoundsFl = error "WrapTypeFl.succ: WrapAtBoundsFl has no successor"

  pred WrapAtColumnFl = WrapNoneFl
  pred WrapAtPixelFl = WrapAtColumnFl
  pred WrapAtBoundsFl = WrapAtPixelFl
  pred WrapNoneFl = error "WrapTypeFl.pred: WrapNoneFl has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from WrapAtBoundsFl

  fromEnum WrapNoneFl = 0
  fromEnum WrapAtColumnFl = 1
  fromEnum WrapAtPixelFl = 2
  fromEnum WrapAtBoundsFl = 3

  toEnum 0 = WrapNoneFl
  toEnum 1 = WrapAtColumnFl
  toEnum 2 = WrapAtPixelFl
  toEnum 3 = WrapAtBoundsFl
  toEnum unmatched = error ("WrapTypeFl.toEnum: Cannot match " ++ show unmatched)

{-# LINE 238 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data WrapType = WrapNone | WrapAtColumn ColumnNumber | WrapAtPixel PixelPosition | WrapAtBounds deriving (Eq, Show, Ord)
data PageFormat = A0
                | A1
                | A2
                | A3
                | A4
                | A5
                | A6
                | A7
                | A8
                | A9
                | B0
                | B1
                | B2
                | B3
                | B4
                | B5
                | B6
                | B7
                | B8
                | B9
                | B10
                | C5E
                | DLE
                | Executive
                | Folio
                | Ledger
                | Legal
                | Letter
                | Tabloid
                | Envelope
                | Media
  deriving (Show,Eq,Ord)
instance Enum PageFormat where
  succ A0 = A1
  succ A1 = A2
  succ A2 = A3
  succ A3 = A4
  succ A4 = A5
  succ A5 = A6
  succ A6 = A7
  succ A7 = A8
  succ A8 = A9
  succ A9 = B0
  succ B0 = B1
  succ B1 = B2
  succ B2 = B3
  succ B3 = B4
  succ B4 = B5
  succ B5 = B6
  succ B6 = B7
  succ B7 = B8
  succ B8 = B9
  succ B9 = B10
  succ B10 = C5E
  succ C5E = DLE
  succ DLE = Executive
  succ Executive = Folio
  succ Folio = Ledger
  succ Ledger = Legal
  succ Legal = Letter
  succ Letter = Tabloid
  succ Tabloid = Envelope
  succ Envelope = Media
  succ Media = error "PageFormat.succ: Media has no successor"

  pred :: PageFormat -> PageFormat
pred A1 = PageFormat
A0
  pred A2 = PageFormat
A1
  pred A3 = PageFormat
A2
  pred A4 = PageFormat
A3
  pred A5 = PageFormat
A4
  pred A6 = PageFormat
A5
  pred A7 = PageFormat
A6
  pred A8 = PageFormat
A7
  pred A9 = PageFormat
A8
  pred B0 = PageFormat
A9
  pred B1 = PageFormat
B0
  pred B2 = PageFormat
B1
  pred B3 = PageFormat
B2
  pred B4 = PageFormat
B3
  pred B5 = PageFormat
B4
  pred B6 = PageFormat
B5
  pred B7 = PageFormat
B6
  pred B8 = PageFormat
B7
  pred B9 = PageFormat
B8
  pred B10 = PageFormat
B9
  pred C5E = PageFormat
B10
  pred DLE = PageFormat
C5E
  pred Executive = PageFormat
DLE
  pred Folio = PageFormat
Executive
  pred Ledger = PageFormat
Folio
  pred Legal = PageFormat
Ledger
  pred Letter = Legal
  pred Tabloid = PageFormat
Letter
  pred Envelope = PageFormat
Tabloid
  pred Media = PageFormat
Envelope
  pred A0 = String -> PageFormat
forall a. HasCallStack => String -> a
error "PageFormat.pred: A0 has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom :: PageFormat -> [PageFormat]
enumFrom from :: PageFormat
from = PageFormat -> PageFormat -> [PageFormat]
forall a. Enum a => a -> a -> [a]
enumFromTo PageFormat
from PageFormat
Media

  fromEnum :: PageFormat -> Int
fromEnum A0 = 0
  fromEnum A1 = 1
  fromEnum A2 = 2
  fromEnum A3 = 3
  fromEnum A4 = 4
  fromEnum A5 = 5
  fromEnum A6 = 6
  fromEnum A7 = 7
  fromEnum A8 = 8
  fromEnum A9 = 9
  fromEnum B0 = 10
  fromEnum B1 = 11
  fromEnum B2 = 12
  fromEnum B3 = 13
  fromEnum B4 = 14
  fromEnum B5 = 15
  fromEnum B6 = 16
  fromEnum B7 = 17
  fromEnum B8 = 18
  fromEnum B9 = 19
  fromEnum B10 = 20
  fromEnum C5E = 21
  fromEnum DLE = 22
  fromEnum Executive = 23
  fromEnum Folio = 24
  fromEnum Ledger = 25
  fromEnum Legal = 26
  fromEnum Letter = 27
  fromEnum Tabloid = 28
  fromEnum Envelope = 29
  fromEnum Media = 4096

  toEnum :: Int -> PageFormat
toEnum 0 = PageFormat
A0
  toEnum 1 = A1
  toEnum 2 = PageFormat
A2
  toEnum 3 = A3
  toEnum 4 = A4
  toEnum 5 = PageFormat
A5
  toEnum 6 = A6
  toEnum 7 = A7
  toEnum 8 = PageFormat
A8
  toEnum 9 = A9
  toEnum 10 = B0
  toEnum 11 = PageFormat
B1
  toEnum 12 = PageFormat
B2
  toEnum 13 = B3
  toEnum 14 = B4
  toEnum 15 = PageFormat
B5
  toEnum 16 = B6
  toEnum 17 = B7
  toEnum 18 = PageFormat
B8
  toEnum 19 = B9
  toEnum 20 = B10
  toEnum 21 = C5E
  toEnum 22 = DLE
  toEnum 23 = Executive
  toEnum 24 = Folio
  toEnum 25 = PageFormat
Ledger
  toEnum 26 = PageFormat
Legal
  toEnum 27 = PageFormat
Letter
  toEnum 28 = PageFormat
Tabloid
  toEnum 29 = PageFormat
Envelope
  toEnum 4096 = Media
  toEnum unmatched :: Int
unmatched = String -> PageFormat
forall a. HasCallStack => String -> a
error ("PageFormat.toEnum: Cannot match " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
unmatched)

{-# LINE 240 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data PageLayout = Portrait
                | Landscape
                | Reversed
                | Orientation
  deriving (Show,Eq,Ord)
instance Enum PageLayout where
  succ Portrait = Landscape
  succ Landscape = Reversed
  succ Reversed = Orientation
  succ Orientation = error "PageLayout.succ: Orientation has no successor"

  pred Landscape = Portrait
  pred Reversed = Landscape
  pred Orientation = Reversed
  pred Portrait = error "PageLayout.pred: Portrait has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from Orientation

  fromEnum Portrait = 0
  fromEnum Landscape = 256
  fromEnum Reversed = 512
  fromEnum Orientation = 768

  toEnum 0 = Portrait
  toEnum 256 = Landscape
  toEnum 512 = Reversed
  toEnum 768 = Orientation
  toEnum unmatched = error ("PageLayout.toEnum: Cannot match " ++ show unmatched)

{-# LINE 241 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data TableRowSelectMode = SelectNone
                        | SelectSingle
                        | SelectMulti
  deriving (Show,Eq,Ord)
instance Enum TableRowSelectMode where
  succ SelectNone = SelectSingle
  succ SelectSingle = SelectMulti
  succ SelectMulti = error "TableRowSelectMode.succ: SelectMulti has no successor"

  pred SelectSingle = SelectNone
  pred SelectMulti = SelectSingle
  pred SelectNone = error "TableRowSelectMode.pred: SelectNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from SelectMulti

  fromEnum SelectNone = 0
  fromEnum SelectSingle = 1
  fromEnum SelectMulti = 2

  toEnum 0 = SelectNone
  toEnum 1 = SelectSingle
  toEnum 2 = SelectMulti
  toEnum unmatched = error ("TableRowSelectMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 242 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data TableContext = ContextNone
                  | ContextStartPage
                  | ContextEndPage
                  | ContextRowHeader
                  | ContextColHeader
                  | ContextCell
                  | ContextTable
                  | ContextRCResize
  deriving (Show,Eq,Ord)
instance Enum TableContext where
  succ ContextNone = ContextStartPage
  succ ContextStartPage = ContextEndPage
  succ ContextEndPage = ContextRowHeader
  succ ContextRowHeader = ContextColHeader
  succ ContextColHeader = ContextCell
  succ ContextCell = ContextTable
  succ ContextTable = ContextRCResize
  succ ContextRCResize = error "TableContext.succ: ContextRCResize has no successor"

  pred ContextStartPage = ContextNone
  pred ContextEndPage = ContextStartPage
  pred ContextRowHeader = ContextEndPage
  pred ContextColHeader = ContextRowHeader
  pred ContextCell = ContextColHeader
  pred ContextTable = ContextCell
  pred ContextRCResize = ContextTable
  pred ContextNone = error "TableContext.pred: ContextNone has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from ContextRCResize

  fromEnum ContextNone = 0
  fromEnum ContextStartPage = 1
  fromEnum ContextEndPage = 2
  fromEnum ContextRowHeader = 4
  fromEnum ContextColHeader = 8
  fromEnum ContextCell = 16
  fromEnum ContextTable = 32
  fromEnum ContextRCResize = 64

  toEnum 0 = ContextNone
  toEnum 1 = ContextStartPage
  toEnum 2 = ContextEndPage
  toEnum 4 = ContextRowHeader
  toEnum 8 = ContextColHeader
  toEnum 16 = ContextCell
  toEnum 32 = ContextTable
  toEnum 64 = ContextRCResize
  toEnum unmatched = error ("TableContext.toEnum: Cannot match " ++ show unmatched)

{-# LINE 243 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data LinePosition = LinePositionTop
                  | LinePositionBottom
                  | LinePositionMiddle
  deriving (Show,Eq,Ord)
instance Enum LinePosition where
  succ LinePositionTop = LinePositionBottom
  succ LinePositionBottom = LinePositionMiddle
  succ LinePositionMiddle = error "LinePosition.succ: LinePositionMiddle has no successor"

  pred LinePositionBottom = LinePositionTop
  pred LinePositionMiddle = LinePositionBottom
  pred LinePositionTop = error "LinePosition.pred: LinePositionTop has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from LinePositionMiddle

  fromEnum LinePositionTop = 0
  fromEnum LinePositionBottom = 1
  fromEnum LinePositionMiddle = 2

  toEnum 0 = LinePositionTop
  toEnum 1 = LinePositionBottom
  toEnum 2 = LinePositionMiddle
  toEnum unmatched = error ("LinePosition.toEnum: Cannot match " ++ show unmatched)

{-# LINE 244 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data ScrollbarMode = HorizontalScrollBar
                   | VerticalScrollBar
                   | BothScrollBar
                   | AlwaysOnScrollBar
                   | HorizontalAlwaysScrollBar
                   | VerticalAlwaysScrollBar
                   | BothAlwaysScrollBar
  deriving (Show,Eq,Ord)
instance Enum ScrollbarMode where
  succ HorizontalScrollBar = VerticalScrollBar
  succ VerticalScrollBar = BothScrollBar
  succ BothScrollBar = AlwaysOnScrollBar
  succ AlwaysOnScrollBar = HorizontalAlwaysScrollBar
  succ HorizontalAlwaysScrollBar = VerticalAlwaysScrollBar
  succ VerticalAlwaysScrollBar = BothAlwaysScrollBar
  succ BothAlwaysScrollBar = error "ScrollbarMode.succ: BothAlwaysScrollBar has no successor"

  pred VerticalScrollBar = HorizontalScrollBar
  pred BothScrollBar = VerticalScrollBar
  pred AlwaysOnScrollBar = BothScrollBar
  pred HorizontalAlwaysScrollBar = AlwaysOnScrollBar
  pred VerticalAlwaysScrollBar = HorizontalAlwaysScrollBar
  pred BothAlwaysScrollBar = VerticalAlwaysScrollBar
  pred HorizontalScrollBar = error "ScrollbarMode.pred: HorizontalScrollBar has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from BothAlwaysScrollBar

  fromEnum HorizontalScrollBar = 1
  fromEnum VerticalScrollBar = 2
  fromEnum BothScrollBar = 3
  fromEnum AlwaysOnScrollBar = 4
  fromEnum HorizontalAlwaysScrollBar = 5
  fromEnum VerticalAlwaysScrollBar = 6
  fromEnum BothAlwaysScrollBar = 7

  toEnum 1 = HorizontalScrollBar
  toEnum 2 = VerticalScrollBar
  toEnum 3 = BothScrollBar
  toEnum 4 = AlwaysOnScrollBar
  toEnum 5 = HorizontalAlwaysScrollBar
  toEnum 6 = VerticalAlwaysScrollBar
  toEnum 7 = BothAlwaysScrollBar
  toEnum unmatched = error ("ScrollbarMode.toEnum: Cannot match " ++ show unmatched)

{-# LINE 245 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

data StyleTableEntry = StyleTableEntry (Maybe Color) (Maybe Font) (Maybe FontSize) deriving (Eq, Show, Ord)
data PackType = PackVertical
              | PackHorizontal
  deriving (Show,Eq,Ord)
instance Enum PackType where
  succ PackVertical = PackHorizontal
  succ PackHorizontal = error "PackType.succ: PackHorizontal has no successor"

  pred PackHorizontal = PackVertical
  pred PackVertical = error "PackType.pred: PackVertical has no predecessor"

  enumFromTo from to = go from
    where
      end = fromEnum to
      go v = case compare (fromEnum v) end of
                 LT -> v : go (succ v)
                 EQ -> [v]
                 GT -> []

  enumFrom from = enumFromTo from PackHorizontal

  fromEnum PackVertical = 0
  fromEnum PackHorizontal = 1

  toEnum 0 = PackVertical
  toEnum 1 = PackHorizontal
  toEnum unmatched = error ("PackType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 247 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type FlShortcut      = (C2HSImp.CUInt)
{-# LINE 248 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type FlColor         = (C2HSImp.CUInt)
{-# LINE 249 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type FlFont          = (C2HSImp.CInt)
{-# LINE 250 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type FlAlign         = (C2HSImp.CUInt)
{-# LINE 251 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type LineDelta       = Maybe Int
type Delta           = Maybe Int
type FlIntPtr        = (C2HSImp.CLong)
{-# LINE 254 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type FlUIntPtr       = (C2HSImp.CULong)
{-# LINE 255 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type ID              = ((C2HSImp.Ptr ()))
{-# LINE 256 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type Fl_Offscreen = (C2HSImp.CULong)
{-# LINE 257 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type Fl_Socket = (C2HSImp.CInt)
{-# LINE 258 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type Fl_Bitmask = (C2HSImp.CULong)
{-# LINE 259 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

type Fl_Region = ((C2HSImp.Ptr ()))
{-# LINE 260 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

newtype WindowHandle = WindowHandle (Ptr ())

newtype NumInserted = NumInserted Int deriving (Show, Eq, Ord)
newtype NumDeleted = NumDeleted Int deriving (Show, Eq, Ord)
newtype NumRestyled = NumRestyled Int deriving (Show, Eq, Ord)
newtype DeletedText = DeletedText T.Text deriving (Show, Eq, Ord)

type role Ref nominal
data Ref a           = Ref !(ForeignPtr (Ptr ())) deriving (Eq, Show, Ord)
data FunRef          = FunRef !(FunPtr ())
-- * The FLTK widget hierarchy
data CBase parent
type Base = CBase ()

type GlobalCallback              = IO ()
type CallbackWithUserDataPrim    = Ptr () -> Ptr () -> IO ()
type CallbackPrim                = Ptr () -> IO ()
type OpenCallback                = T.Text -> IO ()
type OpenCallbackPrim            = CString -> IO ()
type CustomColorAveragePrim      = Ptr () -> CUInt -> CFloat -> IO ()
type CustomImageDrawPrim         = Ptr () -> CInt -> CInt -> CInt -> CInt -> CInt -> CInt -> IO ()
type CustomImageCopyPrim         = Ptr () -> CInt -> CInt -> IO (Ptr ())
type GlobalEventHandlerPrim      = CInt -> IO CInt
type GlobalEventHandlerF         = Event -> IO Int
type DrawCallback                = T.Text -> Position -> IO ()
type DrawCallbackPrim            = CString -> CInt -> CInt -> CInt -> IO ()
type TextBufferCallback          = FunPtr (Ptr () -> IO ())
type FileChooserCallback         = FunPtr (Ptr () -> Ptr () -> IO())
type SharedImageHandler          = FunPtr (CString -> CUChar -> CInt -> Ptr ())
type BoxDrawF                    = Rectangle -> Color -> IO ()
type BoxDrawFPrim                = CInt -> CInt -> CInt -> CInt -> FlColor -> IO ()
type FDHandlerPrim               = Fl_Socket -> Ptr () -> IO ()
type FDHandler                   = FlSocket -> IO ()
type TextModifyCb                = AtIndex -> NumInserted -> NumDeleted -> NumRestyled -> DeletedText -> IO ()
type TextModifyCbPrim            = CInt -> CInt -> CInt -> CInt -> Ptr CChar -> Ptr () -> IO ()
type TextPredeleteCb             = AtIndex -> NumDeleted -> IO ()
type TextPredeleteCbPrim         = CInt -> CInt -> Ptr () -> IO ()
type UnfinishedStyleCb           = AtIndex -> IO ()
type UnfinishedStyleCbPrim       = CInt -> Ptr () -> IO ()
type MenuItemDrawF               = Ptr () -> CInt -> CInt -> CInt -> CInt -> Ptr () -> CInt -> IO ()
type TabPositionsPrim            = Ptr () -> Ptr CInt -> Ptr CInt -> IO CInt
type TabHeightPrim               = Ptr () -> IO CInt
type TabWhichPrim                = Ptr () -> CInt -> CInt -> IO (Ptr ())
type TabClientAreaPrim           = Ptr () -> Ptr CInt -> Ptr CInt ->  Ptr CInt -> Ptr CInt -> CInt -> IO ()
type GetDoublePrim               = Ptr () -> IO (CDouble)
type GetIntPrim                  = Ptr () -> IO CInt
type SetIntPrim                  = Ptr () -> CInt -> IO ()
type ColorSetPrim                = Ptr () -> CDouble -> CDouble -> CDouble -> IO CInt
type DestroyCallbacksPrim        = Ptr () -> Ptr () -> IO ()

newtype Width = Width Int deriving (Eq, Show, Ord)
newtype Height = Height Int deriving (Eq, Show, Ord)
newtype PreciseWidth = PreciseWidth Double deriving (Eq, Show, Ord)
newtype PreciseHeight = PreciseHeight Double deriving (Eq, Show, Ord)
newtype Depth = Depth Int deriving (Eq, Show, Ord)
newtype LineSize = LineSize Int deriving (Eq, Show, Ord)
newtype X = X Int deriving (Eq, Show, Ord)
newtype PreciseX = PreciseX Double deriving (Eq, Show, Ord)
newtype Y = Y Int deriving (Eq, Show, Ord)
newtype PreciseY = PreciseY Double deriving (Eq, Show, Ord)
newtype ByX = ByX Double deriving (Eq, Show, Ord)
newtype ByY = ByY Double deriving (Eq, Show, Ord)
newtype Angle = Angle CShort deriving (Eq, Show, Ord)
newtype PreciseAngle = PreciseAngle Double deriving (Eq, Show, Ord)
data Position = Position X Y deriving (Eq, Show, Ord)
data PrecisePosition = PrecisePosition PreciseX PreciseY deriving (Eq, Show, Ord)
data CountDirection = CountUp | CountDown deriving (Eq, Show, Ord)
data DPI = DPI Float Float deriving (Eq, Show, Ord)
newtype TextDisplayStyle = TextDisplayStyle CInt deriving (Eq, Show, Ord)
data IndexRange = IndexRange AtIndex AtIndex deriving (Eq, Show, Ord)
statusToIndexRange :: (Ptr CInt -> Ptr CInt -> IO Int) -> IO (Maybe IndexRange)
statusToIndexRange f =
  alloca $ \start' ->
  alloca $ \end' ->
  f start' end' >>= \status' ->
  case status' of
    0 -> return Nothing
    _ -> do
      start'' <- peekIntConv start'
      end'' <- peekIntConv end'
      return (Just (IndexRange (AtIndex start'') (AtIndex end'')))

data ColorChooserRGB = Decimals (Between0And1, Between0And1, Between0And1) | Words RGB deriving (Eq, Show, Ord)
data Rectangle = Rectangle { rectanglePosition :: Position , rectangleSize :: Size } deriving (Eq, Show, Ord)
data ByXY = ByXY ByX ByY deriving (Eq, Show, Ord)
data Intersection = Contained | Partial deriving (Eq, Show, Ord)
data Size = Size Width Height deriving (Eq, Show, Ord)
data PreciseSize = PreciseSize PreciseWidth PreciseHeight deriving (Eq, Show, Ord)
newtype Lines = Lines Int deriving (Eq,Show,Ord)
newtype LineNumber = LineNumber Int deriving (Eq,Show,Ord)
newtype ColumnNumber = ColumnNumber Int deriving (Eq, Show, Ord)
newtype PixelPosition = PixelPosition Int deriving (Eq,Show,Ord)
newtype AtIndex = AtIndex Int deriving (Eq,Show,Ord)
newtype Rows = Rows Int deriving (Eq,Show,Ord)
newtype Columns = Columns Int deriving (Eq,Show,Ord)
data KeyType = SpecialKeyType SpecialKey | NormalKeyType Char deriving (Eq, Show, Ord)
data ShortcutKeySequence = ShortcutKeySequence [EventState] KeyType deriving (Eq, Show, Ord)
data Shortcut = KeySequence ShortcutKeySequence | KeyFormat T.Text deriving (Eq, Show, Ord)
data KeyBindingKeySequence = KeyBindingKeySequence (Maybe [EventState]) KeyType deriving (Eq, Show, Ord)
newtype Between0And1 = Between0And1 Double deriving (Eq, Show, Ord)
newtype Between0And6 = Between0And6 Double deriving (Eq, Show, Ord)
data ScreenLocation = Intersect Rectangle
                    | ScreenNumber Int
                    | ScreenPosition Position deriving (Eq, Show, Ord)
newtype FontSize = FontSize CInt deriving (Eq, Show, Ord)
newtype PixmapHs = PixmapHs [T.Text] deriving (Eq, Show, Ord)
data BitmapHs = BitmapHs B.ByteString Size deriving (Eq, Show, Ord)
data Clipboard = InternalClipboard | SharedClipboard deriving (Eq, Show, Ord)
data OutOfRangeOrNotSubmenu = OutOfRangeOrNotSubmenu deriving (Eq, Show, Ord)
-- | The type of 'Fl_Offscreen' varies wildly from platform to platform. Feel free to examine the insides when debugging
-- but any computation based on it will probably not be portable.
newtype FlOffscreen = FlOffscreen Fl_Offscreen
newtype FlBitmask = FlBitmask Fl_Bitmask
newtype FlRegion = FlRegion Fl_Region
newtype FlSocket = FlSocket Fl_Socket
type Fl_GlContext = ((C2HSImp.Ptr ()))
{-# LINE 377 "src/Graphics/UI/FLTK/LowLevel/Fl_Types.chs" #-}

newtype FlGlContext = FlGlContext Fl_GlContext
successOrOutOfRangeOrNotSubmenu :: Int -> Either OutOfRangeOrNotSubmenu ()
successOrOutOfRangeOrNotSubmenu status = if (status == (-1)) then Left OutOfRangeOrNotSubmenu else Right ()
data AwakeRingFull = AwakeRingFull deriving (Eq, Show, Ord)
successOrAwakeRingFull :: Int -> Either AwakeRingFull ()
successOrAwakeRingFull status = if (status == (-1)) then Left AwakeRingFull else Right ()
data UnknownEvent = UnknownEvent deriving (Eq, Show, Ord)
successOrUnknownEvent :: Int -> Either UnknownEvent ()
successOrUnknownEvent status = if (status == 0) then Left UnknownEvent else Right ()
data UnknownError = UnknownError deriving (Eq, Show, Ord)
successOrUnknownError :: a -> Int -> Either UnknownError a
successOrUnknownError a result = if (result == 0) then (Left UnknownError) else (Right a)
data NotFound = NotFound deriving (Eq, Show, Ord)
data OutOfRange = OutOfRange deriving (Eq, Show, Ord)
successOrOutOfRange :: a -> Bool -> (a -> IO b) -> IO (Either OutOfRange b)
successOrOutOfRange a pred' tr = if pred' then return (Left OutOfRange) else tr a >>= return . Right
data NoChange = NoChange deriving (Eq, Show, Ord)
successOrNoChange :: Int -> Either NoChange ()
successOrNoChange status = if (status == 0) then Left NoChange else Right ()
data DataProcessingError = NoDataProcessedError | PartialDataProcessedError | UnknownDataError Int
successOrDataProcessingError :: Int -> Either DataProcessingError ()
successOrDataProcessingError status = case status of
  0 -> Right ()
  1 -> Left NoDataProcessedError
  2 -> Left PartialDataProcessedError
  x -> Left $ UnknownDataError x
newtype PreferredSize = PreferredSize Int deriving (Eq, Show, Ord)
newtype GapSize = GapSize Int deriving (Eq, Show, Ord)
data DrawShortcut = NormalDrawShortcut | ElideAmpersandDrawShortcut deriving (Eq,Show,Ord)
data ResolveImageLabelConflict = ResolveImageLabelOverwrite | ResolveImageLabelDoNothing deriving (Show)
data MultiLabelShrinkError = MultiLabelShrinkError deriving Show
toRectangle :: (Int,Int,Int,Int) -> Rectangle
toRectangle (x_pos, y_pos, width, height) =
    Rectangle (Position
               (X x_pos)
               (Y y_pos))
              (Size
               (Width width)
               (Height height))

fromRectangle ::  Rectangle -> (Int,Int,Int,Int)
fromRectangle :: Rectangle -> (Int, Int, Int, Int)
fromRectangle (Rectangle (Position
                          (X x_pos :: Int
x_pos)
                          (Y y_pos :: Int
y_pos))
                         (Size
                          (Width width :: Int
width)
                          (Height height :: Int
height))) =
              (Int
x_pos, Int
y_pos, Int
width, Int
height)

toSize :: (Int, Int) -> Size
toSize :: (Int, Int) -> Size
toSize (width' :: Int
width', height' :: Int
height') = Width -> Height -> Size
Size (Int -> Width
Width Int
width') (Int -> Height
Height Int
height')

toPosition :: (Int,Int) -> Position
toPosition :: (Int, Int) -> Position
toPosition (xPos' :: Int
xPos', yPos' :: Int
yPos') = X -> Y -> Position
Position (Int -> X
X Int
xPos') (Int -> Y
Y Int
yPos')

toPrecisePosition :: Position -> PrecisePosition
toPrecisePosition :: Position -> PrecisePosition
toPrecisePosition (Position (X xPos' :: Int
xPos') (Y yPos' :: Int
yPos')) =
  PreciseX -> PreciseY -> PrecisePosition
PrecisePosition
    (Double -> PreciseX
PreciseX (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
xPos'))
    (Double -> PreciseY
PreciseY (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
yPos'))

toPreciseSize :: Size -> PreciseSize
toPreciseSize :: Size -> PreciseSize
toPreciseSize (Size (Width w :: Int
w) (Height h :: Int
h)) =
  PreciseWidth -> PreciseHeight -> PreciseSize
PreciseSize
    (Double -> PreciseWidth
PreciseWidth (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
w))
    (Double -> PreciseHeight
PreciseHeight (Int -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
h))

throwStackOnError :: IO a -> IO a
throwStackOnError :: IO a -> IO a
throwStackOnError f :: IO a
f =
  IO a
f IO a -> (SomeException -> IO a) -> IO a
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` SomeException -> IO a
forall b. SomeException -> IO b
throwStack
  where
  throwStack :: SomeException -> IO b
  throwStack :: SomeException -> IO b
throwStack e :: SomeException
e = String -> IO b -> IO b
forall a. String -> a -> a
traceStack (SomeException -> String
forall a. Show a => a -> String
show SomeException
e) (IO b -> IO b) -> IO b -> IO b
forall a b. (a -> b) -> a -> b
$ String -> IO b
forall a. HasCallStack => String -> a
error ""

withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO c) -> IO c
withForeignPtrs :: [ForeignPtr a] -> ([Ptr a] -> IO c) -> IO c
withForeignPtrs fptrs :: [ForeignPtr a]
fptrs io :: [Ptr a] -> IO c
io = do
  let ptrs :: [Ptr a]
ptrs = (ForeignPtr a -> Ptr a) -> [ForeignPtr a] -> [Ptr a]
forall a b. (a -> b) -> [a] -> [b]
map ForeignPtr a -> Ptr a
forall a. ForeignPtr a -> Ptr a
Unsafe.unsafeForeignPtrToPtr [ForeignPtr a]
fptrs
  c
r <- [Ptr a] -> IO c
io [Ptr a]
ptrs
  (ForeignPtr a -> IO ()) -> [ForeignPtr a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ ForeignPtr a -> IO ()
forall a. ForeignPtr a -> IO ()
touchForeignPtr [ForeignPtr a]
fptrs
  c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return c
r

toRefPtr :: HasCallStack => Ptr (Ptr a) -> IO (Ptr a)
toRefPtr :: Ptr (Ptr a) -> IO (Ptr a)
toRefPtr ptrToRefPtr :: Ptr (Ptr a)
ptrToRefPtr = do
  Ptr a
refPtr <- Ptr (Ptr a) -> IO (Ptr a)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr a)
ptrToRefPtr
  if (Ptr a
refPtr Ptr a -> Ptr a -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr a
forall a. Ptr a
nullPtr)
   then String -> IO (Ptr a)
forall a. HasCallStack => String -> a
error (String -> IO (Ptr a)) -> String -> IO (Ptr a)
forall a b. (a -> b) -> a -> b
$ "Ref does not exist. " String -> ShowS
forall a. [a] -> [a] -> [a]
++ (CallStack -> String
prettyCallStack CallStack
HasCallStack => CallStack
callStack)
   else Ptr a -> IO (Ptr a)
forall (m :: * -> *) a. Monad m => a -> m a
return Ptr a
refPtr

withRef :: HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef :: Ref a -> (Ptr b -> IO c) -> IO c
withRef (Ref fptr :: ForeignPtr (Ptr ())
fptr) f :: Ptr b -> IO c
f =
   IO c -> IO c
forall a. IO a -> IO a
throwStackOnError (IO c -> IO c) -> IO c -> IO c
forall a b. (a -> b) -> a -> b
$
     ForeignPtr (Ptr ()) -> (Ptr (Ptr ()) -> IO c) -> IO c
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr ())
fptr
       (\ptrToRefPtr :: Ptr (Ptr ())
ptrToRefPtr -> do
           Ptr ()
refPtr <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. HasCallStack => Ptr (Ptr a) -> IO (Ptr a)
toRefPtr Ptr (Ptr ())
ptrToRefPtr
           Ptr b -> IO c
f (Ptr () -> Ptr b
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
refPtr)
       )

isNull :: Ref a -> IO Bool
isNull :: Ref a -> IO Bool
isNull (Ref fptr :: ForeignPtr (Ptr ())
fptr) =
  ForeignPtr (Ptr ()) -> (Ptr (Ptr ()) -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr ())
fptr
   (\ptrToRefPtr :: Ptr (Ptr ())
ptrToRefPtr -> do
        Ptr ()
refPtr <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr ())
ptrToRefPtr
        Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
refPtr Ptr () -> Ptr () -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ()
forall a. Ptr a
nullPtr)
   )

unsafeRefToPtr :: HasCallStack => Ref a -> IO (Ptr ())
unsafeRefToPtr :: Ref a -> IO (Ptr ())
unsafeRefToPtr (Ref fptr :: ForeignPtr (Ptr ())
fptr) =
    IO (Ptr ()) -> IO (Ptr ())
forall a. IO a -> IO a
throwStackOnError (IO (Ptr ()) -> IO (Ptr ())) -> IO (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ do
      Ptr ()
refPtr <- Ptr (Ptr ()) -> IO (Ptr ())
forall a. HasCallStack => Ptr (Ptr a) -> IO (Ptr a)
toRefPtr (Ptr (Ptr ()) -> IO (Ptr ())) -> Ptr (Ptr ()) -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ ForeignPtr (Ptr ()) -> Ptr (Ptr ())
forall a. ForeignPtr a -> Ptr a
Unsafe.unsafeForeignPtrToPtr ForeignPtr (Ptr ())
fptr
      Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr () -> IO (Ptr ())) -> Ptr () -> IO (Ptr ())
forall a b. (a -> b) -> a -> b
$ Ptr () -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr ()
refPtr

withRefs :: HasCallStack => [Ref a] -> (Ptr (Ptr b) -> IO c) -> IO c
withRefs :: [Ref a] -> (Ptr (Ptr b) -> IO c) -> IO c
withRefs refs :: [Ref a]
refs f :: Ptr (Ptr b) -> IO c
f =
  IO c -> IO c
forall a. IO a -> IO a
throwStackOnError
  (IO c -> IO c) -> IO c -> IO c
forall a b. (a -> b) -> a -> b
$ [ForeignPtr (Ptr ())] -> ([Ptr (Ptr ())] -> IO c) -> IO c
forall a c. [ForeignPtr a] -> ([Ptr a] -> IO c) -> IO c
withForeignPtrs
        ((Ref a -> ForeignPtr (Ptr ())) -> [Ref a] -> [ForeignPtr (Ptr ())]
forall a b. (a -> b) -> [a] -> [b]
map (\(Ref fptr :: ForeignPtr (Ptr ())
fptr) -> ForeignPtr (Ptr ())
fptr) [Ref a]
refs)
        (\ptrToRefPtrs :: [Ptr (Ptr ())]
ptrToRefPtrs -> do
           [Ptr ()]
refPtrs <- (Ptr (Ptr ()) -> IO (Ptr ())) -> [Ptr (Ptr ())] -> IO [Ptr ()]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Ptr (Ptr ()) -> IO (Ptr ())
forall a. HasCallStack => Ptr (Ptr a) -> IO (Ptr a)
toRefPtr [Ptr (Ptr ())]
ptrToRefPtrs
           Ptr (Ptr ())
arrayPtr <- [Ptr ()] -> IO (Ptr (Ptr ()))
forall a. Storable a => [a] -> IO (Ptr a)
newArray [Ptr ()]
refPtrs
           Ptr (Ptr b) -> IO c
f (Ptr (Ptr ()) -> Ptr (Ptr b)
forall a b. Ptr a -> Ptr b
castPtr Ptr (Ptr ())
arrayPtr)
        )

withMaybeRef :: Maybe (Ref a) -> (Ptr () -> IO c) -> IO c
withMaybeRef :: Maybe (Ref a) -> (Ptr () -> IO c) -> IO c
withMaybeRef (Just o :: Ref a
o) f :: Ptr () -> IO c
f = Ref a -> (Ptr () -> IO c) -> IO c
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref a
o Ptr () -> IO c
f
withMaybeRef Nothing f :: Ptr () -> IO c
f = Ptr () -> IO c
f (Ptr Any -> Ptr ()
forall a b. Ptr a -> Ptr b
castPtr Ptr Any
forall a. Ptr a
nullPtr)

swapRef :: Ref a -> (Ptr b -> IO (Ptr ())) -> IO ()
swapRef :: Ref a -> (Ptr b -> IO (Ptr ())) -> IO ()
swapRef ref :: Ref a
ref@(Ref fptr :: ForeignPtr (Ptr ())
fptr) f :: Ptr b -> IO (Ptr ())
f = do
   Ptr ()
result <- Ref a -> (Ptr b -> IO (Ptr ())) -> IO (Ptr ())
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref a
ref Ptr b -> IO (Ptr ())
f
   ForeignPtr (Ptr ()) -> (Ptr (Ptr ()) -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr (Ptr ())
fptr ((Ptr (Ptr ()) -> IO ()) -> IO ())
-> (Ptr (Ptr ()) -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \p :: Ptr (Ptr ())
p -> Ptr (Ptr ()) -> Ptr () -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr (Ptr ())
p Ptr ()
result

wrapInRef :: ForeignPtr (Ptr ()) -> Ref a
wrapInRef :: ForeignPtr (Ptr ()) -> Ref a
wrapInRef = ForeignPtr (Ptr ()) -> Ref a
forall a. ForeignPtr (Ptr ()) -> Ref a
Ref (ForeignPtr (Ptr ()) -> Ref a)
-> (ForeignPtr (Ptr ()) -> ForeignPtr (Ptr ()))
-> ForeignPtr (Ptr ())
-> Ref a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ForeignPtr (Ptr ()) -> ForeignPtr (Ptr ())
forall a b. ForeignPtr a -> ForeignPtr b
castForeignPtr

toFunRef :: FunPtr a -> FunRef
toFunRef :: FunPtr a -> FunRef
toFunRef fptr :: FunPtr a
fptr = FunPtr () -> FunRef
FunRef (FunPtr () -> FunRef) -> FunPtr () -> FunRef
forall a b. (a -> b) -> a -> b
$ FunPtr a -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr FunPtr a
fptr

fromFunRef :: FunRef -> (FunPtr ())
fromFunRef :: FunRef -> FunPtr ()
fromFunRef (FunRef f :: FunPtr ()
f) = FunPtr () -> FunPtr ()
forall a b. FunPtr a -> FunPtr b
castFunPtr FunPtr ()
f

refPtrEquals :: Ref a -> Ref b -> IO Bool
refPtrEquals :: Ref a -> Ref b -> IO Bool
refPtrEquals w1 :: Ref a
w1 w2 :: Ref b
w2 = do
  Bool
w1Null <- Ref a -> IO Bool
forall a. Ref a -> IO Bool
isNull Ref a
w1
  Bool
w2Null <- Ref b -> IO Bool
forall a. Ref a -> IO Bool
isNull Ref b
w2
  if (Bool
w1Null Bool -> Bool -> Bool
|| Bool
w2Null) then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    else Ref a -> (Ptr Any -> IO Bool) -> IO Bool
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref a
w1 (\w1Ptr :: Ptr Any
w1Ptr -> Ref b -> (Ptr Any -> IO Bool) -> IO Bool
forall a b c. HasCallStack => Ref a -> (Ptr b -> IO c) -> IO c
withRef Ref b
w2 (\w2Ptr :: Ptr Any
w2Ptr -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr Any
w1Ptr Ptr Any -> Ptr Any -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr Any
w2Ptr)))

unpackFunctionPointerToFreeStruct :: Ptr () -> IO (CInt, Ptr (FunPtr (IO ())))
unpackFunctionPointerToFreeStruct :: Ptr () -> IO (CInt, Ptr (FunPtr (IO ())))
unpackFunctionPointerToFreeStruct fpts :: Ptr ()
fpts = do
  CInt
numFps <- (\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO CInt
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 0 :: IO C2HSImp.CInt}) Ptr ()
fpts
  Ptr (FunPtr (IO ()))
fpArray <- (\ptr :: Ptr ()
ptr -> do {Ptr () -> Int -> IO (Ptr (FunPtr (IO ())))
forall a b. Storable a => Ptr b -> Int -> IO a
C2HSImp.peekByteOff Ptr ()
ptr 8 :: IO (C2HSImp.Ptr (C2HSImp.FunPtr (IO ())))}) Ptr ()
fpts
  (CInt, Ptr (FunPtr (IO ()))) -> IO (CInt, Ptr (FunPtr (IO ())))
forall (m :: * -> *) a. Monad m => a -> m a
return (CInt
numFps, Ptr (FunPtr (IO ()))
fpArray)