| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Graphics.UI.Threepenny.Editors
Contents
Description
Types and combinators to create widgets for editing algebraic datatypes.
This module builds around the idea that editors usually have the same shape as the data they are editing. We can immediately take advantage of this to automatically build editors from datatype definitions.
data Person = Person { first, last, email :: String, age :: Int }
deriveGeneric ''Person
instance Editable PersonThis produces a generic editor with a fixed vertical layout. To customize the layout, we can use a explicit instance and monoidal layout builders:
instance Editable Person where
editor = Person <$> fieldLayout Next "First:" first editor
<*> fieldLayout Break "Last:" last editor
<*> fieldLayout Next "Email:" email editor
<*> fieldLayout Next "Age:" age editorWe can take this a step further by repurposing datatype definitions to
represent not only data, but also the collections of editors that are composed
to build the datatype editor. This is done via the Purpose type
and the Field type family.
data Person purpose =
Person { first, last, email :: Field purpose String
, age :: Field purpose Int}
deriveGeneric ''Person
instance Editable (Person Data) where
type EditorWidget (Person Data) = Person Edit
editor = editorGenericBi
instance Renderable (Person Edit) where
render = renderGenericrenderGeneric will produce a vertical layout. A direct implementation would use standard threepenny layout combinators since the fields of Person Edit are instances of Widget:
instance Renderable (Person Edit) where
render Person{..} =
grid [[string "First:", element first, string "Email:", element email]
,[string "Last:", element last, string "Age:", element age]
]Synopsis
- newtype Editor outer widget inner where
- Editor {
- create :: Behavior outer -> UI (GenericWidget widget inner)
- pattern Horizontally :: Editor a Layout b -> Editor a Horizontal b
- pattern Vertically :: Editor a Layout b -> Editor a Vertical b
- Editor {
- class (HasEmpty a, Renderable (EditorWidget a), Renderable (ListEditorWidget a)) => Editable a where
- type EditorWidget a
- type ListEditorWidget a
- dimapE :: (a' -> a) -> (b -> b') -> Editor a el b -> Editor a' el b'
- (|*|) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a
- (|*) :: Editor s Layout a -> UI Element -> Editor s Layout a
- (*|) :: UI Element -> Editor s Layout a -> Editor s Layout a
- (-*-) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a
- (-*) :: Editor s Layout a -> UI Element -> Editor s Layout a
- (*-) :: UI Element -> Editor s Layout a -> Editor s Layout a
- field :: Renderable m => String -> (out -> inn) -> Editor inn m a -> Editor out Layout a
- fieldLayout :: (Renderable m, Renderable m') => (Layout -> m') -> String -> (out -> inn) -> Editor inn m a -> Editor out m' a
- withSomeWidget :: Renderable w => Editor a w b -> Editor a Layout b
- editorUnit :: Editor b Element b
- editorIdentity :: Editor a el a -> Editor (Identity a) el (Identity a)
- editorReadShow :: (Read a, Show a) => Editor (Maybe a) TextEntry (Maybe a)
- editorEnumBounded :: (Bounded a, Enum a, Ord a, Show a) => Behavior (a -> UI Element) -> Editor (Maybe a) (ListBox a) (Maybe a)
- editorSelection :: Ord a => Behavior [a] -> Behavior (a -> UI Element) -> Editor (Maybe a) (ListBox a) (Maybe a)
- editorSum :: (Ord tag, Show tag, Renderable el) => (Layout -> Layout -> Layout) -> [(tag, Editor a el a)] -> (a -> tag) -> Editor a Layout a
- editorJust :: Editor (Maybe b) el (Maybe b) -> Editor b el b
- editorString :: Editor String TextEntry String
- editorText :: Editor Text TextEntry Text
- editorCheckBox :: Editor Bool Element Bool
- editorList :: (HasEmpty a, Renderable w) => Editor a w a -> Editor (Maybe Int, [a]) (EditorCollection Int w) (Maybe Int, [a])
- editorCollection :: forall k v w. (Ord k, Renderable w) => (Behavior (Maybe k, Map k v) -> EditorCollectionConfig k v) -> Editor v w v -> Editor (Maybe k, Map k v) (EditorCollection k w) (Maybe k, Map k v)
- data EditorCollection k w
- someEditor :: Editable a => Editor a Layout a
- withSomeWidget :: Renderable w => Editor a w b -> Editor a Layout b
- type family Field (purpose :: Purpose) a where ...
- type family ListField (purpose :: Purpose) a where ...
- data Purpose
- editorGeneric :: forall a. (Generic a, HasDatatypeInfo a, All (All Editable `And` All HasEmpty) (Code a)) => Editor a Layout a
- editorGenericBi :: forall xs typ. (Generic (typ Data), Generic (typ Edit), All Editable xs, Code (typ Data) ~ '[xs], Code (typ Edit) ~ '[EditorWidgetsFor xs]) => Editor (typ Data) (typ Edit) (typ Data)
- data GenericWidget control a = GenericWidget {
- widgetTidings :: Tidings a
- widgetControl :: control
- edited :: GenericWidget el a -> Event a
- contents :: GenericWidget el a -> Behavior a
- data Layout
- newtype Vertical = Vertical {}
- newtype Horizontal = Horizontal {}
- data Columns
- class Renderable w where
- renderGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> UI Element
- getLayoutGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> [[Layout]]
- class HasEmpty a where
Editors
newtype Editor outer widget inner Source #
An editor for values of type inner inside a datatype outer realized by a widget.
All the three type arguments are functorial, but outer is contravariant, so Editor is a Biapplicative functor and a Profunctor (via dimapE).
Biapplicative allows to compose editors on both their widget and inner structure. When widget is monoidal, widget composition is implicit and Applicative suffices.
Profunctor allows to apply an inner editor to an outer datatype.
Once created, an Editor yields a tuple of an widget and a Tidings inner which can be integrated in a threepenny app.
Constructors
| Editor | |
Fields
| |
Bundled Patterns
| pattern Horizontally :: Editor a Layout b -> Editor a Horizontal b | Applicative modifier for horizontal composition of editor factories. This can be used in conjunction with ApplicativeDo as: editorPerson = horizontally $ do
firstName <- Horizontally $ field "First:" firstName editor
lastName <- Horizontally $ field "Last:" lastName editor
age <- Horizontally $ field "Age:" age editor
return Person{..}DEPRECATED: Use the |
| pattern Vertically :: Editor a Layout b -> Editor a Vertical b | Applicative modifier for vertical composition of editor factories. This can be used in conjunction with ApplicativeDo as: editorPerson = vertically $ do
firstName <- Vertically $ field "First:" firstName editor
lastName <- Vertically $ field "Last:" lastName editor
age <- Vertically $ field "Age:" age editor
return Person{..}DEPRECATED: Use the |
Instances
| Bifunctor (Editor a) Source # | |
| Biapplicative (Editor a) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types | |
| Functor (Editor a el) Source # | |
| Monoid el => Applicative (Editor a el) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types | |
class (HasEmpty a, Renderable (EditorWidget a), Renderable (ListEditorWidget a)) => Editable a where Source #
The class of Editable datatypes.
There are several ways to create an instance, from easiest to most advanced:
- Automatically (via
SOP), producing an editor with a vertical layout:
instance Editable MyDatatype
- Using the applicative layout combinators:
instance Editable MyDatatype where
editor = MyDatatype <$> field "Name:" name editor
-*- field "Age:" age editor- Using a monoidal layout builder:
instance Editable MyDatatype where
editor = MyDatatype <$> fieldLayout Break "Name:" name editor
<*> fieldLayout Next "Age:" age editor- Using a dual purpose datatype, leaving the layout details for the
Renderableinstance.
instance Editable (MyDatatype Data) where type EditorWidget (MyDatatype Data) = MyDatatype Edit editor = editorGenericBi
Associated Types
type EditorWidget a Source #
The widget type that realizes the editor. Defaults to Layout and only needs to be manually defined when using custom renderables.
type ListEditorWidget a Source #
The widget type that realizes the editor for lists. Defaults to 'EditorCollection.
Methods
editor :: Editor a (EditorWidget a) a Source #
listEditor :: Editor [a] (ListEditorWidget a) [a] Source #
editor :: (Generic a, HasDatatypeInfo a, All (All Editable `And` All HasEmpty) (Code a), EditorWidget a ~ Layout) => Editor a (EditorWidget a) a Source #
listEditor :: (HasEmpty a, ListEditorWidget a ~ EditorCollection Int (EditorWidget a)) => Editor [a] (ListEditorWidget a) [a] Source #
Instances
Editor composition
(|*|) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a infixl 4 Source #
Left-right editor composition
(|*) :: Editor s Layout a -> UI Element -> Editor s Layout a infixl 5 Source #
Left-right composition of an element with a editor
(*|) :: UI Element -> Editor s Layout a -> Editor s Layout a infixl 5 Source #
Left-right composition of an element with a editor
(-*-) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a infixl 4 Source #
Left-right editor composition
(-*) :: Editor s Layout a -> UI Element -> Editor s Layout a infixl 5 Source #
Left-right composition of an element with a editor
(*-) :: UI Element -> Editor s Layout a -> Editor s Layout a infixl 5 Source #
Left-right composition of an element with a editor
field :: Renderable m => String -> (out -> inn) -> Editor inn m a -> Editor out Layout a Source #
A helper that arranges a label and an editor horizontally.
fieldLayout :: (Renderable m, Renderable m') => (Layout -> m') -> String -> (out -> inn) -> Editor inn m a -> Editor out m' a Source #
A helper that arranges a label and an editor horizontally, wrapped in the given monoidal layout builder.
withSomeWidget :: Renderable w => Editor a w b -> Editor a Layout b Source #
Conceal the widget type of some Editor
Editor constructors
editorUnit :: Editor b Element b Source #
editorEnumBounded :: (Bounded a, Enum a, Ord a, Show a) => Behavior (a -> UI Element) -> Editor (Maybe a) (ListBox a) (Maybe a) Source #
editorSelection :: Ord a => Behavior [a] -> Behavior (a -> UI Element) -> Editor (Maybe a) (ListBox a) (Maybe a) Source #
An editor that presents a dynamic choice of values.
editorSum :: (Ord tag, Show tag, Renderable el) => (Layout -> Layout -> Layout) -> [(tag, Editor a el a)] -> (a -> tag) -> Editor a Layout a Source #
An editor for union types, built from editors for its constructors.
editorList :: (HasEmpty a, Renderable w) => Editor a w a -> Editor (Maybe Int, [a]) (EditorCollection Int w) (Maybe Int, [a]) Source #
A barebones editor for collections of editable items. Displays an index selector, add and delete buttons, and an editor for the selected item. Limitations: - Won't work with recursive data structures, due to the lack of FRP switch.
editorCollection :: forall k v w. (Ord k, Renderable w) => (Behavior (Maybe k, Map k v) -> EditorCollectionConfig k v) -> Editor v w v -> Editor (Maybe k, Map k v) (EditorCollection k w) (Maybe k, Map k v) Source #
A barebones editor for collections of editable items. Displays an index selector, add and delete buttons, and an editor for the selected item. Limitations: - Won't work with recursive data structures, due to the lack of FRP switch.
data EditorCollection k w Source #
Instances
| Renderable w => Renderable (EditorCollection k w) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types | |
someEditor :: Editable a => Editor a Layout a Source #
A version of editor with a concealed widget type.
withSomeWidget :: Renderable w => Editor a w b -> Editor a Layout b Source #
Conceal the widget type of some Editor
Dual purpose datatypes
type family Field (purpose :: Purpose) a where ... Source #
Type level fields. Used to define dual purpose datatype constructors, which can be instantiated to either store data or widgets. Example:
data PersonF (purpose :: Purpose) = Person
{ education :: Field purpose Education
, firstName, lastName :: Field purpose Text
, age :: Field purpose (Maybe Int)
}type Person = PersonF Data type PersonEditor = PersonF Edit
Equations
| Field Data a = a | |
| Field Edit a = EditorWidget a |
type family ListField (purpose :: Purpose) a where ... Source #
List version of Field. Example:
data PersonF (purpose :: Purpose) = Person
{ education :: Field purpose Education
, firstName, lastName :: Field purpose Text
, age :: Field purpose (Maybe Int)
, addresses :: ListField purpose String
}type Person = PersonF Data type PersonEditor = PersonF Edit
Equations
| ListField Data a = [a] | |
| ListField Edit a = ListEditorWidget a |
Generic editors
editorGeneric :: forall a. (Generic a, HasDatatypeInfo a, All (All Editable `And` All HasEmpty) (Code a)) => Editor a Layout a Source #
A generic editor derivation for SOP types.
The datatype arguments are layered in vertical fashion and labelled with field names if available.
editorGenericBi :: forall xs typ. (Generic (typ Data), Generic (typ Edit), All Editable xs, Code (typ Data) ~ '[xs], Code (typ Edit) ~ '[EditorWidgetsFor xs]) => Editor (typ Data) (typ Edit) (typ Data) Source #
A generic editor derivation for dual purpose datatypes with a single constructor.
e.g. for the datatype
data Person purpose = Person { firstName, lastName :: Field purpose String }
instance Editable (Person Data) where
type EditorWidget (Person Data) = Person Edit
editor = editorGenericBi
will be equivalent to
instance Editable (Person Data) where
type EditorWidget (Person Data) = Person Edit
editor = bipure DataItem DataItem
<<*>> edit firstName editor
<<*>> edit lastName editorWidgets
data GenericWidget control a Source #
Constructors
| GenericWidget | |
Fields
| |
Instances
| Bifunctor GenericWidget Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types Methods bimap :: (a -> b) -> (c -> d) -> GenericWidget a c -> GenericWidget b d # first :: (a -> b) -> GenericWidget a c -> GenericWidget b c # second :: (b -> c) -> GenericWidget a b -> GenericWidget a c # | |
| Functor (GenericWidget control) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types Methods fmap :: (a -> b) -> GenericWidget control a -> GenericWidget control b # (<$) :: a -> GenericWidget control b -> GenericWidget control a # | |
| Widget el => Widget (GenericWidget el a) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types Methods getElement :: GenericWidget el a -> Element # | |
| Renderable el => Renderable (GenericWidget el a) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types | |
edited :: GenericWidget el a -> Event a Source #
contents :: GenericWidget el a -> Behavior a Source #
Layouts
A rathe limited, grid layout builder, probably not fit for general purpose use yet.
Monoidal layouts
A monoidal layout builder that places everything in a single column
Constructors
| Vertical | |
Fields | |
newtype Horizontal Source #
A monoidal layout builder that places everything in a single row
Constructors
| Horizontal | |
Fields | |
Instances
| Semigroup Horizontal Source # | |
Defined in Graphics.UI.Threepenny.Editors.Layout Methods (<>) :: Horizontal -> Horizontal -> Horizontal # sconcat :: NonEmpty Horizontal -> Horizontal # stimes :: Integral b => b -> Horizontal -> Horizontal # | |
| Monoid Horizontal Source # | |
Defined in Graphics.UI.Threepenny.Editors.Layout Methods mempty :: Horizontal # mappend :: Horizontal -> Horizontal -> Horizontal # mconcat :: [Horizontal] -> Horizontal # | |
| Renderable Horizontal Source # | |
Defined in Graphics.UI.Threepenny.Editors.Layout | |
A monoidal layout builder that lays elements in columns
Custom layout definition
class Renderable w where Source #
Closely related to Widget, this class represents types that can be rendered to an Element, either directly or via Layout.
Instances
| Renderable String Source # | |
| Renderable TextEntry Source # | |
| Renderable Element Source # | |
| Renderable Columns Source # | |
| Renderable Horizontal Source # | |
Defined in Graphics.UI.Threepenny.Editors.Layout | |
| Renderable Vertical Source # | |
| Renderable Layout Source # | |
| Renderable (ListBox a) Source # | |
| Renderable a => Renderable (UI a) Source # | |
| (Renderable a, Renderable b) => Renderable (a -*- b) Source # | |
| (Renderable a, Renderable b) => Renderable (a |*| b) Source # | |
| Renderable w => Renderable (EditorCollection k w) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types | |
| Renderable el => Renderable (GenericWidget el a) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types | |
renderGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> UI Element Source #
A generic render derivation for data types with a single constructor
which renders the (labelled) fields in a vertical layout.
For custom layouts use getLayoutGeneric.
e.g. given the declarations
data PersonEditor = PersonEditor { firstName, lastName :: EditorWidget String }
deriveGeneric ''PersonEditor
using renderGeneric to instantiate Renderable
instance Renderable PersonEditor where getLayout = renderGeneric
will be equivalent to writing the below by hand
instance Renderable PersonEditor where
getLayout PersonEditor{..} =
grid [ [string "First name:", element firstName]
, [string "Last name:", element lastName ]
]
getLayoutGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> [[Layout]] Source #
A helper to implement getLayout for data types with a single constructor.
Given a value, getLayoutGeneric returns a grid of Layouts with one row per field.
Rows can carry one element, for unnamed fields; two elements, for named fields; or three elements, for operators.
Representing empty values
class HasEmpty a where Source #
This class defines how to represent empty values in a UI. A generic derivation is available for every SOP type.
Methods
emptyValue :: a Source #
emptyValue :: (Generic a, HasEmptyCode (Code a), All HasEmpty (Head (Code a))) => a Source #