PersonTest.hs

{-# LANGUAGE FlexibleContexts, FlexibleInstances
  , MultiParamTypeClasses, TemplateHaskell
  , TypeSynonymInstances, UndecidableInstances #-}

module PersonTest where

import Person

-- With respect to GAutoForm instances you have two choices. One is a
-- bit cumbersome the other requires undecidable and overlapping
-- instances, which can be unsafe. The latter choice is used
-- here, which also requires the import of GAutoFormAll. The former
-- requires an instance declation for each used data type.

import Graphics.UI.WX as Wx hiding (close, button)
import Random
import Graphics.UI.AF.WxFormAll as AF
import Graphics.UI.AF.AFWx
import Graphics.UI.AF.General.MySYB
import Data.Word
import List(sort)


data Foo = Foo Int Int
           deriving (Show)

$(derive [''Foo])

aFoo, anotherFoo :: Foo
aFoo = Foo 3 5
anotherFoo = Foo 127 5

data Bar = Bar Foo Foo
           deriving (Show)

$(derive [''Bar])

aBar, anotherBar :: Bar
aBar = Bar aFoo aFoo
anotherBar = Bar anotherFoo anotherFoo

-- FIXME: here we have an error :( When The hole Foo is updated, as shown in myForm below,
-- listener (addListener ... i') is not triggerede.
instance AF.TypePresentation Foo AF.WxAct AF.ComH AF.WxM AF.ECCreatorD AF.EC where
    mkCom (Foo i _) = mapValue (\x -> Foo x x) (\_ (Foo i _) -> i) $ builderToCom $
        do i' <- builderCom i
           addListener (io $ putStrLn "i listener triggered") i'
           return i'

instance TypePresentation Address AF.WxAct AF.ComH AF.WxM AF.ECCreatorD AF.EC where
    mkCom p = layoutAs singleRow $ defaultCom p

main :: IO ()
main = myForm

myForm :: IO ()
myForm = startWx "" $
         do builderCom ()
            p <- builderCom (1::Float) -- Just somePerson
            builderCom $ Just (17.2::Float)
            s <- builderCom (17.2::Float)
            maybeVal <- AF.builderCom (Just "asdf")
            s' <- AF.builderCom ["Foobar II"]
            affect (+1) p s
            affect (+1) s p
            --
            ls <- AF.builderCom ([1::Double,52,9])
            -- affect sort ls ls
            --
            aBar'  <- AF.builderCom aBar
            button "set aFoo" (setValue aBar' anotherBar)
            button "Enable" (setEnabled maybeVal True >> giveFocus p)
            button "Disable" (setEnabled maybeVal False)
            button "Set Int to 123.1"   (setValue s 123.1)
            button "Append 1000" (sequence_ $ replicate 1000 (appendValue s' ["Krolymut\n"]))
            return ()