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


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}
{-# LANGUAGE OverloadedStrings, CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, UndecidableInstances #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.TreeItem
  (
    TreeItemPointer(..),
    TreeItemName(..),
    TreeItemReference(..),
    TreeItemLocator(..),
    MoveError(..),
    MoveType(..),
    SiblingPosition(..),
    TreeItemNotFound(..),
    treeItemNew
    -- * Hierarchy
    --
    -- $hierarchy

    -- * Hierarchy
    --
    -- $hierarchy

    -- * 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.Fl_Enumerations
import Graphics.UI.FLTK.LowLevel.Fl_Types
import Graphics.UI.FLTK.LowLevel.Utils
import Graphics.UI.FLTK.LowLevel.Hierarchy
import Graphics.UI.FLTK.LowLevel.Dispatch
import qualified Data.Text as T

data TreeItemPointer = forall a. (Parent a TreeItem) => TreeItemPointer (Ref a)
newtype TreeItemName = TreeItemName T.Text
data TreeItemReference = TreeItemByIndex AtIndex | TreeItemByPointer TreeItemPointer
data TreeItemLocator = TreeItemPointerLocator TreeItemPointer | TreeItemNameLocator TreeItemName
data MoveError = NoParent | NoIndexFound | IndexRangeError | CouldNotDeparent | CouldNotReparent
data MoveType = MoveAbove | MoveBelow | MoveInto SiblingPosition
data TreeItemNotFound = TreeItemNotFound
data SiblingPosition = SiblingPosition (Maybe Int)
instance Enum MoveError where
  fromEnum NoParent = (-1)
  fromEnum  NoIndexFound = (-2)
  fromEnum  IndexRangeError = (-4)
  fromEnum  CouldNotDeparent = (-5)
  fromEnum  CouldNotReparent = (-6)

  toEnum (-1) = NoParent
  toEnum (-2) = NoIndexFound
  toEnum (-4) = IndexRangeError
  toEnum (-5) = CouldNotDeparent
  toEnum (-6) = CouldNotReparent
  toEnum e = error $ "No MoveError found for " ++ (show e)
newTreeItem' :: (Ptr ()) -> IO ((Ptr ()))
newTreeItem' a1 =
  let {a1' = id a1} in
  newTreeItem''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 59 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

treeItemNew :: Ref TreePrefs -> IO (Ref TreeItem)
treeItemNew prefs' = withRef prefs' $ \prefs'Ptr -> newTreeItem' prefs'Ptr >>= toRef
destroy' :: (Ptr ()) -> IO ((()))
destroy' a1 =
  let {a1' = id a1} in
  destroy''_ a1' >>= \res ->
  let {res' = supressWarningAboutRes res} in
  return (res')

{-# LINE 62 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (Destroy ()) TreeItem orig impl where
  runOp _ _ menu_ = swapRef menu_ $ \menu_Ptr -> destroy' menu_Ptr >> return nullPtr
x' :: (Ptr ()) -> IO ((Int))
x' a1 =
  let {a1' = id a1} in
  x''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ IO Int) => Op (GetX ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> x' tree_itemPtr
y' :: (Ptr ()) -> IO ((Int))
y' a1 =
  let {a1' = id a1} in
  y''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 68 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ IO Int) => Op (GetY ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> y' tree_itemPtr
w' :: (Ptr ()) -> IO ((Int))
w' a1 =
  let {a1' = id a1} in
  w''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 71 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ IO Int) => Op (GetW ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> w' tree_itemPtr
h' :: (Ptr ()) -> IO ((Int))
h' a1 =
  let {a1' = id a1} in
  h''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 74 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ IO Int) => Op (GetH ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> h' tree_itemPtr
showSelfWithIndent' :: (Ptr ()) -> (CString) -> IO ()
showSelfWithIndent' a1 a2 =
  let {a1' = id a1} in
  (flip ($)) a2 $ \a2' ->
  showSelfWithIndent''_ a1' a2' >>
  return ()

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

instance (impl ~ (Maybe T.Text -> IO ())) => Op (ShowSelf ()) TreeItem orig impl where
  runOp _ _ tree_item indent = case indent of
    Just s' -> withRef tree_item $ \tree_itemPtr ->
      copyTextToCString s' >>= showSelfWithIndent' tree_itemPtr
    Nothing -> withRef tree_item $ \tree_itemPtr ->
      copyTextToCString "" >>= showSelfWithIndent' tree_itemPtr
setLabel' :: (Ptr ()) -> (Ptr CChar ) -> IO ()
setLabel' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setLabel''_ a1' a2' >>
  return ()

{-# LINE 84 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( T.Text ->  IO ())) => Op (SetLabel ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> withText val (\valPtr -> setLabel' tree_itemPtr valPtr)
label' :: (Ptr ()) -> IO ((CString))
label' a1 =
  let {a1' = id a1} in
  label''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 87 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO T.Text)) => Op (GetLabel ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> label' tree_itemPtr >>= cStringToText
setLabelfont' :: (Ptr ()) -> (Font) -> IO ()
setLabelfont' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromFont a2} in
  setLabelfont''_ a1' a2' >>
  return ()

{-# LINE 90 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( Font ->  IO ())) => Op (SetLabelfont ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> setLabelfont' tree_itemPtr val
labelfont' :: (Ptr ()) -> IO ((Font))
labelfont' a1 =
  let {a1' = id a1} in
  labelfont''_ a1' >>= \res ->
  let {res' = cToFont res} in
  return (res')

{-# LINE 93 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Font))) => Op (GetLabelfont ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelfont' tree_itemPtr
setLabelsize' :: (Ptr ()) -> (CInt) -> IO ()
setLabelsize' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setLabelsize''_ a1' a2' >>
  return ()

{-# LINE 96 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( FontSize ->  IO ())) => Op (SetLabelsize ()) TreeItem orig impl where
  runOp _ _ tree_item (FontSize val) = withRef tree_item $ \tree_itemPtr -> setLabelsize' tree_itemPtr val
labelsize' :: (Ptr ()) -> IO ((CInt))
labelsize' a1 =
  let {a1' = id a1} in
  labelsize''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 99 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (FontSize))) => Op (GetLabelsize ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelsize' tree_itemPtr >>= return . FontSize
setLabelcolor' :: (Ptr ()) -> (Color) -> IO ()
setLabelcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setLabelcolor''_ a1' a2' >>
  return ()

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

instance (impl ~ ( Color ->  IO ())) => Op (SetLabelcolor ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> setLabelcolor' tree_itemPtr val
labelcolor' :: (Ptr ()) -> IO ((Color))
labelcolor' a1 =
  let {a1' = id a1} in
  labelcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 105 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Color))) => Op (GetLabelcolor ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelcolor' tree_itemPtr
labelfgcolor' :: (Ptr ()) -> IO ((Color))
labelfgcolor' a1 =
  let {a1' = id a1} in
  labelfgcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 108 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Color))) => Op (GetLabelfgcolor ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelfgcolor' tree_itemPtr
setLabelfgcolor' :: (Ptr ()) -> (Color) -> IO ()
setLabelfgcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setLabelfgcolor''_ a1' a2' >>
  return ()

{-# LINE 111 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( Color ->  IO ())) => Op (SetLabelfgcolor ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> setLabelfgcolor' tree_itemPtr val
setLabelbgcolor' :: (Ptr ()) -> (Color) -> IO ()
setLabelbgcolor' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromColor a2} in
  setLabelbgcolor''_ a1' a2' >>
  return ()

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

instance (impl ~ ( Color ->  IO ())) => Op (SetLabelbgcolor ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> setLabelbgcolor' tree_itemPtr val
labelbgcolor' :: (Ptr ()) -> IO ((Color))
labelbgcolor' a1 =
  let {a1' = id a1} in
  labelbgcolor''_ a1' >>= \res ->
  let {res' = cToColor res} in
  return (res')

{-# LINE 117 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Color))) => Op (GetLabelbgcolor ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelbgcolor' tree_itemPtr
setWidget' :: (Ptr ()) -> (Ptr ()) -> IO ()
setWidget' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setWidget''_ a1' a2' >>
  return ()

{-# LINE 120 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a WidgetBase, impl ~ (Maybe ( Ref a )  ->  IO ())) => Op (SetWidget ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> withMaybeRef val $ \valPtr -> setWidget' tree_itemPtr valPtr
widget' :: (Ptr ()) -> IO ((Ptr ()))
widget' a1 =
  let {a1' = id a1} in
  widget''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 123 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Maybe (Ref WidgetBase)))) => Op (GetWidget ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> widget' tree_itemPtr >>= toMaybeRef
children' :: (Ptr ()) -> IO ((Int))
children' a1 =
  let {a1' = id a1} in
  children''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ (IO (Int))) => Op (Children ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> children' tree_itemPtr
childByIndex' :: (Ptr ()) -> (Int) -> IO ((Ptr ()))
childByIndex' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  childByIndex''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 129 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( AtIndex ->  IO (Maybe (Ref WidgetBase)))) => Op (Child ()) TreeItem orig impl where
  runOp _ _ tree_item (AtIndex index') = withRef tree_item $ \tree_itemPtr -> childByIndex' tree_itemPtr index' >>= toMaybeRef
hasChildren' :: (Ptr ()) -> IO ((Bool))
hasChildren' a1 =
  let {a1' = id a1} in
  hasChildren''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 132 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (HasChildren ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> hasChildren' tree_itemPtr

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

{-# LINE 136 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

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

instance (impl ~ ( TreeItemLocator ->  IO (Maybe AtIndex))) => Op (FindChild ()) TreeItem orig impl where
  runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> do
    idx' <- case locator' of
             (TreeItemPointerLocator (TreeItemPointer item')) -> withRef item' $ \itemPtr-> findChildByItem' tree_itemPtr itemPtr
             (TreeItemNameLocator (TreeItemName name')) -> copyTextToCString name' >>= findChild' tree_itemPtr
    if idx' == -1 then return Nothing else (return $ Just (AtIndex idx'))

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

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

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

{-# LINE 146 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( TreeItemLocator ->  IO (Either UnknownError ()))) => Op (RemoveChild ()) TreeItem orig impl where
  runOp _ _ tree_item locator' = withRef tree_item $ \tree_itemPtr -> do
     status' <- case locator' of
       (TreeItemPointerLocator (TreeItemPointer item')) -> withRef item' $ \itemPtr-> removeChildByItem' tree_itemPtr itemPtr
       (TreeItemNameLocator (TreeItemName name')) -> copyTextToCString name' >>= removeChild' tree_itemPtr
     if (status' < 0) then (return $ Left UnknownError) else (return $ Right ())
clearChildren' :: (Ptr ()) -> IO ()
clearChildren' a1 =
  let {a1' = id a1} in
  clearChildren''_ a1' >>
  return ()

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

instance (impl ~ (IO ())) => Op (ClearChildren ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> clearChildren' tree_itemPtr
swapChildren' :: (Ptr ()) -> (Int) -> (Int) -> IO ()
swapChildren' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  swapChildren''_ a1' a2' a3' >>
  return ()

{-# LINE 156 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( AtIndex -> AtIndex ->  IO ())) => Op (SwapChildren ()) TreeItem orig impl where
  runOp _ _ tree_item (AtIndex ax) (AtIndex bx) = withRef tree_item $ \tree_itemPtr -> swapChildren' tree_itemPtr ax bx
swapChildrenByTreeItem' :: (Ptr ()) -> (Ptr ()) -> (Ptr ()) -> IO ((Int))
swapChildrenByTreeItem' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  swapChildrenByTreeItem''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 159 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a -> Ref a -> IO (Either TreeItemNotFound ()))) => Op (SwapChildrenByTreeItem ()) TreeItem orig impl where
  runOp _ _ tree_item a b = withRef tree_item $ \tree_itemPtr -> withRef a $ \aPtr -> withRef b $ \bPtr -> do
    status' <- swapChildrenByTreeItem' tree_itemPtr aPtr bPtr
    if (status' == 0) then return (Left TreeItemNotFound) else return (Right ())
findChildItem' :: (Ptr ()) -> (Ptr (Ptr CChar)) -> IO ((Ptr ()))
findChildItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  findChildItem''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 164 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ([T.Text] ->  IO (Maybe (Ref TreeItem)))) => Op (FindInChildren ()) TreeItem orig impl where
  runOp _ _ tree_item path_ = withRef tree_item $ \tree_itemPtr -> withStrings path_ $ \pathPtr -> findChildItem' tree_itemPtr (castPtr pathPtr) >>= toMaybeRef
findItem' :: (Ptr ()) -> (Ptr (Ptr CChar)) -> IO ((Ptr ()))
findItem' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  findItem''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 167 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( [T.Text] ->  IO (Maybe (Ref TreeItem)))) => Op (FindItem ()) TreeItem orig impl where
  runOp _ _ tree_item path =
    withRef tree_item $ \tree_itemPtr ->
      withStrings path (\pathPtr -> findItem' tree_itemPtr (castPtr pathPtr) >>= toMaybeRef)
addWith' :: (Ptr ()) -> (Ptr ()) -> (Ptr CChar) -> (Ptr ()) -> IO ((Ptr ()))
addWith' a1 a2 a3 a4 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = id a3} in
  let {a4' = id a4} in
  addWith''_ a1' a2' a3' a4' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 172 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

{-# LINE 173 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

{-# LINE 174 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

{-# LINE 175 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreeItem, Parent b TreePrefs, impl ~ (Ref b  -> TreeItemLocator ->  IO (Maybe (Ref a)))) => Op (Add ()) TreeItem orig impl where
  runOp _ _ tree_item prefs arr =
    withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr ->
      case arr of
        TreeItemNameLocator (TreeItemName n') -> copyTextToCString n' >>= \nText -> add' tree_itemPtr prefsPtr nText >>= toMaybeRef
        TreeItemPointerLocator (TreeItemPointer p') -> withRef p' $ \p'Ptr -> addWith' tree_itemPtr prefsPtr (castPtr nullPtr) p'Ptr >>= toMaybeRef
instance (Parent a TreeItem, Parent b TreePrefs, impl ~ (Ref b  ->  [T.Text] -> Maybe (Ref a) -> IO (Maybe (Ref a)))) => Op (AddAt ()) TreeItem orig impl where
  runOp _ _ tree_item prefs path item' =
    withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr ->
    withStrings path $ \pathPtr ->
      case item' of
        Nothing -> addAt' tree_itemPtr prefsPtr (castPtr pathPtr) >>= toMaybeRef
        Just i' -> withRef i' $ \i'Ptr -> addWithAt' tree_itemPtr prefsPtr i'Ptr pathPtr >>= toMaybeRef
insert' :: (Ptr ()) -> (Ptr ()) -> (CString) -> IO ((Ptr ()))
insert' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  (flip ($)) a3 $ \a3' ->
  insert''_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 189 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

{-# LINE 190 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a  -> T.Text ->  Maybe AtIndex -> IO (Maybe (Ref TreeItem)))) => Op (Insert ()) TreeItem orig impl where
  runOp _ _ tree_item prefs new_label pos' =
    withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr ->
      case pos' of
        Nothing -> do
          t <- copyTextToCString new_label
          insert' tree_itemPtr prefsPtr t >>= toMaybeRef
        Just (AtIndex p') -> do
          t <- copyTextToCString new_label
          insertWithPos' tree_itemPtr prefsPtr t p' >>= toMaybeRef
insertAbove' :: (Ptr ()) -> (Ptr ()) -> (CString) -> IO ((Ptr ()))
insertAbove' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  (flip ($)) a3 $ \a3' ->
  insertAbove''_ a1' a2' a3' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 201 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a -> T.Text ->  IO (Maybe (Ref TreeItem)))) => Op (InsertAbove ()) TreeItem orig impl where
  runOp _ _ tree_item prefs new_label =
    withRef tree_item $
    \tree_itemPtr ->
     withRef prefs $ \prefsPtr -> do
       t <- copyTextToCString new_label
       insertAbove' tree_itemPtr prefsPtr t >>= toMaybeRef
deparent' :: (Ptr ()) -> (Int) -> IO ((Ptr ()))
deparent' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  deparent''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ (AtIndex -> IO (Either UnknownError (Ref orig)))) => Op (Deparent ()) TreeItem orig impl where
  runOp _ _ tree_item (AtIndex pos') = withRef tree_item $ \tree_itemPtr -> do
    item' <- deparent' tree_itemPtr pos'
    if (item' == nullPtr) then (return $ Left UnknownError) else toRef item' >>= return . Right
reparent' :: (Ptr ()) -> (Ptr ()) -> (Int) -> IO ((Int))
reparent' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  let {a3' = fromIntegral a3} in
  reparent''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (Parent a TreeItem, impl ~ (Ref a -> AtIndex -> IO (Either UnknownError ()))) => Op (Reparent ()) TreeItem orig impl where
  runOp _ _ tree_item child_item (AtIndex pos') =
    withRef tree_item $ \tree_itemPtr -> withRef child_item $ \child_itemPtr -> do
      status' <- reparent' tree_itemPtr child_itemPtr pos'
      if (status' < 0) then (return $ Left UnknownError) else (return $ Right ())
move' :: (Ptr ()) -> (Int) -> (Int) -> IO ((Int))
move' a1 a2 a3 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  let {a3' = fromIntegral a3} in
  move''_ a1' a2' a3' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ (AtIndex -> AtIndex -> IO (Either OutOfRange ()))) => Op (Move ()) TreeItem orig impl where
  runOp _ _ tree_item (AtIndex pos') (AtIndex spos') =
    withRef tree_item $ \tree_itemPtr -> do
      status' <- move' tree_itemPtr pos' spos'
      if status' == -1 then (return $ Left OutOfRange) else return (Right ())
move_above' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
move_above' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  move_above''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 226 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

{-# LINE 227 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

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

{-# LINE 228 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreeItem, impl ~ (Ref a -> MoveType -> IO (Either MoveError ()))) => Op (MoveTo ()) TreeItem orig impl where
  runOp _ _ tree_item to_item moveType' =
    withRef tree_item $ \tree_itemPtr ->
    withRef to_item $ \to_itemPtr -> do
    statusCode' <- case moveType' of
      MoveInto (SiblingPosition (Just p')) -> move_into' tree_itemPtr to_itemPtr p'
      MoveInto (SiblingPosition Nothing)  -> move_into' tree_itemPtr to_itemPtr 0
      MoveAbove                           -> move_above' tree_itemPtr to_itemPtr
      MoveBelow                           -> move_below' tree_itemPtr to_itemPtr
    if (statusCode' < 0) then return (Left (toEnum statusCode')) else return (Right ())
depth' :: (Ptr ()) -> IO ((Int))
depth' a1 =
  let {a1' = id a1} in
  depth''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 239 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (GetDepth ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> depth' tree_itemPtr
prev' :: (Ptr ()) -> IO ((Ptr ()))
prev' a1 =
  let {a1' = id a1} in
  prev''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

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

instance (impl ~ (IO (Maybe (Ref TreeItem)))) => Op (Prev ()) TreeItem orig impl where
  runOp _ _ tree_item =
    withRef tree_item $ \tree_itemPtr -> prev' tree_itemPtr >>= toMaybeRef
next' :: (Ptr ()) -> IO ((Ptr ()))
next' a1 =
  let {a1' = id a1} in
  next''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 246 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Maybe (Ref TreeItem)))) => Op (Next ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> next' tree_itemPtr >>= toMaybeRef
nextSibling' :: (Ptr ()) -> IO ((Ptr ()))
nextSibling' a1 =
  let {a1' = id a1} in
  nextSibling''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 249 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Maybe (Ref TreeItem)))) => Op (NextSibling ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> nextSibling' tree_itemPtr >>= toMaybeRef
prevSibling' :: (Ptr ()) -> IO ((Ptr ()))
prevSibling' a1 =
  let {a1' = id a1} in
  prevSibling''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 252 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Maybe (Ref TreeItem)))) => Op (PrevSibling ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> prevSibling' tree_itemPtr >>= toMaybeRef
updatePrevNext' :: (Ptr ()) -> (Int) -> IO ()
updatePrevNext' a1 a2 =
  let {a1' = id a1} in
  let {a2' = fromIntegral a2} in
  updatePrevNext''_ a1' a2' >>
  return ()

{-# LINE 255 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( AtIndex ->  IO ())) => Op (UpdatePrevNext ()) TreeItem orig impl where
  runOp _ _ tree_item (AtIndex index') = withRef tree_item $ \tree_itemPtr -> updatePrevNext' tree_itemPtr index'
nextDisplayed' :: (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
nextDisplayed' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  nextDisplayed''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 258 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a  ->  IO (Maybe (Ref TreeItem)))) => Op (NextDisplayed ()) TreeItem orig impl where
  runOp _ _ tree_item prefs = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> nextDisplayed' tree_itemPtr prefsPtr >>= toMaybeRef
prevDisplayed' :: (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
prevDisplayed' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  prevDisplayed''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 261 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a  ->  IO (Maybe (Ref TreeItem)))) => Op (PrevDisplayed ()) TreeItem orig impl where
  runOp _ _ tree_item prefs = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> prevDisplayed' tree_itemPtr prefsPtr >>= toMaybeRef
parent' :: (Ptr ()) -> IO ((Ptr ()))
parent' a1 =
  let {a1' = id a1} in
  parent''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 264 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Maybe (Ref TreeItem)))) => Op (GetParent ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> parent' tree_itemPtr >>= toMaybeRef
setParent' :: (Ptr ()) -> (Ptr ()) -> IO ()
setParent' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setParent''_ a1' a2' >>
  return ()

{-# LINE 267 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreeItem, impl ~ (Maybe (Ref a)  ->  IO ())) => Op (SetParent ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> withMaybeRef val $ \valPtr -> setParent' tree_itemPtr valPtr
open' :: (Ptr ()) -> IO ()
open' a1 =
  let {a1' = id a1} in
  open''_ a1' >>
  return ()

{-# LINE 270 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (Open ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> open' tree_itemPtr
close' :: (Ptr ()) -> IO ()
close' a1 =
  let {a1' = id a1} in
  close''_ a1' >>
  return ()

{-# LINE 273 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (Close ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> close' tree_itemPtr
isOpen' :: (Ptr ()) -> IO ((Bool))
isOpen' a1 =
  let {a1' = id a1} in
  isOpen''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 276 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (IsOpen ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> isOpen' tree_itemPtr
isClose' :: (Ptr ()) -> IO ((Bool))
isClose' a1 =
  let {a1' = id a1} in
  isClose''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 279 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (IsClose ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> isClose' tree_itemPtr
openToggle' :: (Ptr ()) -> IO ()
openToggle' a1 =
  let {a1' = id a1} in
  openToggle''_ a1' >>
  return ()

{-# LINE 282 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (OpenToggle ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> openToggle' tree_itemPtr
select' :: (Ptr ()) -> IO ()
select' a1 =
  let {a1' = id a1} in
  select''_ a1' >>
  return ()

{-# LINE 285 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (Select ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> select' tree_itemPtr
selectWithVal' :: (Ptr ()) -> (Bool) -> IO ()
selectWithVal' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromBool a2} in
  selectWithVal''_ a1' a2' >>
  return ()

{-# LINE 288 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (SelectSet ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> selectWithVal' tree_itemPtr val
selectToggle' :: (Ptr ()) -> IO ()
selectToggle' a1 =
  let {a1' = id a1} in
  selectToggle''_ a1' >>
  return ()

{-# LINE 291 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (SelectToggle ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> selectToggle' tree_itemPtr
selectAll' :: (Ptr ()) -> IO ((Int))
selectAll' a1 =
  let {a1' = id a1} in
  selectAll''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 294 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (SelectAll ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> selectAll' tree_itemPtr
deselect' :: (Ptr ()) -> IO ()
deselect' a1 =
  let {a1' = id a1} in
  deselect''_ a1' >>
  return ()

{-# LINE 297 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (Deselect ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> deselect' tree_itemPtr
deselectAll' :: (Ptr ()) -> IO ((Int))
deselectAll' a1 =
  let {a1' = id a1} in
  deselectAll''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 300 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (DeselectAll ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> deselectAll' tree_itemPtr
isSelected' :: (Ptr ()) -> IO ((Bool))
isSelected' a1 =
  let {a1' = id a1} in
  isSelected''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 303 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (IsSelected ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> isSelected' tree_itemPtr
activate' :: (Ptr ()) -> IO ()
activate' a1 =
  let {a1' = id a1} in
  activate''_ a1' >>
  return ()

{-# LINE 306 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO ())) => Op (Activate ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> activate' tree_itemPtr
activateWithVal' :: (Ptr ()) -> (Bool) -> IO ()
activateWithVal' a1 a2 =
  let {a1' = id a1} in
  let {a2' = cFromBool a2} in
  activateWithVal''_ a1' a2' >>
  return ()

{-# LINE 309 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ ( Bool ->  IO ())) => Op (ActivateWith ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> activateWithVal' tree_itemPtr val
isActive' :: (Ptr ()) -> IO ((Bool))
isActive' a1 =
  let {a1' = id a1} in
  isActive''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 312 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (IsActive ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> isActive' tree_itemPtr
visible' :: (Ptr ()) -> IO ((Bool))
visible' a1 =
  let {a1' = id a1} in
  visible''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 315 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (Visible ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> visible' tree_itemPtr
isVisible' :: (Ptr ()) -> IO ((Bool))
isVisible' a1 =
  let {a1' = id a1} in
  isVisible''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 318 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (IsVisible ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> isVisible' tree_itemPtr
visibleR' :: (Ptr ()) -> IO ((Bool))
visibleR' a1 =
  let {a1' = id a1} in
  visibleR''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 321 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (VisibleR ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> visibleR' tree_itemPtr
setUsericon' :: (Ptr ()) -> (Ptr ()) -> IO ()
setUsericon' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  setUsericon''_ a1' a2' >>
  return ()

{-# LINE 324 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a Image, impl ~ (Maybe (Ref a)  ->  IO ())) => Op (SetUsericon ()) TreeItem orig impl where
  runOp _ _ tree_item val = withRef tree_item $ \tree_itemPtr -> withMaybeRef val $ \valPtr -> setUsericon' tree_itemPtr valPtr
usericon' :: (Ptr ()) -> IO ((Ptr ()))
usericon' a1 =
  let {a1' = id a1} in
  usericon''_ a1' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 327 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Maybe (Ref Image)))) => Op (GetUsericon ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> usericon' tree_itemPtr >>= toMaybeRef
findClicked' :: (Ptr ()) -> (Ptr ()) -> IO ((Ptr ()))
findClicked' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  findClicked''_ a1' a2' >>= \res ->
  let {res' = id res} in
  return (res')

{-# LINE 330 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a  ->  IO (Maybe (Ref TreeItem)))) => Op (FindClicked ()) TreeItem orig impl where
  runOp _ _ tree_item prefs = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> findClicked' tree_itemPtr prefsPtr >>= toMaybeRef
eventOnCollapseIcon' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
eventOnCollapseIcon' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  eventOnCollapseIcon''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 333 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a  ->  IO (Int))) => Op (EventOnCollapseIcon ()) TreeItem orig impl where
  runOp _ _ tree_item prefs = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> eventOnCollapseIcon' tree_itemPtr prefsPtr
eventOnLabel' :: (Ptr ()) -> (Ptr ()) -> IO ((Int))
eventOnLabel' a1 a2 =
  let {a1' = id a1} in
  let {a2' = id a2} in
  eventOnLabel''_ a1' a2' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 336 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (Parent a TreePrefs, impl ~ (Ref a  ->  IO (Int))) => Op (EventOnLabel ()) TreeItem orig impl where
  runOp _ _ tree_item prefs = withRef tree_item $ \tree_itemPtr -> withRef prefs $ \prefsPtr -> eventOnLabel' tree_itemPtr prefsPtr
isRoot' :: (Ptr ()) -> IO ((Bool))
isRoot' a1 =
  let {a1' = id a1} in
  isRoot''_ a1' >>= \res ->
  let {res' = cToBool res} in
  return (res')

{-# LINE 339 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Bool))) => Op (IsRoot ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> isRoot' tree_itemPtr
labelX' :: (Ptr ()) -> IO ((Int))
labelX' a1 =
  let {a1' = id a1} in
  labelX''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 342 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (LabelX ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelX' tree_itemPtr
labelY' :: (Ptr ()) -> IO ((Int))
labelY' a1 =
  let {a1' = id a1} in
  labelY''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 345 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (LabelY ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelY' tree_itemPtr
labelW' :: (Ptr ()) -> IO ((Int))
labelW' a1 =
  let {a1' = id a1} in
  labelW''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 348 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (LabelW ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelW' tree_itemPtr
labelH' :: (Ptr ()) -> IO ((Int))
labelH' a1 =
  let {a1' = id a1} in
  labelH''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 351 "src/Graphics/UI/FLTK/LowLevel/TreeItem.chs" #-}

instance (impl ~ (IO (Int))) => Op (LabelH ()) TreeItem orig impl where
  runOp _ _ tree_item = withRef tree_item $ \tree_itemPtr -> labelH' tree_itemPtr


-- $hierarchy
-- @
-- "Graphics.UI.FLTK.LowLevel.TreeItem"
-- @

-- $functions
-- @
-- activate :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- activateWith :: 'Ref' 'TreeItem' -> 'Bool' -> 'IO' ()
--
-- add:: ('Parent' a 'TreeItem', 'Parent' b 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' b -> 'TreeItemLocator' -> 'IO' ('Maybe' ('Ref' a))
--
-- addAt:: ('Parent' a 'TreeItem', 'Parent' b 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' b -> ['T.Text'] -> 'Maybe' ('Ref' a) -> 'IO' ('Maybe' ('Ref' a))
--
-- child :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'WidgetBase'))
--
-- children :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- clearChildren :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- close :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- deparent :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'IO' ('Either' 'UnknownError' ('Ref' orig))
--
-- deselect :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- deselectAll :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- destroy :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- eventOnCollapseIcon:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Int')
--
-- eventOnLabel:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Int')
--
-- findChild :: 'Ref' 'TreeItem' -> 'TreeItemLocator' -> 'IO' ('Maybe' 'AtIndex')
--
-- findClicked:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- findInChildren :: 'Ref' 'TreeItem' -> ['T.Text'] -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- findItem :: 'Ref' 'TreeItem' -> ['T.Text'] -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getDepth :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- getH :: 'Ref' 'TreeItem' -> 'IO' 'Int'
--
-- getLabel :: 'Ref' 'TreeItem' -> 'IO' 'T.Text'
--
-- getLabelbgcolor :: 'Ref' 'TreeItem' -> 'IO' ('Color')
--
-- getLabelcolor :: 'Ref' 'TreeItem' -> 'IO' ('Color')
--
-- getLabelfgcolor :: 'Ref' 'TreeItem' -> 'IO' ('Color')
--
-- getLabelfont :: 'Ref' 'TreeItem' -> 'IO' ('Font')
--
-- getLabelsize :: 'Ref' 'TreeItem' -> 'IO' ('FontSize')
--
-- getParent :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- getUsericon :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'Image'))
--
-- getW :: 'Ref' 'TreeItem' -> 'IO' 'Int'
--
-- getWidget :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'WidgetBase'))
--
-- getX :: 'Ref' 'TreeItem' -> 'IO' 'Int'
--
-- getY :: 'Ref' 'TreeItem' -> 'IO' 'Int'
--
-- hasChildren :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- insert:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'T.Text' -> 'Maybe' 'AtIndex' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- insertAbove:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'T.Text' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- isActive :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- isClose :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- isOpen :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- isRoot :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- isSelected :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- isVisible :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- labelH :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- labelW :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- labelX :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- labelY :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- move :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'AtIndex' -> 'IO' ('Either' 'OutOfRange' ())
--
-- moveTo:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'MoveType' -> 'IO' ('Either' 'MoveError' ())
--
-- next :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- nextDisplayed:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- nextSibling :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- open :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- openToggle :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- prev :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- prevDisplayed:: ('Parent' a 'TreePrefs') => 'Ref' 'TreeItem' -> 'Ref' a -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- prevSibling :: 'Ref' 'TreeItem' -> 'IO' ('Maybe' ('Ref' 'TreeItem'))
--
-- removeChild :: 'Ref' 'TreeItem' -> 'TreeItemLocator' -> 'IO' ('Either' 'UnknownError' ())
--
-- reparent:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'AtIndex' -> 'IO' ('Either' 'UnknownError' ())
--
-- select :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- selectAll :: 'Ref' 'TreeItem' -> 'IO' ('Int')
--
-- selectSet :: 'Ref' 'TreeItem' -> 'Bool' -> 'IO' ()
--
-- selectToggle :: 'Ref' 'TreeItem' -> 'IO' ()
--
-- setLabel :: 'Ref' 'TreeItem' -> 'T.Text' -> 'IO' ()
--
-- setLabelbgcolor :: 'Ref' 'TreeItem' -> 'Color' -> 'IO' ()
--
-- setLabelcolor :: 'Ref' 'TreeItem' -> 'Color' -> 'IO' ()
--
-- setLabelfgcolor :: 'Ref' 'TreeItem' -> 'Color' -> 'IO' ()
--
-- setLabelfont :: 'Ref' 'TreeItem' -> 'Font' -> 'IO' ()
--
-- setLabelsize :: 'Ref' 'TreeItem' -> 'FontSize' -> 'IO' ()
--
-- setParent:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Maybe' ('Ref' a) -> 'IO' ()
--
-- setUsericon:: ('Parent' a 'Image') => 'Ref' 'TreeItem' -> 'Maybe' ('Ref' a) -> 'IO' ()
--
-- setWidget:: ('Parent' a 'WidgetBase') => 'Ref' 'TreeItem' -> 'Maybe' ( 'Ref' a ) -> 'IO' ()
--
-- showSelf :: 'Ref' 'TreeItem' -> 'Maybe' 'T.Text' -> 'IO' ()
--
-- swapChildren :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'AtIndex' -> 'IO' ()
--
-- swapChildrenByTreeItem:: ('Parent' a 'TreeItem') => 'Ref' 'TreeItem' -> 'Ref' a -> 'Ref' a -> 'IO' ('Either' 'TreeItemNotFound' ())
--
-- updatePrevNext :: 'Ref' 'TreeItem' -> 'AtIndex' -> 'IO' ()
--
-- visible :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
--
-- visibleR :: 'Ref' 'TreeItem' -> 'IO' ('Bool')
-- @

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_New_WithPrefs"
  newTreeItem''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_Destroy"
  destroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_x"
  x''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_y"
  y''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_w"
  w''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_show_self_with_indent"
  showSelfWithIndent''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_label"
  setLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_label"
  label''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_labelfont"
  setLabelfont''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_labelfont"
  labelfont''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_labelsize"
  setLabelsize''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_labelsize"
  labelsize''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_labelcolor"
  setLabelcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_labelcolor"
  labelcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_labelfgcolor"
  labelfgcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_labelfgcolor"
  setLabelfgcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_labelbgcolor"
  setLabelbgcolor''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CUInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_labelbgcolor"
  labelbgcolor''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CUInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_widget"
  setWidget''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_widget"
  widget''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_child_by_index"
  childByIndex''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_has_children"
  hasChildren''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_find_child"
  findChild''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_find_child_by_item"
  findChildByItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_remove_child_by_item"
  removeChildByItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_remove_child"
  removeChild''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_clear_children"
  clearChildren''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_swap_children"
  swapChildren''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_swap_children_by_tree_item"
  swapChildrenByTreeItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_find_child_item"
  findChildItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_find_item"
  findItem''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_add_with"
  addWith''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_add_with_at"
  addWithAt''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr ()))))))

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_add_at"
  addAt''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_insert"
  insert''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_insert_with_pos"
  insertWithPos''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_insert_above"
  insertAbove''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr ())))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_deparent"
  deparent''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_reparent"
  reparent''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_move"
  move''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_move_above"
  move_above''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_move_below"
  move_below''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_move_into"
  move_into''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_depth"
  depth''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_prev"
  prev''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_next"
  next''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_next_sibling"
  nextSibling''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_prev_sibling"
  prevSibling''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_update_prev_next"
  updatePrevNext''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_next_displayed"
  nextDisplayed''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_prev_displayed"
  prevDisplayed''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_parent"
  parent''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_parent"
  setParent''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_open"
  open''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_close"
  close''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_is_open"
  isOpen''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_is_close"
  isClose''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_open_toggle"
  openToggle''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_select"
  select''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_select_with_val"
  selectWithVal''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_select_toggle"
  selectToggle''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_select_all"
  selectAll''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_deselect"
  deselect''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_deselect_all"
  deselectAll''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_is_selected"
  isSelected''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_activate"
  activate''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_activate_with_val"
  activateWithVal''_ :: ((C2HSImp.Ptr ()) -> (C2HSImp.CInt -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_is_active"
  isActive''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CChar))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_visible"
  visible''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_is_visible"
  isVisible''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_visible_r"
  visibleR''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_set_usericon"
  setUsericon''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_usericon"
  usericon''_ :: ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ())))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_find_clicked"
  findClicked''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO (C2HSImp.Ptr ()))))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_event_on_collapse_icon"
  eventOnCollapseIcon''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_event_on_label"
  eventOnLabel''_ :: ((C2HSImp.Ptr ()) -> ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt)))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_is_root"
  isRoot''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_label_x"
  labelX''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_label_y"
  labelY''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_label_w"
  labelW''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/TreeItem.chs.h Fl_Tree_Item_label_h"
  labelH''_ :: ((C2HSImp.Ptr ()) -> (IO C2HSImp.CInt))