diff --git a/WxGeneric.cabal b/WxGeneric.cabal --- a/WxGeneric.cabal +++ b/WxGeneric.cabal @@ -1,21 +1,20 @@ Name: WxGeneric -Version: 0.6.1 -Copyright: Mads Lindstrøm +Version: 0.8.1 +Copyright: Mads Lindstrøm License: LGPL License-file: wxWidgetsLicense.txt -Author: Mads Lindstrøm -Maintainer: Mads Lindstrøm +Author: Mads Lindstrøm +Maintainer: Mads Lindstrøm Homepage: http://www.haskell.org/haskellwiki/WxGeneric Category: GUI -Build-Depends: SybWidget >= 0.5.2 && < 0.6.0, - base >=4.1.0 && < 4.3.0, - haskell98 >= 1.0.1 && < 1.1.0, - mtl >= 1.0.0 && < 1.2.0, +Build-Depends: SybWidget >= 0.5.5 && < 0.6.0, + base >= 4.2.0 && < 4.6, + mtl >= 2.0.0.0, xtc >= 1.0 && < 1.1.0, - wx >= 0.12.0 && < 0.13.0, - containers >= 0.2.0 && < 0.4.0, - wxcore >= 0.12.0 && < 0.13.0 -Tested-with: GHC==6.12.1,GHC==6.10.4 + wx >= 0.12.0, + containers >= 0.4.0, + wxcore >= 0.12.0 +Tested-with: GHC==7.4.1 Synopsis: Generic (SYB3) construction of wxHaskell widgets Build-type: Simple Stability: experimental diff --git a/src/Graphics/UI/WxGeneric/GenericClass.hs b/src/Graphics/UI/WxGeneric/GenericClass.hs --- a/src/Graphics/UI/WxGeneric/GenericClass.hs +++ b/src/Graphics/UI/WxGeneric/GenericClass.hs @@ -1,7 +1,7 @@ {-# LANGUAGE ExistentialQuantification, FlexibleContexts , FlexibleInstances, FunctionalDependencies, KindSignatures , MultiParamTypeClasses, RankNTypes, ScopedTypeVariables, TypeSynonymInstances - , ImpredicativeTypes #-} + #-} {-# OPTIONS -Wall #-} module Graphics.UI.WxGeneric.GenericClass @@ -24,12 +24,12 @@ import qualified Graphics.UI.SybWidget as SW import qualified Graphics.UI.WxGeneric.GenericWidget as GW -import Graphics.UI.WxGeneric.GenericWidget (GenWid, GenWidIO) +import Graphics.UI.WxGeneric.GenericWidget (GenWid, GenWidIO(GenWidIO)) import qualified Graphics.UI.WxGeneric.Composite as C import qualified Graphics.UI.WxGeneric.Layout as L import Control.Monad.Reader -import Maybe +import Data.Maybe import qualified Data.Either as Either -- |Creates a widget from any type that implements WxGen. @@ -82,10 +82,11 @@ data Outer a = Outer SW.PriLabel (Either (GenWidIO a) (String -> GenWidIO a)) instance GW.MapValue Outer where - mapValue oldToNew newToOld (Outer lbl (Left genWidIO)) = - Outer lbl (Left (\w -> genWidIO w >>= return . GW.mapValue oldToNew newToOld)) - mapValue oldToNew newToOld (Outer lbl (Right genWidIO)) = - Outer lbl (Right (\s w -> genWidIO s w >>= return . GW.mapValue oldToNew newToOld)) + mapValue oldToNew newToOld (Outer lbl (Left (GenWidIO genWidIO))) = + Outer lbl (Left $ GenWidIO (\w -> genWidIO w >>= return . GW.mapValue oldToNew newToOld)) + mapValue oldToNew newToOld (Outer lbl (Right strToGenWidIO)) = + Outer lbl (Right (\s -> let GenWidIO genWidIO = strToGenWidIO s + in GenWidIO (\w -> genWidIO w >>= return . GW.mapValue oldToNew newToOld))) -- |Creates an 'Outer' type. The encapsulated widget is labelless. toOuter :: forall a. (WxGen a) => GenWidIO a -> Outer a @@ -99,8 +100,8 @@ -- |Unpacks an 'Outer' type and returns the encapsulated 'GenWid'. fromOuter :: GW.Parms w -> Outer a -> IO (GenWid a) -fromOuter w (Outer _ (Left f)) = f w -fromOuter w (Outer lbl (Right f)) = f (SW.labelString $ SW.humanizeLabel lbl) w +fromOuter w (Outer _ (Left (GenWidIO f))) = f w +fromOuter w (Outer lbl (Right f)) = GW.unWidIO (f (SW.labelString $ SW.humanizeLabel lbl)) w -- |Returns label if the widget do not show it itself getUnlabeld :: Outer a -> Maybe String @@ -131,8 +132,8 @@ mkWid x = case SW.constrRep (SW.toConstr wxGenCtx x) of SW.AlgConstr _ -> genericOuter True x - SW.IntConstr _ -> toOuter (\w -> anyNum ('-':['0'..'9']) x w) - SW.FloatConstr _ -> toOuter (\w -> anyNum ('-':'.':['0'..'9']) x w) + SW.IntConstr _ -> toOuter (anyNum ('-':['0'..'9']) x) + SW.FloatConstr _ -> toOuter (anyNum ('-':'.':['0'..'9']) x) SW.StringConstr [_] -> error "GenericClass: Char not implemented yet" -- FIXME SW.StringConstr _ -> error "GenericClass: No StringConstr constructors for other than Char." generateLabel :: a -> SW.PriLabel @@ -275,7 +276,8 @@ -- ********** AnyNum **************************************** anyNum :: (SW.Data WxGenD a) => String -> a -> GenWidIO a -anyNum legalChars initial genWidParms = +anyNum legalChars initial = GenWidIO + (\genWidParms -> do let p = GW.getParent genWidParms (sybGet, sybSet) <- SW.numericGetSet wxGenCtx initial intEn <- textEntry p [ processEnter := True @@ -287,6 +289,7 @@ setter initial C.propagateFutureEvents [C.Mouse, C.Focus] intEn p return $ GW.mkSingleObservableEx intEn hfill getter setter (GW.singleChild intEn) + ) where handleInput _ (EventKey (KeyChar c) mods _) | not (altDown mods || controlDown mods || metaDown mods) diff --git a/src/Graphics/UI/WxGeneric/GenericList.hs b/src/Graphics/UI/WxGeneric/GenericList.hs --- a/src/Graphics/UI/WxGeneric/GenericList.hs +++ b/src/Graphics/UI/WxGeneric/GenericList.hs @@ -64,7 +64,8 @@ mkStringOuter :: String -> GC.Outer String mkStringOuter x = GC.replacePoorConstrLabel "String" $ GC.toOuter helper where - helper genWidParms = + helper = GW.GenWidIO + (\genWidParms -> do let p = GW.getParent genWidParms te <- textEntry p [ text := x ] C.propagateFutureEvents [C.Mouse, C.Focus] te p @@ -72,7 +73,7 @@ setter val = set te [ text := val ] return $ GW.mkSingleObservableEx te hfill getter setter (GW.singleChild te) - + ) -- A function to show lists in a GUI. mkDefaultListOuter :: (GC.WxGen a, Show a) => [a] -> GC.Outer [a] diff --git a/src/Graphics/UI/WxGeneric/GenericWidget.hs b/src/Graphics/UI/WxGeneric/GenericWidget.hs --- a/src/Graphics/UI/WxGeneric/GenericWidget.hs +++ b/src/Graphics/UI/WxGeneric/GenericWidget.hs @@ -11,7 +11,7 @@ -} module Graphics.UI.WxGeneric.GenericWidget ( valuedCompose - , mkGenWid, mkSingleObservable, mkSingleObservableEx, GenWid, GenWidIO + , mkGenWid, mkSingleObservable, mkSingleObservableEx, GenWid, GenWidIO(GenWidIO), unWidIO , MapValue(..) , module Graphics.UI.WxGeneric.GenericWidget.Parameters , module Graphics.UI.WxGeneric.GenericWidget.WidgetTree @@ -25,21 +25,25 @@ import Graphics.UI.WxGeneric.GenericWidget.Parameters import Graphics.UI.WxGeneric.GenericWidget.WidgetTree -type GenWidIO a = forall w. Parms w -> IO (GenWid a) +data GenWidIO a = GenWidIO (forall w. Parms w -> IO (GenWid a)) +unWidIO :: GenWidIO a -> forall w. Parms w -> IO (GenWid a) +unWidIO (GenWidIO f) = f + -- |Composing multiple widgets into a composite GenWid. It is similar -- to 'C.compose'. valuedCompose :: (Parms (WXCore.CPanel ()) -> IO (Layout, IO a, a -> IO(), IO (IO ()), IO() -> IO(), IO WidTree) ) -> GenWidIO a -valuedCompose f genWidParms = +valuedCompose f = GenWidIO + (\genWidParms -> do let w = getParent genWidParms p <- panel w [] C.propagateFutureEvents C.allEvents p w (lay, getter, setter, getChange, setChange, getWidTree) <- f (setParent p genWidParms) return $ mkGenWidEx p (container p lay) getter setter getChange setChange getWidTree - + ) -- *** ValuedCmds data ValuedCmds a = ValuedCmds diff --git a/src/Graphics/UI/WxGeneric/GenericWidget/Parameters.hs b/src/Graphics/UI/WxGeneric/GenericWidget/Parameters.hs --- a/src/Graphics/UI/WxGeneric/GenericWidget/Parameters.hs +++ b/src/Graphics/UI/WxGeneric/GenericWidget/Parameters.hs @@ -90,7 +90,7 @@ greedyShortcuts :: [Char] -> TransformLabel greedyShortcuts usedShortcutLetters = mkTL where - mkTL = mkTransformLabel (Set.fromList usedShortcutLetters) (State . newLbl) + mkTL = mkTransformLabel (Set.fromList usedShortcutLetters) (state . newLbl) newLbl lbl used = case span (\x -> Set.member (Char.toLower x) used || (not $ Char.isAlpha x)) lbl of (_, []) -> (lbl, used) -- no available shortcut letter