threepenny-editors-0.5.4: Composable algebraic editors

Safe HaskellNone
LanguageHaskell2010

Graphics.UI.Threepenny.Editors

Contents

Synopsis

Widgets

data GenericWidget control a Source #

A widget for editing values of type a.

Constructors

GenericWidget 

Fields

Instances

Bifunctor GenericWidget Source # 

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 # 

Methods

fmap :: (a -> b) -> GenericWidget control a -> GenericWidget control b #

(<$) :: a -> GenericWidget control b -> GenericWidget control a #

Widget el => Widget (GenericWidget el a) Source # 

Methods

getElement :: GenericWidget el a -> Element #

Renderable el => Renderable (GenericWidget el a) Source # 

Editors

data Editor a el b Source #

A widget el for editing b values while displaying a values. For obvious reasons, a and b are usually the same type, except while composing editors. All the three type arguments are functorial, but a is contravariant. Editor is a Biapplicative functor on el and b, and a Profunctor on a and b.

Editors compose using the Applicative interface when el is monoidal or more generally with the Biapplicative interface. In both cases the Profunctor lmap is used to select the value to display.

For an example of the Applicative interface, let's assemble the editor for a tuple of values:

editorTuple = (,) <$> lmap fst editable <*> lmap snd editable

Instances

Bifunctor (Editor a) Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> Editor a a c -> Editor a b d #

first :: (a -> b) -> Editor a a c -> Editor a b c #

second :: (b -> c) -> Editor a a b -> Editor a a c #

Biapplicative (Editor a) Source # 

Methods

bipure :: a -> b -> Editor a a b #

(<<*>>) :: Editor a (a -> b) (c -> d) -> Editor a a c -> Editor a b d #

(*>>) :: Editor a a b -> Editor a c d -> Editor a c d #

(<<*) :: Editor a a b -> Editor a c d -> Editor a a b #

Functor (Editor a el) Source # 

Methods

fmap :: (a -> b) -> Editor a el a -> Editor a el b #

(<$) :: a -> Editor a el b -> Editor a el a #

Monoid el => Applicative (Editor a el) Source # 

Methods

pure :: a -> Editor a el a #

(<*>) :: Editor a el (a -> b) -> Editor a el a -> Editor a el b #

(*>) :: Editor a el a -> Editor a el b -> Editor a el b #

(<*) :: Editor a el a -> Editor a el b -> Editor a el a #

someEditor :: Editable a => Editor a Layout a Source #

A version of editor with a concealed widget type.

create :: Editor a el b -> Behavior a -> UI (GenericWidget el b) Source #

Create an editor to display the argument. User edits are fed back via the edited Event.

