WxFilePath.hs

{-# LANGUAGE RankNTypes, ScopedTypeVariables, TypeOperators #-}
{-# OPTIONS -fno-warn-orphans #-}

module Graphics.UI.AF.WxForm.WxFilePath () where

import qualified Graphics.UI.AF.General as AF

import Graphics.UI.AF.WxForm.WxFormImplementation
import Graphics.UI.WX hiding (Widget, value, dialog)
import Graphics.UI.AF.General.CustomTypes
import Graphics.UI.AF.WxForm.WxList()  -- must import as AFFilePath and AFDirectoryPath both contains a string ([Char])

{- Who made what?

Shelarcy made the AFDirectoryPath and merged it with AFFilePath.

Mads Lindstrøm made AFFilePath.

-}

instance ECCreator AFFilePath
    where
    makeEC x = dialogEC "file" filePath AFFilePath dialog' x
       where
           dialog' w _ = fileOpenDialog w True True "Choose file ..." [("Any file", ["*"])] "" ""

instance ECCreator AFDirectoryPath
     where
     makeEC x = dialogEC "directory" directoryPath AFDirectoryPath dialog' x
        where
            dialog' w val = dirOpenDialog w True "Choose directory ..." val

dialogEC :: (Eq a, Show a) =>
            String
         -> (a -> String)
         -> (String -> a)
         -> (forall w. Window w -> String -> IO (Maybe String))
         -> MakeEC a
dialogEC typeName fromType toType dialog' value = AF.builderToCom $
    do Parent w <- getPanel
       chooseB  <- io $ button w [ text := "Choose " ++ typeName ++ " ..."
                                 , enabled := True]
       te <- io $ textEntry w [processEnter := True]
       let gui = singleGui (badConstrLabel typeName)
                    (row 5 [hfill $ widget te, widget chooseB]) hfill
           setGuiValue x = set te [ text := fromType x ]
           setGuiEnable enable =
               do set chooseB  [ enabled := enable ]
                  set te [ enabled := enable ]
       (comH, parms) <- addCustomGui value setGuiValue te gui
       
       io $ set te [ on focus := \_ ->
                         do get te text >>= testInputParm' parms SetOnReject . toType
                            propagateEvent
                   ]
       io $ set chooseB [ on command :=
                             do val <- get te text
                                maybePath <- dialog' w val
                                maybe (return()) (testInputParm' parms SetOnAccept . toType)
                                      maybePath
                        ]
       return $ typeLift (\cio -> cio { pickSetEnabled = setGuiEnable }) comH