-- 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/Ask.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-}
module Graphics.UI.FLTK.LowLevel.Ask
  (
    flBeep,
    BeepType(..),
    flMessage,
    flAlert,
    flInput,
    flPassword
  )
where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Ptr as C2HSImp





import C2HS hiding (cFromEnum, cToBool,cToEnum)

import qualified Data.Text as T
import Graphics.UI.FLTK.LowLevel.Utils

data BeepType = BeepDefault
              | BeepMessage
              | BeepError
              | BeepQuestion
              | BeepPassword
              | BeepNotification
  deriving (Eq,Show,Ord)
instance Enum BeepType where
  succ BeepDefault = BeepMessage
  succ BeepMessage = BeepError
  succ BeepError = BeepQuestion
  succ BeepQuestion = BeepPassword
  succ BeepPassword = BeepNotification
  succ BeepNotification = error "BeepType.succ: BeepNotification has no successor"

  pred BeepMessage = BeepDefault
  pred BeepError = BeepMessage
  pred BeepQuestion = BeepError
  pred BeepPassword = BeepQuestion
  pred BeepNotification = BeepPassword
  pred BeepDefault = error "BeepType.pred: BeepDefault 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 BeepNotification

  fromEnum BeepDefault = 0
  fromEnum BeepMessage = 1
  fromEnum BeepError = 2
  fromEnum BeepQuestion = 3
  fromEnum BeepPassword = 4
  fromEnum BeepNotification = 5

  toEnum 0 = BeepDefault
  toEnum 1 = BeepMessage
  toEnum 2 = BeepError
  toEnum 3 = BeepQuestion
  toEnum 4 = BeepPassword
  toEnum 5 = BeepNotification
  toEnum unmatched = error ("BeepType.toEnum: Cannot match " ++ show unmatched)

{-# LINE 30 "src/Graphics/UI/FLTK/LowLevel/Ask.chs" #-}


flBeep' :: IO ()
flBeep' =
  flBeep''_ >>
  return ()

{-# LINE 32 "src/Graphics/UI/FLTK/LowLevel/Ask.chs" #-}

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

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

flBeep :: Maybe BeepType -> IO ()
flBeep Nothing = flBeep'
flBeep (Just bt) = flBeepType' (fromIntegral (fromEnum bt))

flInput' :: (CString) -> IO ((CString))
flInput' a1 =
  (flip ($)) a1 $ \a1' ->
  flInput''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 38 "src/Graphics/UI/FLTK/LowLevel/Ask.chs" #-}

flInput :: T.Text -> IO (Maybe T.Text)
flInput msg = do
  r <- copyTextToCString msg >>= flInput'
  cStringToMaybeText r

flPassword' :: (CString) -> IO ((CString))
flPassword' a1 =
  (flip ($)) a1 $ \a1' ->
  flPassword''_ a1' >>= \res ->
  return res >>= \res' ->
  return (res')

{-# LINE 44 "src/Graphics/UI/FLTK/LowLevel/Ask.chs" #-}

flPassword :: T.Text -> IO (Maybe T.Text)
flPassword msg = do
  r <- copyTextToCString msg >>= flPassword'
  cStringToMaybeText r

flMessage' :: (CString) -> IO ()
flMessage' a1 =
  (flip ($)) a1 $ \a1' ->
  flMessage''_ a1' >>
  return ()

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

flMessage :: T.Text -> IO ()
flMessage t = copyTextToCString t >>= flMessage'

flAlert' :: (CString) -> IO ()
flAlert' a1 =
  (flip ($)) a1 $ \a1' ->
  flAlert''_ a1' >>
  return ()

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

flAlert :: T.Text -> IO ()
flAlert t = copyTextToCString t >>= flAlert'

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Ask.chs.h flc_beep"
  flBeep''_ :: (IO ())

foreign import ccall safe "Graphics/UI/FLTK/LowLevel/Ask.chs.h flc_beep_with_type"
  flBeepType''_ :: (C2HSImp.CInt -> (IO ()))

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

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

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

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