{-# LANGUAGE FlexibleContexts, FlexibleInstances, FunctionalDependencies , KindSignatures, MultiParamTypeClasses #-} module Graphics.UI.AF.General.AutoForm ( TypePresentation, SimpleDialog -- * Creating windows , infoDialog, errorDialog, window -- * Components , addCom -- ** Component constructors , mkCom, defaultCom, builderToCom, builderCom -- ** Valueless components , button, addTimer, executeProcess -- the last two do not return a component know, -- but they will in the future. -- * Mapping the component type -- -- |These functions do not change the GUI-user sees the components - -- only how the programmer sees them. E.g. they change state and\/or -- value, not presentation. -- -- ** State , state, makeChangedState, Changed(..) -- ** Value , Valued(..), Mergeable(..) -- * Actions , postponeAction , Action(..) -- ** Setting/getting value of component , ValuedAction(..) -- * Presentation of component , limit, label -- * Misc , AutoForm , commandImpl, command , addListener ) where import Graphics.UI.AF.General.MySYB import Control.Monad.Trans(liftIO, MonadIO) import Data.Monoid class Valued (valued :: * -> *) where -- |Maps the value of a compoent mapValue :: (old -> new) -- ^old to new conversion -> (old -> new -> old) -- ^new to old conversions. This functions also get the current -- old value as input. -> valued old -- ^old component -> valued new -- ^new component fstValue :: valued (valFst, valSnd) -> valued valFst fstValue valued = mapValue fst (\old new -> (new, snd old)) valued sndValue :: valued (valFst, valSnd) -> valued valSnd sndValue valued = mapValue snd (\old new -> (fst old, new)) valued -- |Hides the value of a valued object. noValue :: valued a -> valued () noValue valued = mapValue (const ()) (\old _ -> old) valued class Mergeable (valued :: * -> *) where merge :: valued left -> valued right -> valued (left, right) class (Monad action) => ValuedAction (valued :: * -> *) (action :: * -> *) where getValue :: valued a -> action a setValue :: valued a -> a -> action () nonRecursiveSetValue :: valued a -> a -> action () appendValue :: (Monoid a) => valued a -> a -> action () appendValue c xs = do value <- getValue c setValue c (value `mappend` xs) class ( Monad action ) => Action (action :: * -> *) (comH :: * -> *) | action -> comH, comH -> action where setEnabled :: comH a -> Bool -> action () closeWindow :: action () -- |Will give this compoment focus giveFocus :: comH a -> action () class ( Action action comH , Valued com, Valued comH -- , Mergeable com, Mergeable comH , ValuedAction comH action , SimpleDialog action, SimpleDialog builder ) => AutoForm (action :: * -> *) (comH :: * -> *) (builder :: * -> *) (satCxt :: * -> *) (com :: * -> *) | action -> comH, comH -> builder, builder -> satCxt, satCxt -> com, com -> action where -- |Makes a default component. That is, it do not call `mkCom`. defaultCom :: (Sat (satCxt a)) => a -> com a -- | Takes all components encapsulated in (added to) a builder -- monad and packages them in a component. builderToCom :: builder (comH a) -> com a -- |Encapsulates (or adds) a component in the builder monad. addCom :: com a -> builder (comH a) state :: s -> builder (comH s) -- postponeAction :: action a -> builder () button :: String -> action () -> builder (comH ()) addTimer :: Int -> action () -> builder () executeProcess :: String -> (Int -> action ()) -- ^OnEnd :: ExitCode -> (String -> action ()) -- ^OnStandardInput :: String -> (String -> action ()) -- ^OnStandardError :: String -> builder () -- |Limits the values a GUI-user can set a component to. limit :: (Show a) => (a -> IO Bool) -- ^The limit. -> String -- ^Error message displayed to the GUI-user, if the limit is violated. -> com a -> com a -- |Labels a component. This label will usually be displayed to the GUI-user. label :: String -- ^The label. -> com a -> com a addListener :: action () -> comH a -> builder (comH a) command :: (Sat (satCxt a), Sat (satCxt [String])) => builder () -- ^Not used in WxForm, just a proxy to identify AutoForm instance -> com a -> (a -> IO String) -- ^Command to execute -> IO () window :: com a -> action () commandImpl :: ( AutoForm action comH builder satCxt com , MonadIO action , Sat (satCxt a), Sat (satCxt [String]) ) => com a -> (a -> IO String) -- ^Command to execute -> builder () commandImpl ec execute = do outputArea <- addCom $ label "Output area" $ mkCom [""] commandInput <- addCom ec button "&Quit" closeWindow button "&Execute" (do output <- getValue commandInput >>= liftIO . execute mapM_ (appendValue outputArea) (map (\x -> [x]) $ lines output) ) return () -- |Adds any value to AutoForm interface. The following equation holds: -- builderCom x = addCom $ mkCom x builderCom :: ( Sat (satCxt a) , AutoForm action comH builder satCxt com , TypePresentation a action comH builder satCxt com ) => a -> builder (comH a) builderCom x = addCom $ mkCom x data Changed a = Changed | Unchanged a deriving (Eq, Show) makeChangedState :: (Eq a, AutoForm action comH builder satCxt com) => comH a -> builder (comH (Changed a)) makeChangedState comIO = do st <- state Changed let updateState = do cur <- getValue st new <- getValue comIO case (cur, new) of (Unchanged x, x') | x /= x' -> setValue st Changed _ -> return () addListener updateState comIO postponeAction (getValue comIO >>= setValue st . Unchanged) return st class TypePresentation a (action :: * -> *) (comH :: * -> *) (builder :: * -> *) (satCxt :: * -> *) (com :: * -> *) where -- |Constructs a component. The default implementation just calls -- 'defaultCom'. Override this if you want other behaviour. mkCom :: (AutoForm action comH builder satCxt com, Sat (satCxt a)) => a -> com a mkCom = defaultCom instance (AutoForm action comH builder satCxt com) => TypePresentation Bool action comH builder satCxt com instance (AutoForm action comH builder satCxt com) => TypePresentation Int action comH builder satCxt com instance (AutoForm action comH builder satCxt com) => TypePresentation Char action comH builder satCxt com instance (AutoForm action comH builder satCxt com) => TypePresentation Float action comH builder satCxt com instance (AutoForm action comH builder satCxt com) => TypePresentation Double action comH builder satCxt com instance (TypePresentation a action comH builder satCxt com) => TypePresentation [a] action comH builder satCxt com instance (TypePresentation a action comH builder satCxt com) => TypePresentation (Maybe a) action comH builder satCxt com instance (TypePresentation a action comH builder satCxt com ,TypePresentation b action comH builder satCxt com) => TypePresentation (a, b) action comH builder satCxt com instance (TypePresentation a action comH builder satCxt com ,TypePresentation b action comH builder satCxt com ,TypePresentation c action comH builder satCxt com) => TypePresentation (a, b, c) action comH builder satCxt com -- |The methods of this class shows simple dialogs. E.g. dialogs which -- do not take a component as input. class (Monad m) => SimpleDialog (m :: * -> *) where errorDialog :: String -- ^Title -> String -- ^Message -> m () infoDialog :: String -- ^Title -> String -- ^Message -> m () {- Design challengers with the SimpleDialog class We would have like to bring all windows-creating functions from AutoForms into SimpleDialog (and rename SimpleDialog to Dialog). However, it proved very difficult. If a function, like window, takes a component as input we are in trouble. 'window' function: window :: Menu a state m String -> component a state -> m () Note that the m in the window function is not always the same as the m in (SimpleDialog m). It is the same if we call window from within 'WxM', but if we call within (ActionM val state m) it is different. Thus: window :: (AutoForm component satCxt m') => Menu a state m' String -> component a state -> m () but then we are claiming that for any (AutoForm component satCxt m') we can with any monad m, implementing SimpleDialog, then we can bring up a window. For example if we are within (ActionM val state WxM) then: window [] should bring up a window (WxM is the WxForm monad). * AutoForm superclass for SimpleDialog Another option would be to let AutoForm be a superclass to SimpleDialog. But then type for SimpleDialog get a lot more complex. Also then we get undecidable instances, as we will have: class (AutoForm component satCxt m, Monad m') => Foo ... but component we will only be on the left side of => . * Another option requireing undecidable instances -- class (AutoForm component satCxt m, Monad m') class (Monad m, Monad m') => Foo (component :: * -> * -> *) (satCxt :: * -> *) (m :: * -> *) (m' :: * -> *) | m -> component, m -> satCxt , satCxt -> component, satCxt -> m , component -> satCxt, component -> m , m' -> component, m' -> satCxt, m' -> m where window' :: Menu a state m String -> component a state -> m' () Requires {-# OPTIONS -fallow-undecidable-instances #-} instance (Foo component satCxt m m) => Foo component satCxt m (ActionM val state m) where window' menu com = lift $ window' menu com From CFormImplementation: instance AF.Foo Com SatCxt Parent Parent where window' = error "Not implemented yet" From WxFormImplementation: instance AF.Foo EC SatCxt WxM WxM where window' menu com = AF.window menu com From AutoForm: class (Monad m, SimpleDialog m, Foo component satCxt m m) => AutoForm (component :: * -> * -> *) (satCxt :: * -> *) (m :: * -> *) -} {- To make it easier to make TypePresentation instances we could: -- Here we just need the actual type being spelized: instance PresentationAll Name where mkCom'''' p = AF.label "My name for Name" $ AF.defaultCom p class PresentationAll a where mkCom'''' :: (AutoForm component satCxt parent, Sat (satCxt a)) => a -> (component a ()) instance (PresentationAll a) => TypePresentation a component satCxt parent where mkCom = mkCom'''' instance PresentationAll a where mkCom'''' = defaultCom -} -- Rest is comments and design rationale {- Design rationale for TypePresentation I (call order) We could let ???Form call TypePresentation in stead of the other way around. Have tried it with the following signature: TypePresentation.customize :: component a () -> component a () that would make a call to mkCom unneccesary and thus make it simpler for the user. However that gave some problems. First of all the call to alterType were complicated. We either had to change customize's signature to: :: a -> component a () -> component a () the first parameter is the value that the GUI should show initially. Or we could add this value to the component. Another problem is that the user must call alterType first and then apply the result of it to other function, as the functionions called before it will be ignored. This seems untransparent to the user, and could easily lead to mistakes. The current solution with explicit calls to mkCom, seems more transparent to the user. A solution could be to fill out some datatype, like: data Customize { label :: String, limit :: [(a -> Bool, String)], alterType :: (a -> b, b -> a) } Then the ???Form instance could apply the different functions, in the order it needed to. The fields could be set with some custom setter function, supplied by the AutoForms library. This however seems to limit the flexibility (harder to add new features - I think) of the library, and I am not ready for that yet. _Conclusion_ I think I will wait with a solution, untill I have analyzed the situation more. More experience implementing the library will properly also help. -} {- Design rationale for TypePresentation II: There is an awful lot of parameters to TypePresentation. It is becoming a burden and its makes it harder to change existin code. Could we not have something like: class (AutoForm context component satCxt parent) => TypePresentation a context where as context decides all other variables of AutoForm? It seems to be related to this email: http://article.gmane.org/gmane.comp.lang.haskell.cafe/7995/match=functional+dependenices+in+class+declarations . Note however, that he seems to turn his functional dependency the wrong way. But that is not important as we get the same problem no matter what way we turn the dependency. So, I guess, it is a no. Another way to avoid the many type parameters, is to not have the four last parameters at all - Just "TypePresentation a". This is not a good solution either, as it proved difficult (maybe impossible) to use the alterType function. See Examples/MVCExample. Another problem is that it becomes impossible to specify that a certain TypePresentation only applies to some instance of AutoForm and not all instances of AutoForm. That is, we could not specialize differently for WxForm and ConsoleForms. -} {- form & modalForm * requirements * form needs to return imediately, so that the program do not stall * The user can make an extra thread, but this is cumbersome. And the point of using non-modal is that the user interface do not stall. * Should form has a modal option * can just use showModal. If he really needs to compute something he can start an extra thread. It is cumbersome, but OK since it would seldom happen. * Should there be a no-parent option? * When would that be useable? -} {- Limit function: design idea If limit's first parameter was not a function from a -> IO Bool, but rather some small internal language we could translate it to JavaScript or other languages. This could facilitate an AJAX like experience in a WebForms instance of AutoForms. Another way for this to happen, would be if we could somehow look at the compile tree. I think somebody was working on that. Who, where, or how, I cannot remember. -} {- ---------------------------- Trash ------------------------ -} {- class (Monad m, SimpleDialog m) => AutoForm (component :: * -> * -> *) (satCxt :: * -> *) (m :: * -> *) ... -- |Makes a display-only component. display :: (Sat (satCxt a)) => a -> component a () -- |Makes a component which cannot be seen. hidden :: (Sat (satCxt a)) => a -> component a () -- FIXME: Consider if this is really useable? ... -} {- class ( Monad action , Monad builder ) => DelayedAction (action :: * -> *) (comH :: * -> *) (builder :: * -> *) | builder -> comH where postponeAction :: action () -> builder () button :: String -> action () -> builder (comH ()) addTimer :: Int -> action () -> builder () executeProcess :: String -> (Int -> action ()) -- ^OnEnd :: ExitCode -> (String -> action ()) -- ^OnStandardInput :: String -> (String -> action ()) -- ^OnStandardError :: String -> builder () class Action setEnabled :: comH a -> Bool -> action () closeWindow :: action () class Builder addListener :: action () -> comH a -> builder (comH a) state :: s -> builder (comH s) class StaticCom limit :: (Show a) => (a -> IO Bool) -- ^The limit. -> String -- ^Error message displayed to the GUI-user, if the limit is violated. -> com a -> com a -- |Labels a component. This label will usually be displayed to the GUI-user. label :: String -- ^The label. -> com a -> com a maybe giveFocus ... for know maybe toStaticCom :: (dynamicCom a -> dynamicCom b) -> staticCom a -> staticCom b => AutoForm (action :: * -> *) (comH :: * -> *) (builder :: * -> *) (satCxt :: * -> *) (com :: * -> *) -- |Creates a static component from an arbitrary type staticCom :: (Sat (satCxt a)) => a -> com a -- | Takes all components encapsulated in a builder monad -- and packages them in a static component (staticCom). builderToStaticCom :: builder (comH a) -- ^The ... -> com a -- |Encapsulates a static component in a builder monad. addStaticCom :: com a -> builder (comH a) The two below can be implemented from staticCom and addStaticCom: dynamicCom :: (Sat (satCxt a)) => a -> builder (comH a) dynamicCom' :: (Sat (satCxt a)) => a -> (com a -> com b) -> builder (comH b) class Presentable a -- like builderCom present :: a -> builder (ComHandle a) -- maybe encapsulate instance Presentable (Com a) instance (Sat (satCxt a)) => Presentable a -- Maybe: class (Monad m) => Runable builder m where runBuilder :: String -> builder a -> m () -- currently the WxM.startI function or maybe just keep it in each instance. How else will the compiler know which instance to choose? Therefore, properly just rename startI to runWxBuilder. -}