-- 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/Ask.chs" #-}
{-# LANGUAGE CPP, ExistentialQuantification, TypeSynonymInstances, FlexibleInstances, MultiParamTypeClasses, FlexibleContexts, ScopedTypeVariables #-}
module Graphics.UI.FLTK.LowLevel.Ask
  (
    flBeep,
    BeepType(..),
    flMessage,
    flAlert,
    flChoice,
    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 Data.Maybe (fromMaybe, maybe)
import Graphics.UI.FLTK.LowLevel.Utils

escapePercent :: T.Text -> T.Text
escapePercent :: Text -> Text
escapePercent t :: Text
t =
  let helper :: [Char] -> [Char]
helper [] = []
      helper ('%' : cs :: [Char]
cs) = '%' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: '%' Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
helper [Char]
cs
      helper (c :: Char
c : cs :: [Char]
cs) = Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char] -> [Char]
helper [Char]
cs
  in [Char] -> Text
T.pack ([Char] -> Text) -> [Char] -> Text
forall a b. (a -> b) -> a -> b
$ [Char] -> [Char]
helper ([Char] -> [Char]) -> [Char] -> [Char]
forall a b. (a -> b) -> a -> b
$ Text -> [Char]
T.unpack Text
t

data BeepType = BeepDefault
              | BeepMessage
              | BeepError
              | BeepQuestion
              | BeepPassword
              | BeepNotification
  deriving (BeepType -> BeepType -> Bool
(BeepType -> BeepType -> Bool)
-> (BeepType -> BeepType -> Bool) -> Eq BeepType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BeepType -> BeepType -> Bool
$c/= :: BeepType -> BeepType -> Bool
== :: BeepType -> BeepType -> Bool
$c== :: BeepType -> BeepType -> Bool
Eq,Int -> BeepType -> [Char] -> [Char]
[BeepType] -> [Char] -> [Char]
BeepType -> [Char]
(Int -> BeepType -> [Char] -> [Char])
-> (BeepType -> [Char])
-> ([BeepType] -> [Char] -> [Char])
-> Show BeepType
forall a.
(Int -> a -> [Char] -> [Char])
-> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
showList :: [BeepType] -> [Char] -> [Char]
$cshowList :: [BeepType] -> [Char] -> [Char]
show :: BeepType -> [Char]
$cshow :: BeepType -> [Char]
showsPrec :: Int -> BeepType -> [Char] -> [Char]
$cshowsPrec :: Int -> BeepType -> [Char] -> [Char]
Show,Eq BeepType
Eq BeepType =>
(BeepType -> BeepType -> Ordering)
-> (BeepType -> BeepType -> Bool)
-> (BeepType -> BeepType -> Bool)
-> (BeepType -> BeepType -> Bool)
-> (BeepType -> BeepType -> Bool)
-> (BeepType -> BeepType -> BeepType)
-> (BeepType -> BeepType -> BeepType)
-> Ord BeepType
BeepType -> BeepType -> Bool
BeepType -> BeepType -> Ordering
BeepType -> BeepType -> BeepType
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: BeepType -> BeepType -> BeepType
$cmin :: BeepType -> BeepType -> BeepType
max :: BeepType -> BeepType -> BeepType
$cmax :: BeepType -> BeepType -> BeepType
>= :: BeepType -> BeepType -> Bool
$c>= :: BeepType -> BeepType -> Bool
> :: BeepType -> BeepType -> Bool
$c> :: BeepType -> BeepType -> Bool
<= :: BeepType -> BeepType -> Bool
$c<= :: BeepType -> BeepType -> Bool
< :: BeepType -> BeepType -> Bool
$c< :: BeepType -> BeepType -> Bool
compare :: BeepType -> BeepType -> Ordering
$ccompare :: BeepType -> BeepType -> Ordering
$cp1Ord :: Eq BeepType
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 :: BeepType -> BeepType -> [BeepType]
enumFromTo from :: BeepType
from to :: BeepType
to = BeepType -> [BeepType]
go BeepType
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 :: Int -> BeepType
toEnum 0 = BeepType
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 39 "src/Graphics/UI/FLTK/LowLevel/Ask.chs" #-}


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

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

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

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

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

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

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

flInput :: T.Text -> Maybe T.Text -> IO (Maybe T.Text)
flInput msg defaultMsg = do
  msgC <- copyTextToCString $ escapePercent msg
  let def = fromMaybe T.empty defaultMsg
  defaultC <- copyTextToCString def
  r <- flInput' msgC defaultC
  cStringToMaybeText r

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

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

flChoice :: T.Text -> T.Text -> Maybe T.Text -> Maybe T.Text -> IO Int
flChoice msg b0 b1 b2 = do
  msgC <- copyTextToCString $ escapePercent msg
  b0C <- copyTextToCString b0
  let stringOrNull t = maybe (return nullPtr) copyTextToCString t
  b1C <- stringOrNull b1
  b2C <- stringOrNull b2
  r <- flChoice' msgC b0C b1C b2C
  return $ fromIntegral r

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

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

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

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

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

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

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

{-# LINE 77 "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_with_deflt"
  flInput''_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar))))

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

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 ()))