FileChooserDemo.hs

module Main where

import Graphics.UI.Gtk hiding (response)

main :: IO ()
main = do
  initGUI

  -- load up our main window
  gui <- builderNew
  builderAddFromFile gui "FileChooserDemo.glade"

  mainWindow <- builderGetObject gui castToWindow "mainWindow"

  -- get a handle on a various objects from the glade file
  on mainWindow objectDestroy mainQuit

  let onClicked obj = on obj buttonActivated

  -- -- and associate actions with the buttons
  selectFolderButton <- builderGetObject gui castToButton "selectFolderButton"
  selectFolderButton `onClicked` openSelectFolderDialog mainWindow

  createFolderButton <- builderGetObject gui castToButton "createFolderButton"
  createFolderButton `onClicked` openCreateFolderDialog mainWindow

  openFileButton <- builderGetObject gui castToButton "openFileButton"
  openFileButton `onClicked` openOpenFileDialog mainWindow

  saveFileButton <- builderGetObject gui castToButton "saveFileButton"
  saveFileButton `onClicked` openSaveFileDialog mainWindow

  openFilePreviewButton <- builderGetObject gui castToButton "openFilePreviewButton"
  openFilePreviewButton `onClicked` openFilePreviewDialog mainWindow

  quitButton <- builderGetObject gui castToButton "quitButton"
  quitButton `onClicked` (do
                           widgetDestroy mainWindow
                           mainQuit)

  -- The final step is to display the main window and run the main loop
  widgetShowAll mainWindow
  mainGUI


openSelectFolderDialog :: Window -> IO ()
openSelectFolderDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just $ "Demo of the standard dialog "
                   ++ "to select an existing folder")  --dialog title
              (Just parentWindow)                      --the parent window
              FileChooserActionSelectFolder            --the kind of dialog we want
              [("Yes, this new dialog looks nice"      --The buttons to display
               , ResponseAccept)
              ,("Eugh! Take me away!"
               ,ResponseCancel)]
  widgetShow dialog
  response <- dialogRun dialog
  case response of
    ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
                         putStrLn $ "you selected the folder " ++ show fileName
    ResponseCancel -> putStrLn "dialog canceled"
    ResponseDeleteEvent -> putStrLn "dialog closed"
  widgetHide dialog

openCreateFolderDialog :: Window -> IO ()
openCreateFolderDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just $ "Demo of the standard dialog to select "
                   ++ "a new folder (or existing) folder")  --dialog title
              (Just parentWindow)                     --the parent window
              FileChooserActionCreateFolder                 --the kind of dialog we want
              [("I want this new folder"                    --The buttons to display
               , ResponseAccept)
              ,("Bored now."
               ,ResponseCancel)]
  widgetShow dialog
  response <- dialogRun dialog
  case response of
    ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
                         putStrLn $ "you selected the folder " ++ show fileName
    ResponseCancel -> putStrLn "Getting bored?"
    ResponseDeleteEvent -> putStrLn "dialog closed"
  widgetHide dialog

openOpenFileDialog :: Window -> IO ()
openOpenFileDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just $ "Demo of the standard dialog to select "
                         ++ "an existing file")             --dialog title
              (Just parentWindow)                     --the parent window
              FileChooserActionOpen                         --the kind of dialog we want
              [("gtk-cancel"                                --The buttons to display
               ,ResponseCancel)
              ,("gtk-open"
               , ResponseAccept)]

  widgetShow dialog
  response <- dialogRun dialog
  case response of
    ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
                         putStrLn $ "you selected the file " ++ show fileName
    ResponseCancel -> putStrLn "dialog canceled"
    ResponseDeleteEvent -> putStrLn "dialog closed"
  widgetHide dialog

openSaveFileDialog :: Window -> IO ()
openSaveFileDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just $ "Demo of the standard dialog to select "
                         ++ "a new file")                   --dialog title
              (Just parentWindow)                     --the parent window
              FileChooserActionSave                         --the kind of dialog we want
              [("gtk-cancel"                                --The buttons to display
               ,ResponseCancel)                             --you can use stock buttons
              ,("gtk-save"
               , ResponseAccept)]
  widgetShow dialog
  response <- dialogRun dialog
  case response of
    ResponseAccept -> do Just fileName <- fileChooserGetFilename dialog
                         putStrLn $ "you called the new file " ++ show fileName
    ResponseCancel -> putStrLn "dialog canceled"
    ResponseDeleteEvent -> putStrLn "dialog closed"
  widgetHide dialog

openFilePreviewDialog :: Window -> IO ()
openFilePreviewDialog parentWindow = do
  dialog <- fileChooserDialogNew
              (Just $ "Demo of the standard dialog to select "
                   ++ "a new file - with a preview widget") --dialog title
              (Just parentWindow)                     --the parent window
              FileChooserActionOpen                         --the kind of dialog we want
              [("_Yes, yes that's very clever"              --The buttons to display
               , ResponseAccept)
              ,("_No, I'm not impressed"
               ,ResponseCancel)]

  --create and set an extra widget
  checkButton <- checkButtonNewWithLabel "frobnicate this file"
  dialog `fileChooserSetExtraWidget` checkButton

  --create and set a preview widget
  previewLabel <- labelNew $ Just "Preview appears here"
  previewLabel `labelSetLineWrap` True
  dialog `fileChooserSetPreviewWidget` previewLabel
  on dialog updatePreview $ do
    previewFile <- fileChooserGetPreviewFilename dialog
    previewLabel `labelSetText` case previewFile of
      Nothing -> "Preview appears here"
      (Just filename) -> "Just pretend this is a preview of the file:\n" ++
                          show filename

  widgetShow dialog
  response <- dialogRun dialog
  case response of
    ResponseAccept -> do fileName <- fileChooserGetFilename dialog
                         putStrLn $ "you selected the new file " ++ show fileName

                         --check the state of the extra widget
                         frobnicate <- toggleButtonGetActive checkButton
                         putStrLn $ if frobnicate
                                      then "you foolishly decided to frobnicate the file"
                                      else "you wisely decided not to frobnicate the file"
    ResponseCancel -> putStrLn "you were not impressed"
    ResponseDeleteEvent -> putStrLn "dialog closed"
  widgetHide dialog