grapefruit-ui (empty) → 0.0.0.0
raw patch · 14 files changed
+1005/−0 lines, 14 filesdep +arrowsdep +basedep +grapefruit-frpsetup-changed
Dependencies added: arrows, base, grapefruit-frp, grapefruit-records
Files
- LICENSE +25/−0
- Setup.lhs +4/−0
- grapefruit-ui.cabal +50/−0
- src/Graphics/UI/Grapefruit/Backend.hs +47/−0
- src/Graphics/UI/Grapefruit/Backend/Std.hs +129/−0
- src/Graphics/UI/Grapefruit/Circuit.hs +21/−0
- src/Graphics/UI/Grapefruit/Comp.hs +92/−0
- src/Graphics/UI/Grapefruit/Interfacing.hs +15/−0
- src/Graphics/UI/Grapefruit/Item.hs +38/−0
- src/Internal/Interfacing.hs +98/−0
- src/Internal/UICircuit.hs +112/−0
- src/Internal/UICircuit.hs-boot +7/−0
- src/Internal/UIItem.hs +349/−0
- src/Internal/UIItem.hs-boot +18/−0
+ LICENSE view
@@ -0,0 +1,25 @@+Copyright © 2007–2009 Brandenburgische Technische Universität Cottbus+All rights reserved.++Redistribution and use in source and binary forms, with or without modification, are permitted+provided that the following conditions are met:++ * Redistributions of source code must retain the above copyright notice, this list of conditions+ and the following disclaimer.++ * Redistributions in binary form must reproduce the above copyright notice, this list of+ conditions and the following disclaimer in the documentation and/or other materials provided+ with the distribution.++ * Neither the name of the copyright holders nor the names of the contributors may be used to+ endorse or promote products derived from this software without specific prior written+ permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS “AS IS” AND ANY EXPRESS OR+IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND+FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDERS OR+CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF+THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.lhs view
@@ -0,0 +1,4 @@+#!/usr/bin/env runghc++> import Distribution.Simple+> main = defaultMain
+ grapefruit-ui.cabal view
@@ -0,0 +1,50 @@+Name: grapefruit-ui+Version: 0.0.0.0+Cabal-Version: >= 1.2.3+Build-Type: Simple+License: BSD3+License-File: LICENSE+Copyright: © 2007–2009 Brandenburgische Technische Universität Cottbus+Author: Wolfgang Jeltsch+Maintainer: jeltsch@informatik.tu-cottbus.de+Stability: provisional+Homepage: http://haskell.org/haskellwiki/Grapefruit+Package-URL: http://hackage.haskell.org/packages/archive/grapefruit-ui/0.0.0.0/grapefruit-ui-0.0.0.0.tar.gz+Synopsis: Declarative user interface programming+Description: Grapefruit is a library for Functional Reactive Programming (FRP) with a focus on+ user interfaces. FRP makes it possible to implement reactive and interactive systems+ in a declarative style. To learn more about FRP, have a look at+ <http://haskell.org/haskellwiki/Functional_Reactive_Programming>.+ .+ This package contains general user interface support. To make use of it, it has to be+ complemented by a UI backend. It is possible to have different UI backends+ implementing the same general interface on top of different UI toolkits. At the+ moment, the only backend is one based on GTK+. This is provided by the+ grapefruit-ui-gtk package.+Category: FRP, Reactivity, GUI, User Interfaces+Tested-With: GHC == 6.8.3+ GHC == 6.10.1++Library+ Build-Depends: arrows >= 0.2 && < 0.5,+ base >= 3.0 && < 4.1,+ grapefruit-frp >= 0.0 && < 0.1,+ grapefruit-records >= 0.0 && < 0.1+ Extensions: Arrows+ CPP+ EmptyDataDecls+ FlexibleContexts+ GeneralizedNewtypeDeriving+ Rank2Types+ TypeFamilies+ TypeOperators+ Exposed-Modules: Graphics.UI.Grapefruit.Circuit+ Graphics.UI.Grapefruit.Comp+ Graphics.UI.Grapefruit.Interfacing+ Graphics.UI.Grapefruit.Item+ Graphics.UI.Grapefruit.Backend+ Graphics.UI.Grapefruit.Backend.Std+ Other-Modules: Internal.Interfacing+ Internal.UICircuit+ Internal.UIItem+ HS-Source-Dirs: src
+ src/Graphics/UI/Grapefruit/Backend.hs view
@@ -0,0 +1,47 @@+-- |This module defines the basic interface to all user interface backends.+module Graphics.UI.Grapefruit.Backend (++ UIBackend (..)++) where++ -- Graphics.UI.Grapefruit+ import {-# SOURCE #-} Internal.UIItem as UIItem++ {-|+ The class of all user interface backends.++ A backend is represented by a type. This technique allows the class system to be used to+ manage different implementations of the same interface. @UIBackend@ declares an interface to+ basic functionality and is implemented by all user interface backends. Subclasses of+ @UIBackend@ extend the basic interface. A backend can be an instance of only some of these+ subclasses when some functionality is not yet implemented or cannot be provided by the+ backend. Backend types are typically used as phantom parameters. However, in some cases, an+ explicit value of a backend type is needed as a function argument. Therefore, a backend is+ usually a single-value type whose only value is named like the type.++ All associated types and methods of @UIBackend@ are used internally by Grapefruit and should+ not be used directly by the user.+ -}+ class UIBackend uiBackend where++ -- |@WidgetPlacement /uiBackend/@ provides the result of @'Placement' 'Widget' /uiBackend/@.+ type WidgetPlacement uiBackend :: *++ -- |@WindowPlacement /uiBackend/@ provides the result of @'Placement' 'Window' /uiBackend/@.+ type WindowPlacement uiBackend :: *++ -- |Initializes the backend.+ initialize :: uiBackend -> IO ()++ -- |Executes the event handling loop.+ handleEvents :: uiBackend -> IO ()++ -- |Asks the event handling loop to quit.+ requestQuitting :: uiBackend -> IO ()++ -- |Finalizes the backend.+ finalize :: uiBackend -> IO ()++ -- |Yields the placement of top-level windows.+ topLevel :: uiBackend -> Placement Window uiBackend
+ src/Graphics/UI/Grapefruit/Backend/Std.hs view
@@ -0,0 +1,129 @@+{-|+ This module declares a subclass of 'UIBackend' with methods that every reasonable UI backend+ should implement.+-}+module Graphics.UI.Grapefruit.Backend.Std (++ -- * Interface+ StdUIBackend (..),++ -- * Utilities+ Orientation (Horizontal, Vertical),+ Caption (ColdCaption, HotCaption),++ -- * Field names+ Closure (Closure),+ Push (Push),+ Text (Text),+ Title (Title)++) where++ -- FRP.Grapefruit+ import FRP.Grapefruit.Signal as Signal+ import FRP.Grapefruit.Signal.Discrete as DSignal+ import FRP.Grapefruit.Signal.Segmented as SSignal+ import FRP.Grapefruit.Record as Record+ import FRP.Grapefruit.Record.Optionality as OptionalityRecord++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Backend as UIBackend+ import Graphics.UI.Grapefruit.Item as UIItem+ import Graphics.UI.Grapefruit.Circuit as UICircuit++ -- * Interface+ -- |A subclass of 'UIBackend' which declares standard bricks and boxes.+ class (UIBackend uiBackend) => StdUIBackend uiBackend where++ -- |A widget showing one line of text.+ label :: Brick Widget uiBackend (X :& Req Text ::: SSignal `Of` String) X++ -- |A push button.+ pushButton :: Brick Widget uiBackend (X :& Req Text ::: SSignal `Of` String)+ (X :& Push ::: DSignal `Of` ())++ -- |A widget which aggregates and arbitrary number of other widgets.+ box :: Orientation -> Box UICircuit Widget Widget uiBackend X X++ -- |An ordinary window.+ window :: Box UIItem Widget Window uiBackend (X :& Req Title ::: SSignal `Of` String)+ (X :& Closure ::: DSignal `Of` ())++ -- * Utilities+ -- |An orientation of widgets in a box.+ data Orientation = Horizontal | Vertical++ {-|+ A caption of a widget with an optional hotkey marker.++ Currently, this type is not used.+ -}+ data Caption = ColdCaption String+ -- ^a caption without a hotkey+ | HotCaption String Char String+ -- ^a caption consisting of a prefix string, a hotkey and a suffix string++ -- * Field names+ {-|+ A field name.++ Typical properties:++ [kind]+ output++ [type]+ @'DSignal' `'Of'` ()@++ [meaning]+ a “window was closed” event+ -}+ data Closure = Closure++ {-|+ A field name.++ Typical properties:++ [kind]+ output++ [type]+ @'DSignal' `'Of'` ()@++ [meaning]+ a stream of button push events+ -}+ data Push = Push++ {-|+ A field name.++ Typical properties:++ [kind]+ input (required)++ [type]+ @'SSignal' `'Of'` String@++ [meaning]+ the caption of a widget+ -}+ data Text = Text++ {-|+ A field name.++ Typical properties:++ [kind]+ input (required)++ [type]+ @'SSignal' `'Of'` String@++ [meaning]+ the title of a window+ -}+ data Title = Title
+ src/Graphics/UI/Grapefruit/Circuit.hs view
@@ -0,0 +1,21 @@+{-FIXME:+ Once Haddock supports cross-package links to modules, make FRP.Grapefruit.Circuit below a+ hyperlink.+-}+{-|+ This module provides support for user interface circuits.++ UI circuits are systems of UI items (for example, widgets). They are similar to ordinary+ circuits as provided by FRP.Grapefruit.Circuit but have the additional feature of providing+ parts of user interfaces.+-}+module Graphics.UI.Grapefruit.Circuit (++ UICircuit,+ fromCircuit,+ run++) where++ -- Internal.Circuit+ import Internal.UICircuit as UICircuit
+ src/Graphics/UI/Grapefruit/Comp.hs view
@@ -0,0 +1,92 @@+{-|+ This module provides general support for user interface components.++ A user interface component is either a user interface item or a user interface circuit. UI items+ are introduced by "Graphics.UI.Grapefruit.Item" and UI circuits by+ "Graphics.UI.Grapefruit.Circuit".+-}+module Graphics.UI.Grapefruit.Comp (++ UIComp ((|>>), (>>|), loop, toUICircuit, fromUIItem),+ (<<|),+ (|<<)++) where++ -- Control+ import Control.Arrow as Arrow -- for documentation only++ -- FRP.Grapefruit+ import FRP.Grapefruit.Circuit as Circuit++ -- Internal+ import {-# SOURCE #-} Internal.UICircuit as UICircuit+ import {-# SOURCE #-} Internal.UIItem as UIItem++ {-|+ The class of all user interface components.++ A user interface component is a part of a user interface which communicates with the+ remainder of the user interface through signals.+ -}+ class UIComp uiComp where++ infixr 1 |>>+ {-|+ Adds a circuit before a user interface component.++ This does not add any items to the user interface but may add data manipulation and+ control functionality.+ -}+ (|>>) :: Circuit era i tmp+ -> uiComp item uiBackend era tmp o+ -> uiComp item uiBackend era i o++ infixr 1 >>|+ {-|+ Adds a circuit after a user interface component.++ This does not add any items to the user interface but may add data manipulation and+ control functionality.+ -}+ (>>|) :: uiComp item uiBackend era i tmp+ -> Circuit era tmp o+ -> uiComp item uiBackend era i o++ {-|+ Adds a feedback loop to a user interface component.++ This method is completely analogous to the 'Arrow.loop' method of 'ArrowLoop'. It is+ provided because not every instance of @UIComp@ is an arrow.+ -}+ loop :: uiComp item uiBackend era (i,feedback) (o,feedback) -> uiComp item uiBackend era i o++ -- |Converts a user interface component into a user interface circuit.+ toUICircuit :: uiComp item uiBackend era i o -> UICircuit item uiBackend era i o++ -- |Converts a user interface item into a user interface component.+ fromUIItem :: UIItem item uiBackend era i o -> uiComp item uiBackend era i o++ {-|+ Puts a circuit before a user interface component.++ This does not add any items to the user interface but may add data manipulation and control+ functionality. @(<<|)@ is equivalent to @flip ('|>>')@.+ -}+ (<<|) :: (UIComp uiComp)+ => uiComp item uiBackend era tmp o+ -> Circuit era i tmp+ -> uiComp item uiBackend era i o+ (<<|) = flip (|>>)++ {-|+ Puts a circuit after a user interface component.++ This does not add any items to the user interface but may add data manipulation and control+ functionality. @(|<<)@ is equivalent to @flip ('>>|')@.+ -}+ (|<<) :: (UIComp uiComp)+ => Circuit era tmp o+ -> uiComp item uiBackend era i tmp+ -> uiComp item uiBackend era i o+ (|<<) = flip (>>|)
+ src/Graphics/UI/Grapefruit/Interfacing.hs view
@@ -0,0 +1,15 @@+-- |This module is about creating interfaces of UI items.+module Graphics.UI.Grapefruit.Interfacing (++ -- * Interfacing+ Interfacing,+ basic,+ with,++ -- * Inner components+ With (With)++) where++ -- Internal+ import Internal.Interfacing as Interfacing
+ src/Graphics/UI/Grapefruit/Item.hs view
@@ -0,0 +1,38 @@+{-|+ This module provides support for user interface items.++ UI items are the building blocks of user interfaces. Typical items are widgets and windows. A UI+ item may contain another item or a UI circuit which is a system of UI items. An example of the+ former case is a window which contains a single widget. An example of the latter case is a box+ widget which contains an arbitrary number of other widgets.+-}+module Graphics.UI.Grapefruit.Item (++ -- * User interface items in general+ UIItem,+ item,++ -- * Bricks+ Brick,+ brick,+ just,++ -- * Boxes+ Box,+ box,+ with,+ With (With),++ -- * Kinds of items+ Item (type CommonInputOptRecord, type CommonOutputRecord),+ Placement,+ Widget,+ Window,++ -- * Field names+ IsEnabled (IsEnabled)++) where++ -- Internal+ import Internal.UIItem as UIItem
+ src/Internal/Interfacing.hs view
@@ -0,0 +1,98 @@+module Internal.Interfacing (++ -- * Interfacing+ Interfacing (Interfacing),+ basic,+ with,++ -- * Inner components+ With (With)++) where++ -- Control+ import Control.Arrow as Arrow+ import Control.Arrow.Operations as ArrowOperations+ import Control.Arrow.Transformer.Reader as ReaderArrow++ -- FRP.Grapefruit+ import FRP.Grapefruit.Circuit as Circuit+ import FRP.Grapefruit.Record as Record+ import FRP.Grapefruit.Record.Context as ContextRecord++ -- Internal+ import {-# SOURCE #-} Internal.UIItem as UIItem+ import Internal.UICircuit as UICircuit++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Comp as UIComp++ -- Fixities+ infixl 1 `With`++ -- * Interfacing+ {-|+ Describes communication of an item with its environment.++ An interfacing is a mapping from native items to circuits. These circuits handle input+ consumption and output production.+ -}+ newtype Interfacing nativeItem era i o = Interfacing (ReaderArrow nativeItem (Circuit era) i o)++ {-|+ Creates an interfacing based on signal connectors (consumers and producers).++ The input and output are signal records. The only restriction to these records is that their+ fields must have corresponding fields in the connector records. The order of fields in the+ signal records may differ from the order of connector fields and there may be connector+ fields without a corresponding signal field. Connectors, for which no signal field exists,+ are not performed.+ -}+ basic :: (Subrecord extIShape iShape, Subrecord extOShape oShape)+ => ContextConsumerRecord nativeItem iShape+ -> ContextProducerRecord nativeItem oShape+ -> Interfacing nativeItem era (SignalRecord era extIShape) (SignalRecord era extOShape)+ basic consumerRecord producerRecord = Interfacing $+ ContextRecord.consume (narrow consumerRecord) >>>+ ContextRecord.produce (narrow producerRecord)++ inner :: (UIComp uiComp)+ => (nativeItem -> Placement innerItem uiBackend)+ -> uiComp innerItem uiBackend era innerI innerO+ -> Interfacing nativeItem era innerI innerO+ inner placement innerComp = Interfacing $+ arr id &&& (readState >>> arr placement) >>>+ liftReader (runReader innerArrow) where++ UICircuit innerArrow = toUICircuit innerComp++ {-|+ Extends an interfacing so that the resulting interfacing also adds an inner component to the+ UI item in question and extends the input and output to contain the input and output of the+ inner component.+ -}+ with :: (UIComp uiComp)+ => (nativeItem -> Placement innerItem uiBackend)+ -- ^conversion from a native item into the placement for its inner items+ -> uiComp innerItem uiBackend era innerI innerO+ -- ^an inner user interface component+ -> Interfacing nativeItem era baseI baseO+ -- ^an interfacing to which the inner component interfacing shall be added+ -> Interfacing nativeItem era (baseI `With` innerI) (baseO `With` innerO)+ with placement innerComp (Interfacing baseInterfacingImpl) = interfacing' where++ interfacing' = Interfacing $+ arr fromWith >>>+ baseInterfacingImpl *** innerInterfacingImpl >>>+ arr toWith++ Interfacing innerInterfacingImpl = inner placement innerComp+++ fromWith (base `With` inner) = (base,inner)++ toWith (base,inner) = base `With` inner++ -- * Inner components+ -- |An input or output, extended with the input or output of an inner component.+ data base `With` inner = base `With` inner
+ src/Internal/UICircuit.hs view
@@ -0,0 +1,112 @@+module Internal.UICircuit (++ UICircuit (UICircuit),+ fromCircuit,+ run++) where++ -- Prelude+ import Prelude hiding ((.))++ -- Control+#if __GLASGOW_HASKELL__ >= 610+ import Control.Category as Category hiding (id)+ import qualified Control.Category as Category+#endif+ import Control.Arrow as Arrow+ import Control.Arrow.Transformer.Reader as ReaderArrow++ -- FRP.Grapefruit+ import FRP.Grapefruit.Circuit as Circuit+ import FRP.Grapefruit.Signal as Signal+ import FRP.Grapefruit.Signal.Discrete as DSignal++ -- Internal+ import {-# SOURCE #-} Internal.UIItem as UIItem++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Backend as UIBackend+ import Graphics.UI.Grapefruit.Comp as UIComp++ {-|+ The type of user interface circuits.++ The @item@ parameter is a phantom parameter which says which kind of items the circuit+ contains. It should be an instance of 'Item'.+ -}+ newtype UICircuit item uiBackend era i o = UICircuit (ReaderArrow (Placement item uiBackend)+ (Circuit era)+ i+ o)++ -- manual deriving because of GHC bug #1133+#if __GLASGOW_HASKELL__ >= 610+ instance Category (UICircuit item uiBackend era) where++ id = UICircuit Category.id++ UICircuit arrow1 . UICircuit arrow2 = UICircuit (arrow1 . arrow2)+#endif++ instance Arrow (UICircuit item uiBackend era) where++ arr fun = UICircuit (arr fun)++#if __GLASGOW_HASKELL__ < 610+ UICircuit arrow1 >>> UICircuit arrow2 = UICircuit (arrow1 >>> arrow2)+#endif++ first (UICircuit arrow) = UICircuit (first arrow)++ second (UICircuit arrow) = UICircuit (second arrow)++ UICircuit arrow1 *** UICircuit arrow2 = UICircuit (arrow1 *** arrow2)++ UICircuit arrow1 &&& UICircuit arrow2 = UICircuit (arrow1 &&& arrow2)++ instance ArrowLoop (UICircuit item uiBackend era) where++ loop (UICircuit arrow) = UICircuit (Arrow.loop arrow)++ -- “really manual” instance (not just because of manual deriving)+ instance UIComp UICircuit where++ circuit |>> uiCircuit = fromCircuit circuit >>> uiCircuit++ uiCircuit >>| circuit = uiCircuit >>> fromCircuit circuit++ loop = Arrow.loop++ toUICircuit = id++ fromUIItem (UIItem uiCircuit) = uiCircuit++ -- |Converts an ordinary circuit into a user interface circuit that contains no items.+ fromCircuit :: Circuit era i o -> UICircuit item uiBackend era i o+ fromCircuit = liftReader >>> UICircuit++ {-|+ Runs a user interface circuit.++ @run@ quits when the output signal of the circuit has a first occurence. The universal+ quantification of the circuit’s era parameter ensures that the circuit does not use+ signals which are produced outside the circuit and therefore avoids era mismatches.+ -}+ run :: (UIBackend uiBackend) =>+ uiBackend -> (forall era. UICircuit Window uiBackend era () (DSignal era ())) -> IO ()+ run uiBackend uiCircuit = run where++ run = do+ UIBackend.initialize uiBackend+ (_,finalizeCircuit) <- Circuit.create circuit ()+ UIBackend.handleEvents uiBackend+ finalizeCircuit+ UIBackend.finalize uiBackend+ -- Where are the top level windows removed?++ circuit = proc _ -> do+ quittingReq <- runReader $+ case uiCircuit of UICircuit arrow -> arrow+ -< ((),topLevel uiBackend)+ consume $ DSignal.consumer (const (requestQuitting uiBackend)) -< quittingReq
+ src/Internal/UICircuit.hs-boot view
@@ -0,0 +1,7 @@+module Internal.UICircuit (++ UICircuit++) where++ data UICircuit item uiBackend era i o
+ src/Internal/UIItem.hs view
@@ -0,0 +1,349 @@+module Internal.UIItem (++ -- * User interface items in general+ UIItem (UIItem),+ item,++ -- * Bricks+ Brick,+ brick,+ just,++ -- * Boxes+ Box,+ box,+ with,+ With (With),++ -- * Kinds of items+ Item (type CommonInputOptRecord, type CommonOutputRecord),+ Placement,+ Widget,+ Window,++ -- * Field names+ IsEnabled (IsEnabled)++) where++ -- Controls+ import Control.Arrow as Arrow+ import Control.Arrow.Operations as ArrowOperations+ import Control.Arrow.Transformer.Reader as ReaderArrow++ -- FRP.Grapefruit+ import FRP.Grapefruit.Circuit as Circuit+ import FRP.Grapefruit.Signal as Signal+ import FRP.Grapefruit.Signal.Segmented as SSignal+ import FRP.Grapefruit.Record as Record+ import FRP.Grapefruit.Record.Optionality as OptionalityRecord+ import FRP.Grapefruit.Record.Context as ContextRecord++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Backend as UIBackend++ -- Internal+ import Internal.UICircuit as UICircuit+ import Internal.Interfacing as Interfacing hiding (with)+ import qualified Internal.Interfacing as Interfacing++ -- Graphics.UI.Grapefruit+ import Graphics.UI.Grapefruit.Comp as UIComp++ -- * User interface items in general+ {-|+ The type of user interface items.++ The @item@ parameter is a phantom parameter which denotes the kind of the item. It should+ be an instance of 'Item'.+ -}+ newtype UIItem item uiBackend era i o = UIItem (UICircuit item uiBackend era i o)++ -- manual deriving because of GHC bug #1133+ instance UIComp UIItem where++ circuit |>> UIItem uiCircuit = UIItem (circuit |>> uiCircuit)++ UIItem uiCircuit >>| circuit = UIItem (uiCircuit >>| circuit)++ loop (UIItem uiCircuit) = UIItem (Arrow.loop uiCircuit)++ toUICircuit (UIItem uiCircuit) = uiCircuit++ fromUIItem = id++ {-|+ Constructs an item using functionality of an underlying imperative library.++ The @nativeItem@ type variable represents an item type of the underlying library.+ -}+ item :: (nativeItem -> IO ())+ -- ^an action which makes a native item visible+ -> (Placement item uiBackend -> IO nativeItem)+ -- ^an action which creates a native item depending on a placement for the item+ -> Interfacing nativeItem era i o+ -- ^the interface specification for the item+ -> UIItem item uiBackend era i o+ item showItem+ newItem+ (Interfacing interfacingImpl) = UIItem $+ UICircuit $ arr id &&& readState >>> liftReader arrow where++ arrow = proc (i,placement) -> do+ nativeItem <- act -< newItem placement+ o <- runReader interfacingImpl -< (i,nativeItem)+ _ <- act -< showItem nativeItem+ returnA -< o++ -- * Bricks+ {-|+ A brick is an era-independent item with a comfortable record-based interface.++ The parameter @iOptRecord@ is an optionality record and therefore specifies a set of+ required and a set of optional fields. When the brick is used, the input fields can be given+ in any order and optional fields can be left out. Similarily, @oRecord@ specifies a set of+ fields (without optionalities) of whom not all have to be utilized by the user of the brick.++ A brick has additional input and output fields which are not explicitely mentioned in its+ type. For an item kind @/item/@, they are given by @'CommonInputOptRecord' /item/@ and+ @'CommonOutputRecord' /item/@. Therefore, it is possible to have inputs and outputs common+ for all bricks of a certain item kind.+ -}+ newtype Brick item uiBackend iOptRecord oRecord+ = Brick (forall era extIRecord extORecord.+ (Subrecord extIRecord+ (All iOptRecord `Cat` All (CommonInputOptRecord item)),+ Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))+ extIRecord,+ Subrecord extORecord+ (oRecord `Cat` CommonOutputRecord item)) =>+ UIItem item uiBackend era (SignalRecord era extIRecord)+ (SignalRecord era extORecord))++ -- |Constructs a brick.+ brick :: (Item item, OptRecord iOptRecord, Record oRecord)+ => ContextConsumerRecord nativeItem (All (CommonInputOptRecord item))+ {-^+ consumers of those inputs which are common to all bricks of the respective item+ kind+ -}+ -> ContextProducerRecord nativeItem (CommonOutputRecord item)+ {-^+ producers of those outputs which are common to all bricks of the respective item+ kind+ -}+ -> (nativeItem -> IO ())+ -- ^an action which makes a native item visible+ -> (Placement item uiBackend -> IO nativeItem)+ -- ^an action which creates a native item depending on a placement for the item+ -> ContextConsumerRecord nativeItem (All iOptRecord)+ -- ^consumers of those inputs which are specific to this brick+ -> ContextProducerRecord nativeItem oRecord+ -- ^producers of those outputs which are specific to this brick+ -> Brick item uiBackend iOptRecord oRecord+ brick commonConsumerRecord commonProducerRecord showItem newItem consumerRecord producerRecord+ = Brick $ item showItem+ newItem+ (Interfacing.basic (cat consumerRecord commonConsumerRecord)+ (cat producerRecord commonProducerRecord))++ {-|+ Converts a brick into an ordinary user interface component.++ The brick is first converted into a UI item which is then converted into the resulting+ component by applying 'fromUIItem'.++ The type of @just@ states the following properties of the resulting component:++ * The input record covers only fields which are input fields according to the type of+ the brick or are common input fields of all items of the respective kind.++ * The input record covers all input fields which are marked as required.++ * The output record covers only fields which are output fields according to the type of+ the brick or are common output fields of all items of the respective kind.++ * The order of fields is arbitrary.++ * The component is not tied to a specific era.++ * All input and output signals use the same era as the component.++ Dropping certain input or output fields results in the corresponding connectors not being+ executed.++ To make the type variables @extIRecord@ and @extORecord@ non-ambiguous, the lists of input+ and output field names have to be known at the call site. For the output field names, this+ is usually done via pattern matching.+ -}+ just :: (Subrecord extIRecord+ (All iOptRecord `Cat` All (CommonInputOptRecord item)),+ Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))+ extIRecord,+ Subrecord extORecord+ (oRecord `Cat` CommonOutputRecord item),+ UIComp uiComp)+ => Brick item uiBackend iOptRecord oRecord+ -> uiComp item uiBackend era (SignalRecord era extIRecord) (SignalRecord era extORecord)+ just (Brick item) = fromUIItem item++ -- * Boxes+ {-|+ A box is a container which can be transformed into an item by putting a user interface+ component into it.++ The component which is put into a box is called the inner component of that box. The+ parameters @innerItem@ and @item@ tell the type of the inner component and the item kind, it+ is based on.++ The interface of an item made from a box is similar to that of an item made from a brick.+ The only difference is that the interface of the box item covers also the input and the+ output of the inner component.+ -}+ newtype Box innerUIComp innerItem item uiBackend iOptRecord oRecord+ = Box (forall era extIRecord extORecord innerI innerO.+ (Subrecord extIRecord+ (All iOptRecord `Cat` All (CommonInputOptRecord item)),+ Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))+ extIRecord,+ Subrecord extORecord+ (oRecord `Cat` CommonOutputRecord item)) =>+ innerUIComp innerItem uiBackend era innerI innerO ->+ UIItem item uiBackend era (SignalRecord era extIRecord `With` innerI)+ (SignalRecord era extORecord `With` innerO))++ -- |Constructs a box.+ box :: (UIComp innerUIComp, Item item, OptRecord iOptRecord, Record oRecord)+ => ContextConsumerRecord nativeItem (All (CommonInputOptRecord item))+ {-^+ consumers of those inputs which are common to all bricks of the respective item+ kind+ -}+ -> ContextProducerRecord nativeItem (CommonOutputRecord item)+ {-^+ producers of those outputs which are common to all bricks of the respective item+ kind+ -}+ -> (nativeItem -> IO ())+ -- ^an action which makes a native item visible+ -> (Placement item uiBackend -> IO nativeItem)+ -- ^an action which creates a native item depending on a placement for the item+ -> (nativeItem -> Placement innerItem uiBackend)+ -- ^conversion from a native item into the placement for its inner items+ -> ContextConsumerRecord nativeItem (All iOptRecord)+ -- ^consumers of those inputs which are specific to this box+ -> ContextProducerRecord nativeItem oRecord+ -- ^producers of those outputs which are specific to this box+ -> Box innerUIComp innerItem item uiBackend iOptRecord oRecord+ box commonConsumerRecord commonProducerRecord+ showItem+ newItem+ placement+ consumerRecord producerRecord+ = Box $ \innerComp -> item showItem+ newItem+ (Interfacing.with placement innerComp $+ Interfacing.basic (cat consumerRecord commonConsumerRecord)+ (cat producerRecord commonProducerRecord))++ {-|+ Puts an inner component into a box and converts the result into an ordinary user interface+ component.++ This function is very similar to 'just'. In contrast to 'just', it takes the inner component+ as an additional argument and extends the input and output of the resulting component with+ the input and output of the inner component. Note that the era of the inner component equals+ the era of the resulting component.++ Applications of @with@ are usually written infix.+ -}+ with :: (Subrecord extIRecord+ (All iOptRecord `Cat` All (CommonInputOptRecord item)),+ Subrecord (Required iOptRecord `Cat` Required (CommonInputOptRecord item))+ extIRecord,+ Subrecord extORecord+ (oRecord `Cat` CommonOutputRecord item),+ UIComp uiComp)+ => Box innerUIComp innerItem item uiBackend iOptRecord oRecord+ -> innerUIComp innerItem uiBackend era innerI innerO+ -> uiComp item uiBackend era (SignalRecord era extIRecord `With` innerI)+ (SignalRecord era extORecord `With` innerO)+ with (Box item) = fromUIItem . item++ -- * Kinds of items+ {-|+ The class of all kinds of items.++ Instances of this class serve as phantom parameters of 'UIItem', 'UICircuit' and others.+ -}+ class (OptRecord (CommonInputOptRecord item), Record (CommonOutputRecord item)) =>+ Item item where++ -- |Inputs which are shared by all items of the respective kind.+ type CommonInputOptRecord item :: * -> *++ -- |Outputs which are shared by all items of the respective kind.+ type CommonOutputRecord item :: * -> *++ {-|+ The family of item placement types.++ A placement says where to place a user interface item, for example, to place a widget in a+ certain box or a window at the top level. @Graphics.UI.Grapefruit.Item@ declares two+ instances of @Placement@. @Placement 'Widget' /uiBackend/@ is equivalent to+ @'WidgetPlacement' /uiBackend/@ and @Placement 'Window' /uiBackend/@ is equivalent to+ @'WindowPlacement' /uiBackend/@.+ -}+ type family Placement item uiBackend :: *++ {-|+ The widget item kind.++ A widget is an item which resides inside a window. Examples of widgets are push buttons,+ labels and boxes (which contain other widgets themselves).+ -}+ data Widget++ instance Item Widget where++ type CommonInputOptRecord Widget = X :& Opt IsEnabled ::: SSignal `Of` Bool++ type CommonOutputRecord Widget = X++ type instance Placement Widget uiBackend = WidgetPlacement uiBackend++ {-|+ The window item kind.++ A window is an item which resides directly on the desktop and typically has a frame with a+ title and some control buttons. Examples of windows are application windows and dialogs.+ -}+ data Window++ instance Item Window where++ type CommonOutputRecord Window = X++ type CommonInputOptRecord Window = X++ type instance Placement Window uiBackend = WindowPlacement uiBackend++ -- * Field names+ {-|+ A field name.++ Typical properties:++ [kind]+ input (optional)++ [type]+ @'SSignal' `'Of'` Bool@++ [meaning]+ whether a widget is enabled or not++ Disabled widgets cannot receive user events and are typically displayed in a different+ style+ -}+ data IsEnabled = IsEnabled
+ src/Internal/UIItem.hs-boot view
@@ -0,0 +1,18 @@+module Internal.UIItem (++ UIItem (UIItem),+ Placement,+ Widget,+ Window++) where++ import {-# SOURCE #-} Internal.UICircuit as UICircuit++ newtype UIItem item uiBackend era i o = UIItem (UICircuit item uiBackend era i o)++ type family Placement item uiBackend :: *++ data Widget++ data Window