module Graphics.UI.TinyFileDialogs
(
messageBox
, inputBox
, saveFileDialog
, openFileDialog
, selectFolderDialog
, colorChooser
, IconType(..)
, MessageBox
, OK(..)
, OKCancel(..)
, YesNo(..)
, YesNoCancel(..)
) where
import qualified Foreign.C.Types as C2HSImp
import qualified Foreign.Marshal.Utils as C2HSImp
import qualified Foreign.Ptr as C2HSImp
import Data.Char (toLower)
import qualified Data.Text as T
import Foreign (Ptr, Word8, nullPtr, peekArray, withArray,
withArrayLen, withMany)
import Foreign.C (CInt, CString, CUChar)
import Foreign.C (peekCString, withCString)
withCText :: T.Text -> (CString -> IO a) -> IO a
withCText = withCString . T.unpack
withCShowLower :: (Show a) => a -> (CString -> IO b) -> IO b
withCShowLower = withCText . T.pack . map toLower . show
withCMaybeText :: Maybe T.Text -> (CString -> IO a) -> IO a
withCMaybeText mt f = case mt of
Nothing -> f nullPtr
Just t -> withCText t f
peekMaybeText :: CString -> IO (Maybe T.Text)
peekMaybeText cstr = if cstr == nullPtr
then return Nothing
else fmap (Just . T.pack) $ peekCString cstr
peekMaybeTextMultiple :: CString -> IO (Maybe [T.Text])
peekMaybeTextMultiple = fmap (fmap $ T.splitOn (T.singleton '|')) . peekMaybeText
withCTexts :: [T.Text] -> ((CInt, Ptr CString) -> IO a) -> IO a
withCTexts ts f = withMany withCText ts $ \ptrs ->
withArrayLen ptrs $ \len ptr -> f (fromIntegral len, ptr)
class (Enum a, Bounded a) => MessageBox a where
messageBoxType :: a -> T.Text
messageBoxValue :: a -> Int
data IconType = Info | Warning | Error | Question
deriving (Eq, Ord, Show, Read, Enum, Bounded)
data OK = OK
deriving (Eq, Ord, Show, Read, Enum, Bounded)
instance MessageBox OK where
messageBoxType _ = T.pack "ok"
messageBoxValue OK = 1
data OKCancel = OC_OK | OC_Cancel
deriving (Eq, Ord, Show, Read, Enum, Bounded)
instance MessageBox OKCancel where
messageBoxType _ = T.pack "okcancel"
messageBoxValue OC_Cancel = 0
messageBoxValue OC_OK = 1
data YesNo = YN_Yes | YN_No
deriving (Eq, Ord, Show, Read, Enum, Bounded)
instance MessageBox YesNo where
messageBoxType _ = T.pack "yesno"
messageBoxValue YN_No = 0
messageBoxValue YN_Yes = 1
data YesNoCancel = YNC_Yes | YNC_No | YNC_Cancel
deriving (Eq, Ord, Show, Read, Enum, Bounded)
instance MessageBox YesNoCancel where
messageBoxType _ = T.pack "yesnocancel"
messageBoxValue YNC_Cancel = 0
messageBoxValue YNC_Yes = 1
messageBoxValue YNC_No = 2
c_messageBox :: (T.Text)
-> (T.Text)
-> (T.Text)
-> (IconType) -> (Int)
-> IO ((Int))
c_messageBox a1 a2 a3 a4 a5 =
withCText a1 $ \a1' ->
withCText a2 $ \a2' ->
withCText a3 $ \a3' ->
withCShowLower a4 $ \a4' ->
let {a5' = fromIntegral a5} in
c_messageBox'_ a1' a2' a3' a4' a5' >>= \res ->
let {res' = fromIntegral res} in
return (res')
messageBox
:: (MessageBox a)
=> T.Text
-> T.Text
-> IconType
-> a
-> IO a
messageBox ttl msg icon dflt = do
n <- c_messageBox ttl msg (messageBoxType dflt) icon (messageBoxValue dflt)
case lookup n [ (messageBoxValue x, x) | x <- [minBound .. maxBound] ] of
Just x -> return x
Nothing -> error $ "Graphics.UI.TinyFileDialogs.messageBox: internal error; unrecognized return value " ++ show n
inputBox :: (T.Text)
-> (T.Text)
-> (Maybe T.Text)
-> IO ((Maybe T.Text))
inputBox a1 a2 a3 =
withCText a1 $ \a1' ->
withCText a2 $ \a2' ->
withCMaybeText a3 $ \a3' ->
inputBox'_ a1' a2' a3' >>= \res ->
peekMaybeText res >>= \res' ->
return (res')
saveFileDialog :: (T.Text)
-> (T.Text)
-> ([T.Text])
-> (T.Text)
-> IO ((Maybe T.Text))
saveFileDialog a1 a2 a3 a4 =
withCText a1 $ \a1' ->
withCText a2 $ \a2' ->
withCTexts a3 $ \(a3'1, a3'2) ->
withCText a4 $ \a4' ->
saveFileDialog'_ a1' a2' a3'1 a3'2 a4' >>= \res ->
peekMaybeText res >>= \res' ->
return (res')
openFileDialog :: (T.Text)
-> (T.Text)
-> ([T.Text])
-> (T.Text)
-> (Bool)
-> IO ((Maybe [T.Text]))
openFileDialog a1 a2 a3 a4 a5 =
withCText a1 $ \a1' ->
withCText a2 $ \a2' ->
withCTexts a3 $ \(a3'1, a3'2) ->
withCText a4 $ \a4' ->
let {a5' = C2HSImp.fromBool a5} in
openFileDialog'_ a1' a2' a3'1 a3'2 a4' a5' >>= \res ->
peekMaybeTextMultiple res >>= \res' ->
return (res')
selectFolderDialog :: (T.Text)
-> (T.Text)
-> IO ((Maybe T.Text))
selectFolderDialog a1 a2 =
withCText a1 $ \a1' ->
withCText a2 $ \a2' ->
selectFolderDialog'_ a1' a2' >>= \res ->
peekMaybeText res >>= \res' ->
return (res')
c_colorChooser :: (T.Text) -> (Maybe T.Text) -> (Ptr CUChar) -> (Ptr CUChar) -> IO ((Maybe T.Text))
c_colorChooser a1 a2 a3 a4 =
withCText a1 $ \a1' ->
withCMaybeText a2 $ \a2' ->
let {a3' = id a3} in
let {a4' = id a4} in
c_colorChooser'_ a1' a2' a3' a4' >>= \res ->
peekMaybeText res >>= \res' ->
return (res')
withColor :: (Word8, Word8, Word8) -> (Ptr CUChar -> IO a) -> IO a
withColor (r, g, b) = withArray $ map fromIntegral [r, g, b]
colorChooser
:: T.Text
-> (Word8, Word8, Word8)
-> IO (Maybe (Word8, Word8, Word8))
colorChooser title color = withColor color $ \ptr -> do
res <- c_colorChooser title Nothing ptr ptr
case res of
Nothing -> return Nothing
Just _ -> fmap ((\[r, g, b] -> Just (r, g, b)) . map fromIntegral) $ peekArray 3 ptr
foreign import ccall safe "Graphics/UI/TinyFileDialogs.chs.h tinyfd_messageBox"
c_messageBox'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO C2HSImp.CInt))))))
foreign import ccall safe "Graphics/UI/TinyFileDialogs.chs.h tinyfd_inputBox"
inputBox'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))))
foreign import ccall safe "Graphics/UI/TinyFileDialogs.chs.h tinyfd_saveFileDialog"
saveFileDialog'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar)))))))
foreign import ccall safe "Graphics/UI/TinyFileDialogs.chs.h tinyfd_openFileDialog"
openFileDialog'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> ((C2HSImp.Ptr (C2HSImp.Ptr C2HSImp.CChar)) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (C2HSImp.CInt -> (IO (C2HSImp.Ptr C2HSImp.CChar))))))))
foreign import ccall safe "Graphics/UI/TinyFileDialogs.chs.h tinyfd_selectFolderDialog"
selectFolderDialog'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar))))
foreign import ccall safe "Graphics/UI/TinyFileDialogs.chs.h tinyfd_colorChooser"
c_colorChooser'_ :: ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> ((C2HSImp.Ptr C2HSImp.CUChar) -> (IO (C2HSImp.Ptr C2HSImp.CChar))))))