Safe Haskell | None |
---|---|
Language | Haskell2010 |
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 Person
This 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 editor
We 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 = renderGeneric
renderGeneric
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 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 |
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
Renderable
instance.
instance Editable (MyDatatype Data) where type EditorWidget (MyDatatype Data) = MyDatatype Edit editor = editorGenericBi
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
.
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
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
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 editor
Widgets
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 #
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
newtype Horizontal Source #
A monoidal layout builder that places everything in a single row
Instances
Semigroup Horizontal Source # | |
Defined in Graphics.UI.Threepenny.Editors.Layout (<>) :: Horizontal -> Horizontal -> Horizontal # sconcat :: NonEmpty Horizontal -> Horizontal # stimes :: Integral b => b -> Horizontal -> Horizontal # | |
Monoid Horizontal Source # | |
Defined in Graphics.UI.Threepenny.Editors.Layout 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 Layout
s 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.
emptyValue :: a Source #
emptyValue :: (Generic a, HasEmptyCode (Code a), All HasEmpty (Head (Code a))) => a Source #