-- 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/Base/Group.chs" #-}
{-# LANGUAGE CPP, RankNTypes, UndecidableInstances, GADTs, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.Base.Group
    (
    -- * Constructor
     groupNew,
     groupCustom,
     groupSetCurrent,
     groupCurrent,
     -- * Hierarchy
     --
     -- $hierarchy

     -- * Group functions
     --
     -- $functions
    )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp






import C2HS hiding (cFromEnum, cFromBool, cToBool,cToEnum)
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Base.Widget
import Control.Exception (finally)

groupSetCurrent' :: (Ptr ()) -> IO ()
groupSetCurrent' a1 =
  let {a1' = id a1} in 
  groupSetCurrent''_ a1' >>
  return ()

{-# LINE 33 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

groupCurrent' :: IO ((Ptr ()))
groupCurrent' =
  groupCurrent''_ >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 34 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}


groupSetCurrent :: (Parent a GroupBase) => Maybe (Ref a) -> IO ()
groupSetCurrent group = withMaybeRef group $ \groupPtr -> groupSetCurrent' groupPtr

groupCurrent :: IO (Maybe (Ref GroupBase))
groupCurrent = groupCurrent' >>= toMaybeRef

groupNew' :: (Int) -> (Int) -> (Int) -> (Int) -> IO ((Ptr ()))
groupNew' a1 a2 a3 a4 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  groupNew''_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 42 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

groupNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (CString) -> IO ((Ptr ()))
groupNewWithLabel' a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  (flip ($)) a5 $ \a5' -> 
  groupNewWithLabel''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 43 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

groupNew :: Rectangle -> Maybe T.Text -> IO (Ref Group)
groupNew rectangle label' =
  widgetMaker
    rectangle
    label'
    Nothing
    Nothing
    overriddenGroupNew'
    overriddenGroupNewWithLabel'

overriddenGroupNewWithLabel' :: (Int) -> (Int) -> (Int) -> (Int) -> (CString) -> (Ptr ()) -> IO ((Ptr ()))
overriddenGroupNewWithLabel' :: Int -> Int -> Int -> Int -> CString -> Ptr () -> IO (Ptr ())
overriddenGroupNewWithLabel' a1 :: Int
a1 a2 :: Int
a2 a3 a4 :: Int
a4 a5 :: CString
a5 a6 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  (flip ($)) a5 $ \a5' -> 
  let {a6' = id a6} in 
  overriddenGroupNewWithLabel''_ a1' a2' a3' a4' a5' a6' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 54 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

overriddenGroupNew' :: (Int) -> (Int) -> (Int) -> (Int) -> (Ptr ()) -> IO ((Ptr ()))
overriddenGroupNew' a1 a2 a3 a4 a5 =
  let {a1' = fromIntegral a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = id a5} in 
  overriddenGroupNew''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 55 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

groupCustom :: Rectangle -> Maybe T.Text -> Maybe (Ref Group -> IO ()) -> CustomWidgetFuncs Group -> IO (Ref Group)
groupCustom rectangle l' draw' funcs' =
  widgetMaker rectangle l' draw' (Just funcs') overriddenGroupNew' overriddenGroupNewWithLabel'

groupDestroy' :: (Ptr ()) -> IO ((()))
groupDestroy' a1 =
  let {a1' = id a1} in 
  groupDestroy''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 60 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( IO ())) => Op (Destroy ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> groupDestroy' groupPtr


drawChild' :: (Ptr ()) -> (Ptr ()) -> IO ()
drawChild' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  drawChild''_ a1' a2' >>
  return ()

{-# LINE 65 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a -> IO ())) => Op (DrawChild ()) GroupBase orig impl where
  runOp _ _ group widget = withRef group $ \groupPtr -> withRef widget $ \widgetPtr -> drawChild' groupPtr widgetPtr

drawChildren' :: (Ptr ()) -> IO ()
drawChildren' a1 =
  let {a1' = id a1} in 
  drawChildren''_ a1' >>
  return ()

{-# LINE 69 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (IO ())) => Op (DrawChildren ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> drawChildren' groupPtr

drawOutsideLabel' :: (Ptr ()) -> (Ptr ()) -> IO ()
drawOutsideLabel' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  drawOutsideLabel''_ a1' a2' >>
  return ()

{-# LINE 73 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a -> IO ())) => Op (DrawOutsideLabel ()) GroupBase orig impl where
  runOp _ _ group widget = withRef group $ \groupPtr -> withRef widget $ \widgetPtr -> drawOutsideLabel' groupPtr widgetPtr

updateChild' :: (Ptr ()) -> (Ptr ()) -> IO ()
updateChild' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  updateChild''_ a1' a2' >>
  return ()

{-# LINE 77 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a -> IO ())) => Op (UpdateChild ()) GroupBase orig impl where
  runOp _ _ group widget = withRef group $ \groupPtr -> withRef widget $ \widgetPtr -> updateChild' groupPtr widgetPtr

begin' :: (Ptr ()) -> IO ((()))
begin' a1 =
  let {a1' = id a1} in 
  begin''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 81 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( IO ())) => Op (Begin ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> begin' groupPtr

end' :: (Ptr ()) -> IO ((()))
end' a1 =
  let {a1' = id a1} in 
  end''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 85 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (IO ())) => Op (End ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> end' groupPtr

instance (
           Match obj ~ FindOp orig orig (Begin ()),
           Match obj ~ FindOp orig orig (End ()),
           Op (Begin ()) obj orig (IO ()),
           Op (End ()) obj orig (IO ()),
           impl ~ (IO a -> IO a)
         )
         =>
         Op (Within ()) GroupBase orig impl where
  runOp :: Within () -> orig -> Ref GroupBase -> impl
runOp _ _ group :: Ref GroupBase
group action :: IO a
action = do
    () <- Ref orig -> IO ()
forall r a impl.
(HasCallStack, Match r ~ FindOp a a (Begin ()),
 Op (Begin ()) r a impl) =>
Ref a -> impl
begin (Ref GroupBase -> Ref orig
forall a r. Ref a -> Ref r
castTo Ref GroupBase
group :: Ref orig)
    IO a -> IO () -> IO a
forall a b. IO a -> IO b -> IO a
finally IO a
action ((Ref orig -> IO ()
forall r a impl.
(HasCallStack, Match r ~ FindOp a a (End ()),
 Op (End ()) r a impl) =>
Ref a -> impl
end (Ref GroupBase -> Ref orig
forall a r. Ref a -> Ref r
castTo Ref GroupBase
group :: Ref orig)) :: IO ())

find' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
find' :: Ptr () -> Ptr () -> IO Int
find' a1 :: Ptr ()
a1 a2 :: Ptr ()
a2 =
  let {a1' = id a1} in 
  let {a2' :: Ptr ()
a2' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
a2} in 
  Ptr () -> Ptr () -> IO CInt
find''_ Ptr ()
a1' Ptr ()
a2' IO CInt -> (CInt -> IO Int) -> IO Int
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: CInt
res ->
  let {res' :: Int
res' = CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral CInt
res} in
  Int -> IO Int
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
res')

{-# LINE 102 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a ->  IO (AtIndex))) => Op (Find ()) GroupBase orig impl where
  runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> find' groupPtr wPtr >>= return . AtIndex

add' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
add' a1 a2 =
  let {a1' = id a1w :: Ref a
} in 
  let {a2' = id a2} in 
  add''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 106 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a->  IO ())) => Op (Add ()) GroupBase orig impl where
  runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> add' groupPtr wPtr

insert' :: (Ptr ()) -> (Ptr ()) -> (Int) -> IO ((()))
insert' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = fromIntegral a3} in 
  insert''_ a1' a2' a3' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 110 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a-> AtIndex ->  IO ())) => Op (Insert ()) GroupBase orig impl where
  runOp _ _ group w (AtIndex i) = withRef group $ \groupPtr -> withRef w $ \wPtr -> insert' groupPtr wPtr i

removeIndex' :: (Ptr ()) -> (Int) -> IO ((()))
removeIndex' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  removeIndex''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 114 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( AtIndex ->  IO ())) => Op (RemoveIndex ()) GroupBase orig impl where
  runOp _ _ group (AtIndex index') = withRef group $ \groupPtr -> removeIndex' groupPtr index'

removeWidget' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
removeWidget' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  removeWidget''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 118 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a ->  IO ())) => Op (RemoveWidget ()) GroupBase orig impl where
  runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> removeWidget' groupPtr wPtr

clear' :: (Ptr ()) -> IO ((()))
clear' a1 =
  let {a1' = id a1} in 
  clear''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 122 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (IO ())) => Op (Clear ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> clear' groupPtr

setResizable' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
setResizable' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  setResizable''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 126 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Maybe ( Ref a ) -> IO ())) => Op (SetResizable ()) GroupBase orig impl where
  runOp _ _ group o = withRef group $ \groupPtr -> withMaybeRef o $ \oPtr -> setResizable' groupPtr oPtr

instance (impl ~ IO ()) => Op (SetNotResizable ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> setResizable' groupPtr nullPtr

resizable' :: (Ptr ()) -> IO ((Ptr ()))
resizable' a1 =
  let {a1' = id a1} in 
  resizable''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 133 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( IO (Maybe (Ref WidgetBase)))) => Op (GetResizable ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> resizable' groupPtr >>= toMaybeRef

addResizable' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
addResizable' a1 a2 =
  let {a1' = id a1o :: Ref a
} in 
  let {a2' = id a2} in 
  addResizable''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 137 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a ->  IO ())) => Op (AddResizable ()) GroupBase orig impl where
  runOp _ _ group o = withRef group $ \groupPtr -> withRef o $ \oPtr -> addResizable' groupPtr oPtr

initSizes' :: (Ptr ()) -> IO ((()))
initSizes' a1 =
  let {a1' = id a1} in 
  initSizes''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 141 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( IO ())) => Op (InitSizes ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> initSizes' groupPtr

children' :: (Ptr ()) -> IO ((Int))
children' a1 =
  let {a1' = id a1} in 
  children''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 145 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( IO (Int))) => Op (Children ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> children' groupPtr

setClipChildren' :: (Ptr ()) -> (Bool) -> IO ((()))
setClipChildren' a1 a2 =
  let {a1' = id a1c :: Bool
} in 
  let {a2' = cFromBool a2} in 
  setClipChildren''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 149 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (Bool ->  IO ())) => Op (SetClipChildren ()) GroupBase orig impl where
  runOp _ _ group c = withRef group $ \groupPtr -> setClipChildren' groupPtr c

clipChildren' :: (Ptr ()) -> IO ((Bool))
clipChildren' a1 =
  let {a1' = id a1} in 
  clipChildren''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 153 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ ( IO (Bool))) => Op (ClipChildren ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> clipChildren' groupPtr

focus' :: (Ptr ()) -> (Ptr ()) -> IO ((()))
focus' a1 a2 =
  let {a1' = id a1w :: Ref a
} in 
  let {a2' = id a2} in 
  focus''_ a1' a2' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 157 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a ->  IO ())) => Op (Focus ()) GroupBase orig impl where
  runOp _ _ group w = withRef group $ \groupPtr -> withRef w $ \wPtr -> focus' groupPtr wPtr

ddfdesignKludge' :: (Ptr ()) -> IO ((Ptr ()))
ddfdesignKludge' a1 =
  let {a1' = id a1} in 
  ddfdesignKludge''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 161 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (IO (Maybe (Ref WidgetBase)))) => Op (DdfdesignKludge ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> ddfdesignKludge' groupPtr >>= toMaybeRef

insertWithBefore' :: (Ptr ()) -> (Ptr ()) -> (Ptr ()) -> IO ((()))
insertWithBefore' a1 a2 a3 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  let {a3' = id a3} in 
  insertWithBefore''_ a1' a2' a3' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 165 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (Parent a WidgetBase, impl ~ (Ref a -> Ref b ->  IO ())) => Op (InsertBefore ()) GroupBase orig impl where
  runOp _ _ self w before = withRef self $ \selfPtr -> withRef w $ \wPtr -> withRef before $ \beforePtr -> insertWithBefore' selfPtr wPtr beforePtr

array' :: (Ptr ()) -> IO ((Ptr (Ptr ())))
array' a1 =
  let {a1' = id a1} in 
  array''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 169 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (IO [Ref WidgetBase])) => Op (GetArray ()) GroupBase orig impl where
  runOp _ _ group = withRef group $ \groupPtr -> do
                    childArrayPtr <- array' groupPtr
                    numChildren <- children group
                    arrayToRefs childArrayPtr numChildren

child' :: (Ptr ()) -> (Int) -> IO ((Ptr ()))
child' :: Ptr () -> Int -> IO (Ptr ())
child' a1 :: Ptr ()
a1 a2 :: Int
a2 =
  let {a1' = id a1} in 
  let {a2' :: CInt
a2' = Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
a2} in 
  Ptr () -> CInt -> IO (Ptr ())
child''_ Ptr ()
a1' CInt
a2' IO (Ptr ()) -> (Ptr () -> IO (Ptr ())) -> IO (Ptr ())
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \res :: Ptr ()
res ->
  let {res' :: Ptr ()
res' = Ptr () -> Ptr ()
forall a. a -> a
id Ptr ()
res} in
  Ptr () -> IO (Ptr ())
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ()
res')

{-# LINE 176 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (AtIndex ->  IO (Maybe (Ref WidgetBase)))) => Op (GetChild ()) GroupBase orig impl where
  runOp _ _ self (AtIndex n) = withRef self $ \selfPtr -> child' selfPtr n >>= toMaybeRef

groupHandle' :: (Ptr ()) -> (CInt) -> IO ((Int))
groupHandle' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = id a2} in 
  groupHandle''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 180 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (Event -> IO (Either UnknownEvent ()))) => Op (Handle ()) GroupBase orig impl where
  runOp _ _ group event = withRef group (\p -> groupHandle' p (fromIntegral . fromEnum $ event)) >>= return  . successOrUnknownEvent

resize' :: (Ptr ()) -> (Int) -> (Int) -> (Int) -> (Int) -> IO ((()))
resize' a1 a2 a3 a4 a5 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  let {a3' = fromIntegral a3} in 
  let {a4' = fromIntegral a4} in 
  let {a5' = fromIntegral a5} in 
  resize''_ a1' a2' a3' a4' a5' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 184 "src/Graphics/UI/FLTK/LowLevel/Base/Group.chs" #-}

instance (impl ~ (Rectangle -> IO ())) => Op (Resize ()) GroupBase orig impl where
  runOp _ _ group rectangle = withRef group $ \groupPtr -> do
                                 let (x_pos,y_pos,w_pos,h_pos) = fromRectangle rectangle
                                 resize' groupPtr x_pos y_pos w_pos h_pos


-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.Base.Widget"
--  |
--  v
-- "Graphics.UI.FLTK.LowLevel.Base.Group"
-- @

-- $functions
-- @
-- add:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a-> 'IO' ()
--
-- addResizable:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ()
--
-- begin :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- children :: 'Ref' 'GroupBase' -> 'IO' ('Int')
--
-- clear :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- clipChildren :: 'Ref' 'GroupBase' -> 'IO' ('Bool')
--
-- ddfdesignKludge :: 'Ref' 'GroupBase' -> 'IO' ('Maybe' ('Ref' 'WidgetBase'))
--
-- destroy :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- drawChild:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ()
--
-- drawChildren :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- drawOutsideLabel:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ()
--
-- end :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- find:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ('AtIndex')
--
-- focus:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ()
--
-- getArray :: 'Ref' 'GroupBase' -> 'IO' ['Ref' 'WidgetBase']
--
-- getChild :: 'Ref' 'GroupBase' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'WidgetBase'))
--
-- getResizable :: 'Ref' 'GroupBase' -> 'IO' ('Maybe' ('Ref' 'WidgetBase'))
--
-- handle :: 'Ref' 'GroupBase' -> 'Event' -> 'IO' ('Either' 'UnknownEvent' ())
--
-- initSizes :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- insert:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a-> 'AtIndex' -> 'IO' ()
--
-- insertBefore:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'Ref' b -> 'IO' ()
--
-- removeIndex :: 'Ref' 'GroupBase' -> 'AtIndex' -> 'IO' ()
--
-- removeWidget:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ()
--
-- resize :: 'Ref' 'GroupBase' -> 'Rectangle' -> 'IO' ()
--
-- setClipChildren :: 'Ref' 'GroupBase' -> 'Bool' -> 'IO' ()
--
-- setNotResizable :: 'Ref' 'GroupBase' -> 'IO' ()
--
-- setResizable:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Maybe' ( 'Ref' a ) -> 'IO' ()
--
-- updateChild:: ('Parent' a 'WidgetBase') => 'Ref' 'GroupBase' -> 'Ref' a -> 'IO' ()
--
-- within:: ('Match' obj ~ 'FindOp' orig orig ('Begin' ()), 'Match' obj ~ 'FindOp' orig orig ('End' ()), 'Op' ('Begin' ()) obj orig ('IO' ()), 'Op' ('End' ()) obj orig ('IO' ()),) => 'Ref' 'GroupBase' -> 'IO' a -> 'IO' a
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_set_current"
  groupSetCurrent''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_current"
  groupCurrent''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_New"
  groupNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_New_WithLabel"
  groupNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_OverriddenGroup_New_WithLabel"
  overriddenGroupNewWithLabel''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_OverriddenGroup_New"
  overriddenGroupNew''_ :: (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_Destroy"
  groupDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_draw_child"
  drawChild''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_draw_children"
  drawChildren''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_draw_outside_label"
  drawOutsideLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_update_child"
  updateChild''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_begin"
  begin''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_end"
  end''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_find"
  find''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_add"
  add''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_insert"
  insert''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_remove_index"
  removeIndex''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_remove_widget"
  removeWidget''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_clear"
  clear''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_set_resizable"
  setResizable''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_resizable"
  resizable''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_add_resizable"
  addResizable''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_init_sizes"
  initSizes''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_children"
  children''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_set_clip_children"
  setClipChildren''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_clip_children"
  clipChildren''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_focus"
  focus''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group__ddfdesign_kludge"
  ddfdesignKludge''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_insert_with_before"
  insertWithBefore''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_array"
  array''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_child"
  child''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_handle"
  groupHandle''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Base/Group.chs.h Fl_Group_resize"
  resize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))))