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