module Examples.Grapefruit.SetView (
mainCircuit
) where
import Control.Applicative as Applicative
import Control.Arrow as Arrow
import Data.Monoid as Monoid
import Data.Sequence as Seq
import Data.Set as Set
import Data.Colour.RGBSpace as RGBSpace
import Data.Record as Record
import FRP.Grapefruit.Signal as Signal
import FRP.Grapefruit.Signal.Discrete as DSignal
import FRP.Grapefruit.Signal.Incremental as ISignal
import FRP.Grapefruit.Signal.Incremental.Set as SetISignal
import Graphics.UI.Grapefruit.Item as UIItem hiding (box)
import Graphics.UI.Grapefruit.Circuit as UICircuit
import Graphics.UI.Grapefruit.Backend.Basic as BasicUIBackend
import Graphics.UI.Grapefruit.Backend.Container as ContainerUIBackend
mainCircuit :: (ContainerUIBackend uiBackend) =>
UICircuit Window uiBackend era () (DSignal era ())
mainCircuit = proc _ -> do
X :& Closure := closure
`With` X
`With` _ <- mainWindow -< X :& Title := pure "Set view"
`With` X
`With` ()
returnA -< closure where
mainWindow = window `with` box Vertical `with` content
content :: (ContainerUIBackend uiBackend) => UICircuit Widget uiBackend era () ()
content = proc _ -> do
rec let
names = ISignal.construct Set.empty (DSignal.union insertions deletions)
insertions = elementInsertion <$> insertionNames
deletions = elementDeletion <$> deletionNames
cols = ISignal.const (Seq.fromList [firstNameCol,familyNameCol])
firstNameCol = Column "first name" firstNameDisplay textCell
firstNameDisplay = \(Name firstName _) -> TextCellDisplay firstName backgroundColor
familyNameCol = Column "family name" familyNameDisplay textCell
familyNameDisplay = \(Name _ familyName) -> TextCellDisplay familyName
backgroundColor
backgroundColor = RGB mempty mempty mempty
_ <- display -< (names,cols)
insertionNames <- modifier "Insert" -< ()
deletionNames <- modifier "Delete" -< ()
returnA -< ()
display :: (ContainerUIBackend uiBackend) =>
UICircuit Widget
uiBackend
era
(ISignal era (Set Name),ISignal era (Seq (Column uiBackend Name)))
()
display = proc (names,cols) -> do
X :& Selection := selection <- just setView -< X :& Elements := names
:& Columns := cols
X <- just label -< X :& Text := fmap (show . Set.toList)
selection
returnA -< ()
modifier :: (BasicUIBackend uiBackend) =>
String -> UICircuit Widget uiBackend era () (DSignal era Name)
modifier actionText = proc _ -> do
X :& Content := firstName <- just lineEditor -< X
X :& Content := familyName <- just lineEditor -< X
X :& Push := push <- just pushButton -< X :& Text := pure actionText
returnA -< Name <$ push <#> firstName <#> familyName
data Name = Name String String deriving (Eq, Ord, Show)