Safe Haskell | None |
---|---|
Language | Haskell2010 |
Synopsis
- data GenericWidget control a = GenericWidget {
- widgetTidings :: Tidings a
- widgetControl :: control
- edited :: GenericWidget el a -> Event a
- contents :: GenericWidget el a -> Behavior a
- widgetControl :: GenericWidget control a -> control
- widgetTidings :: GenericWidget control a -> Tidings a
- 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 {
- liftElement :: UI el -> Editor a el ()
- dimapE :: (a' -> a) -> (b -> b') -> Editor a el b -> Editor a' el b'
- applyE :: (el1 -> el2 -> el) -> Editor in_ el1 (a -> b) -> Editor in_ el2 a -> Editor in_ 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
- editorUnit :: Editor b Element b
- editorIdentity :: Editor a el a -> Editor (Identity a) el (Identity a)
- editorString :: Editor String TextEntry String
- editorText :: Editor Text TextEntry Text
- editorCheckBox :: Editor Bool Element Bool
- 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
- data EditorCollection k w = EditorCollection {}
- 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)
- editorList :: (HasEmpty a, Renderable w) => Editor a w a -> Editor (Maybe Int, [a]) (EditorCollection Int w) (Maybe Int, [a])
- data EditorCollectionConfig k v = EditorCollectionConfig {
- eccNewKey :: Behavior k
- eccAfterDelKey :: Behavior (Maybe k)
- eccTemplate :: v
- eccOptions :: Behavior (Set k)
- eccDisplay :: Behavior (k -> UI Element)
- defaultEditorCollectionConfig :: (Enum k, Ord k, Show k, HasEmpty v) => Behavior (Maybe k, Map k v) -> EditorCollectionConfig k v
- class HasEmpty a where
GenericWidgets
data GenericWidget control a Source #
GenericWidget | |
|
Instances
Bifunctor GenericWidget Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types 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 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 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 #
widgetControl :: GenericWidget control a -> control Source #
The actual widget.
widgetTidings :: GenericWidget control a -> Tidings a Source #
The dynamic contents of the widget.
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 create
d, an Editor
yields a tuple of an widget
and a Tidings inner
which can be integrated in a threepenny app.
Editor | |
|
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 |
liftElement :: UI el -> Editor a el () Source #
Lift an HTML element into a vacuous editor.
applyE :: (el1 -> el2 -> el) -> Editor in_ el1 (a -> b) -> Editor in_ el2 a -> Editor in_ el b Source #
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.
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.
data EditorCollection k w Source #
Instances
Renderable w => Renderable (EditorCollection k w) Source # | |
Defined in Graphics.UI.Threepenny.Editors.Types |
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.
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.
data EditorCollectionConfig k v Source #
EditorCollectionConfig | |
|
defaultEditorCollectionConfig :: (Enum k, Ord k, Show k, HasEmpty v) => Behavior (Maybe k, Map k v) -> EditorCollectionConfig k v Source #
Representation of 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.
emptyValue :: a Source #
emptyValue :: (Generic a, HasEmptyCode (Code a), All HasEmpty (Head (Code a))) => a Source #