-- GENERATED by C->Haskell Compiler, version 0.28.1 Switcheroo, 1 April 2016 (Haskell)
-- Edit the ORIGNAL .chs file instead!


{-# LINE 1 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
module Graphics.UI.FLTK.LowLevel.NativeFileChooser
    (
     NativeFileChooserType(..),
     NativeFileChooserOption(..),
     NativeFileChooserUserAction(..),
     allNativeFileChooserOptions,
     -- * Constructor
     nativeFileChooserNew
     -- * Hierarchy
     --
     -- $hierarchy

     -- * Native_File_Chooser
     --
     -- $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_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 NativeFileChooserType = BrowseFile
                           | BrowseDirectory
                           | BrowseMultiFile
                           | BrowseMultiDirectory
                           | BrowseSaveFile
                           | BrowseSaveDirectory
  deriving (Show,Eq,Ord)
instance Enum NativeFileChooserType where
  succ BrowseFile = BrowseDirectory
  succ BrowseDirectory = BrowseMultiFile
  succ BrowseMultiFile = BrowseMultiDirectory
  succ BrowseMultiDirectory = BrowseSaveFile
  succ BrowseSaveFile = BrowseSaveDirectory
  succ BrowseSaveDirectory = error "NativeFileChooserType.succ: BrowseSaveDirectory has no successor"

  pred BrowseDirectory = BrowseFile
  pred BrowseMultiFile = BrowseDirectory
  pred BrowseMultiDirectory = BrowseMultiFile
  pred BrowseSaveFile = BrowseMultiDirectory
  pred BrowseSaveDirectory = BrowseSaveFile
  pred BrowseFile = error "NativeFileChooserType.pred: BrowseFile 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 BrowseSaveDirectory

  fromEnum BrowseFile = 0
  fromEnum BrowseDirectory = 1
  fromEnum BrowseMultiFile = 2
  fromEnum BrowseMultiDirectory = 3
  fromEnum BrowseSaveFile = 4
  fromEnum BrowseSaveDirectory = 5

  toEnum 0 = BrowseFile
  toEnum 1 = BrowseDirectory
  toEnum 2 = BrowseMultiFile
  toEnum 3 = BrowseMultiDirectory
  toEnum 4 = BrowseSaveFile
  toEnum 5 = BrowseSaveDirectory
  toEnum unmatched = error ("NativeFileChooserType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 49 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

data NativeFileChooserOption = NoOptions
                             | SaveasConfirm
                             | NewFolder
                             | Preview
                             | UseFilterExt
  deriving (Show,Eq,Ord)
instance Enum NativeFileChooserOption where
  succ NoOptions = SaveasConfirm
  succ SaveasConfirm = NewFolder
  succ NewFolder = Preview
  succ Preview = UseFilterExt
  succ UseFilterExt = error "NativeFileChooserOption.succ: UseFilterExt has no successor"

  pred SaveasConfirm = NoOptions
  pred NewFolder = SaveasConfirm
  pred Preview = NewFolder
  pred UseFilterExt = Preview
  pred NoOptions = error "NativeFileChooserOption.pred: NoOptions 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 UseFilterExt

  fromEnum NoOptions = 0
  fromEnum SaveasConfirm = 1
  fromEnum NewFolder = 2
  fromEnum Preview = 4
  fromEnum UseFilterExt = 8

  toEnum 0 = NoOptions
  toEnum 1 = SaveasConfirm
  toEnum 2 = NewFolder
  toEnum 4 = Preview
  toEnum 8 = UseFilterExt
  toEnum unmatched = error ("NativeFileChooserOption.toEnum: Cannot match " ++ show unmatched)

{-# LINE 50 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}


data NativeFileChooserUserAction =
  NativeFileChooserPicked |
  NativeFileChooserCancelled |
  NativeFileChooserError

allNativeFileChooserOptions :: [NativeFileChooserOption]
allNativeFileChooserOptions =
  [
   NoOptions,
   SaveasConfirm,
   NewFolder,
   Preview,
   UseFilterExt
  ]

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

{-# LINE 67 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

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

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

nativeFileChooserNew :: Maybe NativeFileChooserType -> IO (Ref NativeFileChooser)
nativeFileChooserNew t =
  case t of
   (Just t') -> newWithVal' (fromEnum t') >>= toRef
   Nothing -> new' >>= toRef

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

{-# LINE 75 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ IO ()) => Op (Destroy ()) NativeFileChooser orig impl where
  runOp _ _ chooser = swapRef chooser $ \chooserPtr -> do
    nativeFileChooserDestroy' chooserPtr
    return nullPtr
setType' :: (Ptr ()) -> (Int) -> IO ()
setType' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setType''_ a1' a2' >>
  return ()

{-# LINE 80 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ (NativeFileChooserType ->  IO ())) => Op (SetType ()) NativeFileChooser orig impl where
  runOp _ _ chooser type'' = withRef chooser $ \chooserPtr -> setType' chooserPtr (fromEnum type'')
type' :: (Ptr ()) -> IO ((Int))
type' a1 =
  let {a1' = id a1} in 
  type''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 83 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (NativeFileChooserType))) => Op (GetType_ ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> type' chooserPtr >>= return . toEnum
setOptions' :: (Ptr ()) -> (Int) -> IO ()
setOptions' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setOptions''_ a1' a2' >>
  return ()

{-# LINE 86 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ([NativeFileChooserOption] ->  IO ())) => Op (SetOptions ()) NativeFileChooser orig impl where
   runOp _ _ chooser options = withRef chooser $ \chooserPtr -> setOptions' chooserPtr (combine options)
options' :: (Ptr ()) -> IO ((Int))
options' a1 =
  let {a1' = id a1} in 
  options''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 89 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO ([NativeFileChooserOption]))) => Op (GetOptions ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> do
     opts <- options' chooserPtr
     if (opts == 0)
       then return []
       else return (extract allNativeFileChooserOptions $ fromIntegral opts)
count' :: (Ptr ()) -> IO ((Int))
count' a1 =
  let {a1' = id a1} in 
  count''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

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

instance (impl ~ ( IO (Int))) => Op (GetCount ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> count' chooserPtr
filename' :: (Ptr ()) -> IO ((T.Text))
filename' a1 =
  let {a1' = id a1} in 
  filename''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

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

instance (impl ~ ( IO (Maybe T.Text))) => Op (GetFilename ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> filename' chooserPtr >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
filenameWithI' :: (Ptr ()) -> (Int) -> IO ((T.Text))
filenameWithI' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  filenameWithI''_ a1' a2' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 103 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ (Int ->  IO (Maybe T.Text))) => Op (GetFilenameAt ()) NativeFileChooser orig impl where
   runOp _ _ chooser i = withRef chooser $ \chooserPtr -> filenameWithI' chooserPtr i >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
setDirectory' :: (Ptr ()) -> (T.Text) -> IO ()
setDirectory' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  setDirectory''_ a1' a2' >>
  return ()

{-# LINE 107 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ (T.Text ->  IO ())) => Op (SetDirectory ()) NativeFileChooser orig impl where
   runOp _ _ chooser val = withRef chooser $ \chooserPtr -> setDirectory' chooserPtr val
directory' :: (Ptr ()) -> IO ((T.Text))
directory' a1 =
  let {a1' = id a1} in 
  directory''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

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

instance (impl ~ ( IO (Maybe T.Text))) => Op (GetDirectory ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> directory' chooserPtr >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
setTitle' :: (Ptr ()) -> (T.Text) -> IO ()
setTitle' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  setTitle''_ a1' a2' >>
  return ()

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

instance (impl ~ (T.Text ->  IO ())) => Op (SetTitle ()) NativeFileChooser orig impl where
   runOp _ _ chooser title'' = withRef chooser $ \chooserPtr -> setTitle' chooserPtr title''
title' :: (Ptr ()) -> IO ((T.Text))
title' a1 =
  let {a1' = id a1} in 
  title''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

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

instance (impl ~ ( IO (Maybe T.Text))) => Op (GetTitle ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> title' chooserPtr >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
filter' :: (Ptr ()) -> IO ((T.Text))
filter' a1 =
  let {a1' = id a1} in 
  filter''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 121 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (Maybe T.Text))) => Op (GetFilter ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> filter' chooserPtr >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
setFilter' :: (Ptr ()) -> (T.Text) -> IO ()
setFilter' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  setFilter''_ a1' a2' >>
  return ()

{-# LINE 125 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ (T.Text ->  IO ())) => Op (SetFilter ()) NativeFileChooser orig impl where
   runOp _ _ chooser filter'' = withRef chooser $ \chooserPtr -> setFilter' chooserPtr filter''
filters' :: (Ptr ()) -> IO ((Int))
filters' a1 =
  let {a1' = id a1} in 
  filters''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 128 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (Filters ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> filters' chooserPtr
setFilterValue' :: (Ptr ()) -> (Int) -> IO ()
setFilterValue' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = fromIntegral a2} in 
  setFilterValue''_ a1' a2' >>
  return ()

{-# LINE 131 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ (Int ->  IO ())) => Op (SetFilterValue ()) NativeFileChooser orig impl where
   runOp _ _ chooser i = withRef chooser $ \chooserPtr -> setFilterValue' chooserPtr i
filterValue' :: (Ptr ()) -> IO ((Int))
filterValue' a1 =
  let {a1' = id a1} in 
  filterValue''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 134 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (Int))) => Op (GetFilterValue ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> filterValue' chooserPtr
setPresetFile' :: (Ptr ()) -> (T.Text) -> IO ()
setPresetFile' a1 a2 =
  let {a1' = id a1} in 
  let {a2' = unsafeToCString a2} in 
  setPresetFile''_ a1' a2' >>
  return ()

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

instance (impl ~ (T.Text ->  IO ())) => Op (SetPresetFile ()) NativeFileChooser orig impl where
   runOp _ _ chooser preset' = withRef chooser $ \chooserPtr -> setPresetFile' chooserPtr preset'
presetFile' :: (Ptr ()) -> IO ((T.Text))
presetFile' a1 =
  let {a1' = id a1} in 
  presetFile''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 140 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (Maybe T.Text))) => Op (GetPresetFile ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> presetFile' chooserPtr >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
errmsg' :: (Ptr ()) -> IO ((T.Text))
errmsg' a1 =
  let {a1' = id a1} in 
  errmsg''_ a1' >>= \res ->
  let {res' = unsafeFromCString res} in
  return (res')

{-# LINE 144 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (Maybe T.Text))) => Op (GetErrmsg ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> errmsg' chooserPtr >>= \s ->
     if (T.null s) then return Nothing else return (Just s)
show' :: (Ptr ()) -> IO ((Int))
show' a1 =
  let {a1' = id a1} in 
  show''_ a1' >>= \res ->
  let {res' = fromIntegral res} in
  return (res')

{-# LINE 148 "src/Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs" #-}

instance (impl ~ ( IO (NativeFileChooserUserAction))) => Op (ShowWidget ()) NativeFileChooser orig impl where
   runOp _ _ chooser = withRef chooser $ \chooserPtr -> do
     res' <- show' chooserPtr
     return $ case res' of
       0    -> NativeFileChooserPicked
       1    -> NativeFileChooserCancelled
       (-1) -> NativeFileChooserError
       x''  -> error $ "NativeFileChooser::showWidget, unknown option:" ++ (show  x'')

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

-- $functions
-- @
-- destroy :: 'Ref' 'NativeFileChooser' -> 'IO' ()
--
-- filters :: 'Ref' 'NativeFileChooser' -> 'IO' ('Int')
--
-- getCount :: 'Ref' 'NativeFileChooser' -> 'IO' ('Int')
--
-- getDirectory :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text')
--
-- getErrmsg :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text')
--
-- getFilename :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text')
--
-- getFilenameAt :: 'Ref' 'NativeFileChooser' -> 'Int' -> 'IO' ('Maybe' 'T.Text')
--
-- getFilter :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text')
--
-- getFilterValue :: 'Ref' 'NativeFileChooser' -> 'IO' ('Int')
--
-- getOptions :: 'Ref' 'NativeFileChooser' -> 'IO' (['NativeFileChooserOption')]
--
-- getPresetFile :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text')
--
-- getTitle :: 'Ref' 'NativeFileChooser' -> 'IO' ('Maybe' 'T.Text')
--
-- getType_ :: 'Ref' 'NativeFileChooser' -> 'IO' ('NativeFileChooserType')
--
-- setDirectory :: 'Ref' 'NativeFileChooser' -> 'T.Text' -> 'IO' ()
--
-- setFilter :: 'Ref' 'NativeFileChooser' -> 'T.Text' -> 'IO' ()
--
-- setFilterValue :: 'Ref' 'NativeFileChooser' -> 'Int' -> 'IO' ()
--
-- setOptions :: 'Ref' 'NativeFileChooser' -> ['NativeFileChooserOption'] -> 'IO' ()
--
-- setPresetFile :: 'Ref' 'NativeFileChooser' -> 'T.Text' -> 'IO' ()
--
-- setTitle :: 'Ref' 'NativeFileChooser' -> 'T.Text' -> 'IO' ()
--
-- setType :: 'Ref' 'NativeFileChooser' -> 'NativeFileChooserType' -> 'IO' ()
--
-- showWidget :: 'Ref' 'NativeFileChooser' -> 'IO' ('NativeFileChooserUserAction')
-- @

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

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs.h Fl_Native_File_Chooser_New"
  new''_ :: (IO (C2HSImp.Ptr ()))

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/NativeFileChooser.chs.h Fl_Native_File_Chooser_Destroy"
  nativeFileChooserDestroy''_ :: ((C2HSImp.Ptr ()) -> (IO ()))

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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