edit :: (a' -> a) -> Editor a el b -> Editor a' el b Source #

Use when composing Biapplicative editors to focus on a field.

personEditor :: Editor Person PersonEditor Person
personEditor =
    bipure Person Person
      <<*>> edit education editor
      <<*>> edit firstName editor
      <<*>> edit lastName  editor

lmapE :: (a' -> a) -> Editor a el b -> Editor a' el b Source #

Applies a function over the input

dimapE :: (a' -> a) -> (b -> b') -> Editor a el b -> Editor a' el b' Source #

class Renderable (EditorWidget a) => Editable a where Source #

The class of Editable datatypes. . Define your own instance by using the Applicative composition operators or derive it via SOP.

Associated Types

type EditorWidget a Source #

Methods

editor :: Editor a (EditorWidget a) a Source #

The editor factory

editor :: (Generic a, HasDatatypeInfo a, All (All Editable `And` All Default) (Code a), EditorWidget a ~ Layout) => Editor a (EditorWidget a) a Source #

The editor factory

Instances

Editable Bool Source # 

Associated Types

type EditorWidget Bool :: * Source #

Editable Double Source # 
Editable Int Source # 

Associated Types

type EditorWidget Int :: * Source #

Editable () Source # 

Associated Types

type EditorWidget () :: * Source #

Methods

editor :: Editor () (EditorWidget ()) () Source #

(~) * a Char => Editable [a] Source # 

Associated Types

type EditorWidget [a] :: * Source #

Methods

editor :: Editor [a] (EditorWidget [a]) [a] Source #

Editable (Maybe Double) Source # 
Editable (Maybe Int) Source # 

Associated Types

type EditorWidget (Maybe Int) :: * Source #

Editable a => Editable (Identity a) Source # 

Associated Types

type EditorWidget (Identity a) :: * Source #

(Editable a, Editable b) => Editable (a, b) Source # 

Associated Types

type EditorWidget (a, b) :: * Source #

Methods

editor :: Editor (a, b) (EditorWidget (a, b)) (a, b) Source #

All * Editable xs => Editable (NP * I xs) Source #

Tuple editor without fields

Associated Types

type EditorWidget (NP * I xs) :: * Source #

Methods

editor :: Editor (NP * I xs) (EditorWidget (NP * I xs)) (NP * I xs) Source #

data EditorWidgetFor a where Source #

A container for EditorWidget.

type family Field (usage :: Usage) a where ... Source #

Type level fields. Use this helper to define EditorWidget types. Example:

data PersonF (usage :: Usage) = Person
  { education           :: Field usage Education
  , firstName, lastName :: Field usage String
  , age                 :: Field usage (Maybe Int)
type Person = PersonF Value
type PersonEditor = PersonF Edit

Equations

Field Value a = a 
Field Edit a = EditorWidget a 

data Usage Source #

Usage is a kind for type level Fields

Constructors

Value 
Edit 

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 with the field name and the 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 with the field name and the editor horizontally. This version takes a Layout builder as well.

pattern Horizontally :: forall a b. Editor a Layout b -> Editor a Horizontal b Source #

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 Horizontal layout builder instead

pattern Vertically :: forall a b. Editor a Layout b -> Editor a Vertical b Source #

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 Vertical layout builder instead

Editor layout

withLayout :: (layout -> layout') -> Editor a layout b -> Editor a layout' b Source #

Apply a layout builder.

withSomeWidget :: Renderable w => Editor a w b -> Editor a Layout b Source #

Conceal the widget type of some Editor

construct :: Renderable m => Editor a m b -> Editor a Layout b Source #

Construct a concrete Layout. Useful when combining heterogeneours layout builders.

Editor constructors

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.

editorJust :: Editor (Maybe b) el (Maybe b) -> Editor b el b Source #

Ignores Nothing values and only updates for Just values

Generic editors

editorGeneric :: forall a. (Generic a, HasDatatypeInfo a, All (All Editable `And` All Default) (Code a)) => Editor a Layout a Source #

A generic editor for SOP types.

editorGenericSimple :: forall a xs. (Generic a, HasDatatypeInfo a, All Editable xs, Code a ~ '[xs]) => Editor a Layout a Source #

A generic editor for record types.

editorGenericSimpleBi :: forall xs typ. (Generic (typ Value), Generic (typ Edit), All Editable xs, Code (typ Value) ~ '[xs], Code (typ Edit) ~ '[EditorWidgetsFor xs]) => Editor (typ Value) (typ Edit) (typ Value) Source #

A generic implementation of editor for dual purpose datatypes with a single constructor.

e.g. for the datatype

 data Person usage = Person { firstName, lastName :: Field usage String }
 instance Editable (Person Value) where
     type EditorWidget (Person Value) = Person Edit
     editor = editorGenericSimpleBi

will be equivalent to

instance Editable (Person Value) where
 type EditorWidget (Person Value) = Person Edit
 editor = bipure DataItem DataItem
             <<*>> edit firstName editor
             <<*>> edit lastName editor

Layouts

Monoidal layouts

newtype Vertical Source #

A layout monoid that places everything in a single column

Constructors

Vertical 

Fields

newtype Horizontal Source #

A layout monoid that places everything in a single row

Constructors

Horizontal 

data Columns Source #

A layout monoid that lays elements in columns

Constructors

Next Layout

Continue in the same column

Break Layout

Continue in the next column

Type level layouts

data a |*| b Source #

Type level Horizontal layouts

Constructors

a :|*| b 

Instances

Bifunctor (|*|) Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> (a |*| c) -> b |*| d #

first :: (a -> b) -> (a |*| c) -> b |*| c #

second :: (b -> c) -> (a |*| b) -> a |*| c #

Biapplicative (|*|) Source # 

Methods

bipure :: a -> b -> a |*| b #

(<<*>>) :: ((a -> b) |*| (c -> d)) -> (a |*| c) -> b |*| d #

(*>>) :: (a |*| b) -> (c |*| d) -> c |*| d #

(<<*) :: (a |*| b) -> (c |*| d) -> a |*| b #

Bifoldable (|*|) Source # 

Methods

bifold :: Monoid m => (m |*| m) -> m #

bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> (a |*| b) -> m #

bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> (a |*| b) -> c #

bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> (a |*| b) -> c #

(Renderable a, Renderable b) => Renderable ((|*|) a b) Source # 

Methods

render :: (a |*| b) -> UI Element Source #

getLayout :: (a |*| b) -> Layout Source #

data a -*- b Source #

Type level Vertical layouts

Constructors

a :-*- b 

Instances

Bifunctor (-*-) Source # 

Methods

bimap :: (a -> b) -> (c -> d) -> (a -*- c) -> b -*- d #

first :: (a -> b) -> (a -*- c) -> b -*- c #

second :: (b -> c) -> (a -*- b) -> a -*- c #

Biapplicative (-*-) Source # 

Methods

bipure :: a -> b -> a -*- b #

(<<*>>) :: ((a -> b) -*- (c -> d)) -> (a -*- c) -> b -*- d #

(*>>) :: (a -*- b) -> (c -*- d) -> c -*- d #

(<<*) :: (a -*- b) -> (c -*- d) -> a -*- b #

Bifoldable (-*-) Source # 

Methods

bifold :: Monoid m => (m -*- m) -> m #

bifoldMap :: Monoid m => (a -> m) -> (b -> m) -> (a -*- b) -> m #

bifoldr :: (a -> c -> c) -> (b -> c -> c) -> c -> (a -*- b) -> c #

bifoldl :: (c -> a -> c) -> (c -> b -> c) -> c -> (a -*- b) -> c #

(Renderable a, Renderable b) => Renderable ((-*-) a b) Source # 

Methods

render :: (a -*- b) -> UI Element Source #

getLayout :: (a -*- b) -> Layout Source #

Custom layout definition

class Renderable w where Source #

Closely related to Widget, this class represents types that can be rendered to an Element

Methods

render :: w -> UI Element Source #

getLayout :: w -> Layout Source #

Instances

Renderable String Source # 
Renderable TextEntry Source # 
Renderable Element Source # 
Renderable Columns Source # 
Renderable Horizontal Source # 
Renderable Vertical Source # 
Renderable Layout Source # 
Renderable (ListBox a) Source # 
Renderable a => Renderable (UI a) Source # 

Methods

render :: UI a -> UI Element Source #

getLayout :: UI a -> Layout Source #

(Renderable a, Renderable b) => Renderable ((-*-) a b) Source # 

Methods

render :: (a -*- b) -> UI Element Source #

getLayout :: (a -*- b) -> Layout Source #

(Renderable a, Renderable b) => Renderable ((|*|) a b) Source # 

Methods

render :: (a |*| b) -> UI Element Source #

getLayout :: (a |*| b) -> Layout Source #

Renderable el => Renderable (GenericWidget el a) Source # 

renderGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> UI Element Source #

A generic implementation of render 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.

Validation

class Validable a where Source #

The class of values that support validation.

Minimal complete definition

validate

ok :: ValidationResult Source #

All is good

fromWarnings :: [String] -> ValidationResult Source #

Create a validation result from a list of warnings.

fromWarnings [] = ok

updateIfValid :: Validable a => a -> a -> a Source #

Orphan instances

(Applicative f, All * Default xs) => Default (NP * f xs) Source # 

Methods

def :: NP * f xs #