threepenny-editors 0.5.4.1 → 0.5.5

raw patch · 8 files changed

+407/−258 lines, 8 filesdep −data-defaultPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies removed: data-default

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−0
• README.md +187/−62
• examples/CRUD.hs +4/−5
• examples/Person.hs +22/−28
• src/Graphics/UI/Threepenny/Editors.hs +161/−105
• src/Graphics/UI/Threepenny/Editors/Layout.hs +6/−4
• src/Graphics/UI/Threepenny/Editors/Types.hs +19/−49
• threepenny-editors.cabal +1/−5

@@ -1,3 +1,10 @@+# 0.5.5 (2017-09-03)+    * Dropped `Default` constraint requisite and `data-default` dependency.+    * As a result, `editorGenericSimple` is replaced with `editorGeneric`.+    * Improved haddocks and README.+    * Cleaned up module export lists.+    * Renamed Usage to Purpose and the Value constructor to Data. +    * Renamed `editorGenericSimpleBi` to `editorGenericBi`. # 0.5.4 (2017-08-28)     * Generic derivation of `editor` for dual purpose datatypes. # 0.5.3 (2017-08-28)

@@ -4,60 +4,66 @@  # threepenny-editors  -## Introduction-A library allowing to easily create threepenny-gui widgets for editing algebraic datatypes. -The library provides a set of editors for primitive and base types, a set of editor-constructors for building editors for type constructors, and a set of combinators for-composing editors - the `EditorFactory` type has an `Applicative`-like structure, with two-combinators for horizontal and vertical composition, as well as-a `Profunctor` instance. Don't worry if you are not familiar with these concepts as they are-not required to perform simple tasks with this library.-```-newtype EditorFactory a b-instance Profunctor EditorFactory+## Description+Threepenny-editors is a library for constructing of widgets for editing algebraic datatypes in [threepenny-gui](http://hackage.haskell.org/package/threepenny-gui). An editor factory is a function `Behaviour outer -> (widget, Tidings inner)`. The library introduces an abstraction `Editor` around these functions which allows treat them as first class entities, improving compositionality and applicability. Moreover, the generic functions provided help automating much of the boilerplate required for the definitions. -(|*|) :: EditorFactory s (b->a) -> EditorFactory s b -> EditorFactory s a-(-*-) :: EditorFactory s (b->a) -> EditorFactory s b -> EditorFactory s a-```+More concretely: -The library also provides an `Editable` type class to associate a default `EditorFactoy` with-a type:-```-class Editable a where-  editor :: EditorFactory a a-```+1. `Editor outer widget inner` is an factory to create editors for a type `inner` inside a datatype `outer` implemented by a `widget`. +2. `widget` must be a `Renderable` type. `Renderable` generalizes the `Widget` class from threepenny-gui with the ability to perform layout from the Haskell side.+3. Once `create`d, an `Editor` yields a tuple of `Widget` and `Tidings`, to be composed in a threepenny-gui app.+4. The `Editable` type class associates a type with its `Editor`. Instances are provided for most primitive types. +`Editor`s have `Biapplicative` and `Profunctor` instances. `Biapplicative` allows to compose editors on both their `widget` and their `inner` structure, whereas `Profunctor` allows to apply an `inner` editor to an `outer` datatype by focusing the editor into a substructure.++The library provides generic functions (using [generics-sop](http://hackage.haskell.org/package/generics-sop)) to generate editors and renderables:++- `editorGeneric` - A generic editor for standard datatypes where all the fields are `Editable` that produces a vertical layout.+- `editorGenericBi` - A generic editor for dual purpose datatypes where all the fields are `Editable`.+- `renderGeneric` - A generic render for single constructor dual purpose datatypes that produces a vertical layout.++A dual purpose datatype is a type constructor where the type argument has kind `Purpose`, with two possible instantiations: `Data` or `Edit`. Instantiating with `Data` yields a container of data, i.e. a normal datatype, whereas instantiating with `Edit` yields a container of widgets. This allows to generate data and editor from the same definition when the shape of the editor matches the shape of the data.+ ## Example -Let's start with something simple, obtaining an `EditorFactory` for a newtype:+Let's start with something simple, obtaining an `Editor` for a newtype:+ ``` newtype Brexiteer = Brexiteer {unBrexiteer::Bool} deriving (Bounded, Enum, Eq, Read, Show, Ord, Generic) ```  Since we already have an `Editable` instance for `Bool` that displays a checkbox,  we can obtain an `Editable` instance for `Brexiteer` for free:+ ``` deriving instance Editable Brexiteer ``` -We can also wrap the existing `Bool` editor manually if we want to using `dimap`:+We can also wrap the existing `Bool` editor manually using `dimapE`:+ ```-editorBrexiteer = dimap unBrexiteer Brexiteer (editor :: Editor Bool Bool)+editorBrexiteer = dimapE unBrexiteer Brexiteer (editor :: Editor Bool Element Bool) ```+ The type annotation above is only for illustrative purposes.  Perhaps we are not happy with the default checkbox editor and want to have a different UI?-The code below shows how to use a textbox instead:+We can use a text box:+ ```-editorBrexiteerText :: EditorFactory Brexiteer Brexiteer+editorBrexiteerText :: Editor (Maybe Brexiteer) TextEntry (Maybe Brexiteer) editorBrexiteerText = editorReadShow ```+ Or a combo box:+ ```-editorBrexiteerChoice :: EditorFactoy Brexiteer Brexiteer-editorBrexiteerChoice = editorEnumBounded+editorBrexiteerChoice :: Editor (Maybe Brexiteer) (ListBox Brexiteer) (Maybe Brexiteer)+editorBrexiteerChoice = editorEnumBounded (pure string) ```+ Let's move on to a union type now:+ ``` data Education   = Basic@@ -65,45 +71,24 @@   | Other_ String   deriving (Eq, Read, Show) ```-We could define an editor for `Education` with `editorReadShow`, but maybe we want a more user-friendly UI that displays a choice of education type, and only in the `Other` case a free form-text input. The `editorSum` combinator takes a list of choices and an editor for each choice:-```-editorEducation :: EditorFactory Education Education-editorEducation = do-    let selector x = case x of-            Other _ -> "Other"-            _       -> show x-    editorSum-      [ ("Basic", const Basic <$> editorUnit)-      , ("Intermediate", const Intermediate <$> editorUnit)-      , ("Other", dimap (fromMaybe "" . getOther) Other editor)-      ]-      selector -getOther :: Education -> Maybe String-getOther (Other s) = Just s-getOther _         = Nothing-```+We could define an editor with `editorReadShow`, but maybe we want a more user+friendly UI that displays a choice, and only when `Other` is selected displays a free form+text input. This can be achieved with the `editorSum` combinator, which takes a list of choices+and an editor for each choice. While `editorSum` is easy enough to use,+`editorGeneric` removes away all the boilerplate for us: -Or more simply, we could just use `editorGeneric` to achieve the same effect, provided that-`Education` has got SOP.Generic and SOP.HasDatatypeInfo instances ```-import           GHC.Generics-import qualified Generics.SOP as SOP+import Generics.SOP.TH -deriving instance Generic Education-instance SOP.HasDatatypeInfo Education-instance SOP.Generic Education+derivingGeneric ''Education  -- Derive an Editable instance that uses editorGeneric instance Editable Education---- Explicitly call editorGeneric-editorEducation :: EditorFactory Education Education-editorEducation = editorGeneric ```-Moving on to a record type, let's look at how to compose multiple editors together:++Moving on, let's look at how to compose multiple editors together:+ ``` data Person = Person   { education           :: Education@@ -114,20 +99,25 @@   }   deriving (Generic, Show) ```+ The `field` combinator encapsulates the common pattern of pairing a label and a base editor to build the editor for a record field:+ ```-field :: String -> (out -> inn) -> EditorFactory inn a -> EditorFactory out a-field name f e = string name *| lmap f e+field :: String -> (out -> inn) -> Editor inn a -> Editor out a+field name f e = string name *| dimap f id e ```+ Where `*|` prepends a UI Element to an Editor horizontally:  ```-(*|) :: UI Element -> EditorFactory s a -> EditorFactory s a+(*|) :: UI Element -> Editor s w a -> Editor s w a ```+ Armed with `field` and applicative composition (vertical '-*-' and horizontal '|*|'), we define the editor for `Person` almost mechanically:+ ```-editorPerson :: EditorFactory Person Person+editorPerson :: Editor Person Person editorPerson =     (\fn ln a e ls b -> Person e fn ln a b ls)       <$> field "First:"     firstName editor@@ -137,7 +127,142 @@       -*- field "Status"     status (editorJust $ editorSelection (pure [minBound..]) (pure (string.show)))       -*- field "Brexiter"   brexiteer editor ```+ The only bit of ingenuity in the code above is the deliberate reordering of the fields.  It is also possible to generically derive the editor for person in the same way as before, in which case the labels are taken from the field names, and the order from the declaration order.++In addition to the simple layout combinators, `threepenny-editors` supports the more flexible monoidal layout builders.+`Columns` is such builder which allows to lay out editors in multiple columns:++```+{-# LANGUAGE ApplicativeDo #-}+editorPersonColumns :: Editor Person Columns Person+editorPersonColumns = do+      firstName <- fieldLayout Next "First:"     firstName editor+      lastName  <- fieldLayout Next "Last:"      lastName editor+      age       <- fieldLayout Next "Age:"       age editor+      education <- fieldLayout Break "Education:" education editorEducation+      status    <- fieldLayout Next "Status"     status (editorJust $ editorSelection (pure [minBound..]) (pure (string.show)))+      brexiteer <- fieldLayout Next "Brexiter"   brexiteer editor+      return Person{..}+```++In all the editors created so far, the widget type was `Layout` (`Columns` is just a newtype of `Layout`). Because `Layout` is opaque,+there is no way to access the field widgets. This can be a problem if we want to set attributes on the fields, etc. To do that,+we would need to define a data type to capture all the field editors, and use in place of `Layout`. This is what the `Biapplicative`+interface allows us to do.++But moreover, all the editors defined so far have one thing in common: they have the same shape as the datatype they are editing. +We can take advantage of this to define a datatype with a dual purpose, which can be used to either hold data, or hold widgets:++```+-- | A dual purpose data type that doubles as a value and as a widget depending on the type argument.+data PersonDual (purpose :: Purpose) = Person+  { education           :: Field purpose Education+  , firstName, lastName :: Field purpose String+  , age                 :: Field purpose (Maybe Int)+  , brexiteer           :: Field purpose Brexiteer+  , status              :: Field purpose LegalStatus+  }++type Person = PersonDual Data+type PersonEditor = PersonDual Edit+```+This binds the field widgets, allowing to e.g. set attributes on them.+To define a `PersonEditor`, we make use of the `Editor` `Biapplicative` instance:++```+personEditor =+    bipure Person Person+      <<*>> dimap education id editorEducation+      <<*>> dimap firstName id editor+      <<*>> dimap lastName  id editor+      <<*>> dimap age       id editor+      <<*>> dimap brexiteer id editor+      <<*>> dimap status    id (editorJust $ editorSelection ...)+```++When all the fields are `Editable` this definition can be derived via `editorGenericBi`.++Now the actual layout is define separately from the editor composition, +using standard threepenny-gui primitives:++```+instance Renderable PersonEditor where+  render Person{..} = grid+   [ [string "First:", element firstName, string "Age:", element age]+   , [string "Last:", element lastName, string "Brexiteer:", element brexiteer]+   , [string "Status:", element status, string "Education:", element education]+   ]+```++Once again `render` can be derived via `renderGeneric`, which produces a single column vertical layout.++The complete code for the dual purpose `Person` example can be found below:+```+{-# LANGUAGE DataKinds            #-}+{-# LANGUAGE FlexibleInstances    #-}+{-# LANGUAGE KindSignatures       #-}+{-# LANGUAGE RecursiveDo          #-}+{-# LANGUAGE ScopedTypeVariables  #-}+{-# LANGUAGE TemplateHaskell      #-}+{-# LANGUAGE TypeFamilies         #-}+{-# LANGUAGE TypeSynonymInstances #-}+{-# LANGUAGE UndecidableInstances #-}++import           Control.Monad+import           Generics.SOP.TH+import           Graphics.UI.Threepenny+import           Graphics.UI.Threepenny.Editors++data Education+  = Basic+  | Intermediate+  | Other String++instance Editable Education++newtype Brexiteer = Brexiteer Bool++instance Editable Brexiteer where editor = editorGeneric++data LegalStatus+  = Single+  | Married+  | Divorced+  | Widowed++instance Editable LegalStatus++data PersonDual (purpose :: Purpose) = Person+  { education           :: Field purpose Education+  , firstName, lastName :: Field purpose String+  , age                 :: Field purpose (Maybe Int)+  , brexiteer           :: Field purpose Brexiteer+  , status              :: Field purpose LegalStatus+  }++type Person = PersonDual 'Data+type PersonEditor = PersonDual 'Edit++instance Editable Person where+  type EditorWidget Person = PersonEditor+  editor = editorGenericBi++instance Renderable PersonEditor where+  render = renderGeneric++deriveGeneric ''Education+deriveGeneric ''Brexiteer+deriveGeneric ''LegalStatus+deriveGeneric ''PersonDual++main = startGUI defaultConfig $ \w -> mdo+  personE :: GenericWidget PersonEditor Person <- create editor personB+  personB :: Behavior Person <- stepper (Person Basic "" "" Nothing (Brexiteer False) Single) (edited personE)++  void $ getBody w #+ [render personE]+  void $ element (firstName (widgetControl personE)) # set style [("background-color", "Blue")]+```

@@ -127,11 +127,10 @@ {-----------------------------------------------------------------------------     Data items that are stored in the data base ------------------------------------------------------------------------------}-data DataItemDual (usage :: Usage) = DataItem-  { firstName, lastName :: Field usage String-  }+data DataItemDual (purpose :: Purpose) = DataItem+  { firstName, lastName :: Field purpose String } -type DataItem = DataItemDual Value+type DataItem = DataItemDual Data type DataItemEditor = DataItemDual Edit  showDataItem :: DataItem -> String@@ -139,7 +138,7 @@  instance Editable DataItem where   type EditorWidget DataItem = DataItemEditor-  editor = editorGenericSimpleBi+  editor = editorGenericBi  instance Renderable DataItemEditor where   render = renderGeneric

@@ -7,18 +7,21 @@ {-# LANGUAGE RecursiveDo                #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE StandaloneDeriving         #-}+{-# LANGUAGE TemplateHaskell            #-} {-# LANGUAGE TypeFamilies               #-}+{-# LANGUAGE UndecidableInstances       #-} {-# OPTIONS_GHC -Wno-name-shadowing     #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-} module Person (main) where import           Control.Monad-import           Data.Biapplicative-import           Data.Default import           Data.Maybe import qualified Generics.SOP                              as SOP+import           Generics.SOP.TH import           GHC.Generics                              (Generic) import           Graphics.UI.Threepenny.Core import           Graphics.UI.Threepenny.Editors+import           Graphics.UI.Threepenny.Editors.Layout     (above, beside)+import           Graphics.UI.Threepenny.Editors.Validation import           Graphics.UI.Threepenny.Elements import           Prelude                                   hiding (span) @@ -26,20 +29,23 @@ main = startGUI defaultConfig setup  -- | A dual purpose data type that doubles as a value and as a widget depending on the type argument.-data PersonF (usage :: Usage) = Person-  { education           :: Field usage Education-  , firstName, lastName :: Field usage String-  , age                 :: Field usage (Maybe Int)-  , brexiteer           :: Field usage Brexiteer-  , status              :: Field usage LegalStatus+data PersonF (purpose :: Purpose) = Person+  { education           :: Field purpose Education+  , firstName, lastName :: Field purpose String+  , age                 :: Field purpose (Maybe Int)+  , brexiteer           :: Field purpose Brexiteer+  , status              :: Field purpose LegalStatus   }   deriving (Generic) -type Person = PersonF Value+type Person = PersonF Data type PersonEditor = PersonF Edit +defPerson :: Person+defPerson = Person Basic "First" "Last" Nothing (Brexiteer False) Single+ instance Validable Person where-  validate Person{..} = fromWarnings $ +  validate Person{..} = fromWarnings $     [ "First name cannot be null" | null firstName ] ++     [ "Last name cannot be null"  | null lastName ] ++     [ "Age must be a natural number" | Just x <- [age], x <= 0]@@ -54,7 +60,6 @@ instance Editable LegalStatus instance SOP.HasDatatypeInfo LegalStatus instance SOP.Generic LegalStatus-instance Default LegalStatus where def = Single  data Education   = Basic@@ -62,8 +67,6 @@   | Other String   deriving (Eq, Ord, Read, Show, Generic) -instance Default Education where def = Basic- getOther :: Education -> Maybe String getOther (Other s) = Just s getOther _         = Nothing@@ -88,17 +91,13 @@  newtype Brexiteer = Brexiteer Bool deriving (Eq, Show, Ord, Generic) -instance Default Brexiteer where def = Brexiteer False-instance Editable Brexiteer where editor = editorGenericSimple+instance Editable Brexiteer where editor = editorGeneric instance SOP.HasDatatypeInfo Brexiteer instance SOP.Generic Brexiteer  deriving instance Show Person  instance Editable Person-instance SOP.HasDatatypeInfo Person-instance SOP.Generic Person-instance Default Person where def = Person Basic "First" "Last" (Just 18) def def  -- | An editor for 'Person' values that uses the 'Columns' layout builder editorPersonColumns :: Editor Person Columns Person@@ -107,7 +106,7 @@       lastName  <- fieldLayout Next "Last:"      lastName editor       age       <- fieldLayout Next "Age:"       age editor       education <- fieldLayout Break "Education:" education editorEducation-      status    <- fieldLayout Next "Status"     status (withSomeWidget $ editorJust $ editorSelection (pure [minBound..]) (pure (string.show)))+      status    <- fieldLayout Next "Status"     status (editorJust $ editorSelection (pure [minBound..]) (pure (string.show)))       brexiteer <- fieldLayout Next "Brexiter"   brexiteer editor       return Person{..} @@ -115,14 +114,7 @@ -- | A editor for 'Person' values with a fully fledged Widget type. --   The UI and layout are defined in the 'Renderable' instance for the widget. personEditor :: Editor Person PersonEditor Person-personEditor =-    bipure Person Person-      <<*>> edit education editor-      <<*>> edit firstName editor-      <<*>> edit lastName  editor-      <<*>> edit age       editor-      <<*>> edit brexiteer editor-      <<*>> edit status    editor+personEditor = editorGenericBi  instance Renderable PersonEditor where   getLayout Person{..} =@@ -146,7 +138,7 @@   person3e <- create personEditor person1B   -- When using a biapplicative editor, we can set the attributes of the field editors after creation.   _ <- element (firstName (widgetControl person3e)) # set style [("background-color", "Blue")]-  person1B <- accumB def (updateIfValid . head <$> unions+  person1B <- accumB defPerson (updateIfValid . head <$> unions                             [ edited person1C                             , edited person2                             , edited person3e@@ -168,3 +160,5 @@     , [render person3e]     , [hr]     ]]++deriveGeneric ''PersonF

@@ -1,52 +1,82 @@-{-# LANGUAGE PolyKinds #-}-{-# LANGUAGE GADTs #-} {-# LANGUAGE DataKinds                  #-} {-# LANGUAGE DefaultSignatures          #-} {-# LANGUAGE FlexibleContexts           #-} {-# LANGUAGE FlexibleInstances          #-}+{-# LANGUAGE GADTs                      #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE PatternSynonyms            #-}+{-# LANGUAGE PolyKinds                  #-} {-# LANGUAGE RankNTypes                 #-} {-# LANGUAGE ScopedTypeVariables        #-} {-# LANGUAGE TupleSections              #-} {-# LANGUAGE TypeApplications           #-} {-# LANGUAGE TypeFamilies               #-} {-# LANGUAGE TypeOperators              #-}+{-# LANGUAGE UndecidableInstances       #-}+{-# LANGUAGE UndecidableSuperClasses    #-} {-# LANGUAGE ViewPatterns               #-} {-# OPTIONS_GHC -Wno-orphans            #-} {-# OPTIONS_GHC -Wno-name-shadowing     #-} {-# OPTIONS_GHC -Wno-duplicate-exports  #-}-{-# OPTIONS_GHC -fdefer-type-errors  #-}+{- | 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]+>          ]++-} module Graphics.UI.Threepenny.Editors-  ( -- * Widgets-    GenericWidget(..)-  , edited-  , contents-  , widgetControl-  , widgetTidings-    -- * Editors-  , Editor(Horizontally, horizontally, Vertically, vertically)-  , someEditor-  , create-  , edit-  , lmapE-  , dimapE+  ( -- * Editors+    Editor(..)   , Editable(..)-  , EditorWidgetFor(..)-  , Field-  , Usage(..)+  , dimapE     -- ** Editor composition   , (|*|), (|*), (*|)   , (-*-), (-*), (*-)   , field   , fieldLayout-  , pattern Horizontally-  , pattern Vertically-    -- ** Editor layout-  , withLayout   , withSomeWidget-  , construct     -- ** Editor constructors   , editorUnit   , editorIdentity@@ -55,61 +85,77 @@   , editorSelection   , editorSum   , editorJust+  , someEditor+  , withSomeWidget+    -- ** Dual purpose datatypes+  , Field+  , Purpose(..)     -- ** Generic editors   , editorGeneric-  , editorGenericSimple-  , editorGenericSimpleBi+  , editorGenericBi+    -- * Widgets+  , GenericWidget(..)+  , edited+  , contents     -- * Layouts   , Layout-  , above-  , beside   -- ** Monoidal layouts   , Vertical(..)   , Horizontal(..)   , Columns(..)-  -- ** Type level layouts-  , type (|*|)(..)-  , type (-*-)(..)   -- ** Custom layout definition   , Renderable(..)   , renderGeneric   , getLayoutGeneric-  -- * Validation-  , Validable(..)-  , ValidationResult-  , ok-  , fromWarnings-  , getWarnings-  , isValid-  , updateIfValid   ) where  import           Data.Biapplicative import           Data.Char-import           Data.Default import           Data.Functor.Compose import           Data.Functor.Identity import           Data.Maybe-import qualified Data.Sequence as Seq+import qualified Data.Sequence                         as Seq import           Generics.SOP                          hiding (Compose)+import           Generics.SOP.Constraint               hiding (Compose) import           Graphics.UI.Threepenny.Core           as UI import           Graphics.UI.Threepenny.Widgets import           Text.Casing  import           Graphics.UI.Threepenny.Editors.Layout import           Graphics.UI.Threepenny.Editors.Types-import           Graphics.UI.Threepenny.Editors.Validation  -- | The class of 'Editable' datatypes.---   .---   Define your own instance by using the 'Applicative' composition operators or---   derive it via 'Generics.SOP'.+--+--   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+-- class Renderable (EditorWidget a) => Editable a where+  -- | The widget type that realizes the editor. Defaults to 'Layout' and only needs to be manually defined when using custom renderables.   type family EditorWidget a   type EditorWidget a = Layout-  -- | The editor factory   editor :: Editor a (EditorWidget a) a-  default editor :: (Generic a, HasDatatypeInfo a, (All (All Editable `And` All Default) (Code a)), EditorWidget a ~ Layout) => Editor a (EditorWidget a) a+  default editor :: (Generic a, HasDatatypeInfo a, (All (All Editable `And` All NonEmpty) (Code a)), EditorWidget a ~ Layout) => Editor a (EditorWidget a) a   editor = editorGeneric  -- | Conceal the widget type of some 'Editor'@@ -124,20 +170,20 @@ data EditorWidgetFor a where   EditorWidgetFor :: Editable a => EditorWidget a -> EditorWidgetFor a --- | 'Usage' is a kind for type level 'Field's-data Usage = Value | Edit+-- | 'Purpose' is a kind for type level 'Field's+data Purpose = Data | Edit --- | Type level fields. Use this helper to define EditorWidget types. Example:+-- | Type level fields. Used to define dual purpose datatypes, example: ----- > data PersonF (usage :: Usage) = Person--- >   { education           :: Field usage Education--- >   , firstName, lastName :: Field usage String--- >   , age                 :: Field usage (Maybe Int)+-- > data PersonF (purpose :: Purpose) = Person+-- >   { education           :: Field purpose Education+-- >   , firstName, lastName :: Field purpose String+-- >   , age                 :: Field purpose (Maybe Int) ----- > type Person = PersonF Value+-- > type Person = PersonF Data -- > type PersonEditor = PersonF Edit-type family Field (usage :: Usage) a where-  Field 'Value  a = a+type family Field (purpose :: Purpose) a where+  Field 'Data  a = a   Field 'Edit a = EditorWidget a  instance Editable () where@@ -165,10 +211,16 @@   type EditorWidget Double = TextEntry   editor = editorJust editor -instance (Editable a, Editable b) => Editable (a,b) where-  type EditorWidget (a,b) = EditorWidget a |*| EditorWidget b-  editor = bipure (:|*|) (,) <<*>> lmapE fst editor <<*>> lmapE snd editor+instance (Editable a, Editable b) => Editable (a |*| b) where+  type EditorWidget (a |*| b) = EditorWidget a |*| EditorWidget b+  editor = bipure (:|*|) (:|*|) <<*>> dimapE (\(x :|*| _) -> x) id editor+                                <<*>> dimapE (\(_ :|*| y) -> y) id editor +instance (Editable a, Editable b) => Editable (a -*- b) where+  type EditorWidget (a -*- b) = EditorWidget a -*- EditorWidget b+  editor = bipure (:-*-) (:-*-) <<*>> dimapE (\(x :-*- _) -> x) id editor+                                <<*>> dimapE (\(_ :-*- y) -> y) id editor+ instance Editable a => Editable (Identity a) where   type EditorWidget (Identity a) = EditorWidget a   editor = editorIdentity editor@@ -221,8 +273,8 @@  getLayoutGeneric' :: (All Renderable xs) => DatatypeInfo '[xs] -> SOP I '[xs] -> [[Layout]] getLayoutGeneric' (ADT _ _ (c :* Nil)) (SOP (Z x)) = getLayoutConstructor c x-getLayoutGeneric' (Newtype _ _ c) (SOP (Z x)) = getLayoutConstructor c x-getLayoutGeneric' _ _ = error "unreachable"+getLayoutGeneric' (Newtype _ _ c) (SOP (Z x))      = getLayoutConstructor c x+getLayoutGeneric' _ _                              = error "unreachable"  getLayoutConstructor :: All Renderable xs => ConstructorInfo xs -> NP I xs -> [[Layout]] getLayoutConstructor (Record _ fields) renders = hcollapse $ hcliftA2 (Proxy @ Renderable) (\f (I x) -> K $ getLayoutField f x) fields renders@@ -240,32 +292,32 @@ --   /e.g./ for the datatype -- -- @---  data Person usage = Person { firstName, lastName :: Field usage String }+--  data Person purpose = Person { firstName, lastName :: Field purpose String } -- @ ----- @ instance Editable (Person Value) where---     type EditorWidget (Person Value) = Person Edit---     editor = editorGenericSimpleBi+-- @ instance Editable (Person Data) where+--     type EditorWidget (Person Data) = Person Edit+--     editor = editorGenericBi -- @ -- --   will be equivalent to ----- > instance Editable (Person Value) where--- >  type EditorWidget (Person Value) = Person Edit+-- > instance Editable (Person Data) where+-- >  type EditorWidget (Person Data) = Person Edit -- >  editor = bipure DataItem DataItem -- >              <<*>> edit firstName editor -- >              <<*>> edit lastName editor--- -editorGenericSimpleBi+--+editorGenericBi   :: forall xs typ .-     ( Generic (typ 'Value)+     ( Generic (typ 'Data)      , Generic (typ 'Edit)      , All Editable xs-     , Code (typ 'Value) ~ '[xs]+     , Code (typ 'Data) ~ '[xs]      , Code (typ 'Edit) ~ '[EditorWidgetsFor xs]      )-  => Editor (typ 'Value) (typ 'Edit) (typ 'Value)-editorGenericSimpleBi = dimapE from to $ bimap to id $ constructorEditorBi+  => Editor (typ 'Data) (typ 'Edit) (typ 'Data)+editorGenericBi = dimapE from to $ bimap to id constructorEditorBi  constructorEditorBi   :: forall xs . (All Editable xs)@@ -276,7 +328,7 @@ constructorEditorBi' = sequence_NP2 fieldsEditorBi  unpackWidgets :: NP EditorWidgetFor xs -> NP I (EditorWidgetsFor xs)-unpackWidgets Nil = Nil+unpackWidgets Nil                       = Nil unpackWidgets (EditorWidgetFor e :* xs) = I e :* unpackWidgets xs  type family EditorWidgetsFor (xs :: [*]) where@@ -287,7 +339,7 @@ fieldsEditorBi = go id sList where   go :: forall ys. All Editable ys => (forall f . NP f xs -> NP f ys) -> SList ys -> NP2 EditorWidgetFor (Editor (NP I xs)) ys   go _ SNil = Nil2-  go f SCons = bimap EditorWidgetFor id (edit (unI . hd . f) editor) :** go (tl . f) sList+  go f SCons = bimap EditorWidgetFor id (dimapE (unI . hd . f) id editor) :** go (tl . f) sList  -- A bifunctorial version of NP, used to sequence the applicative effects data NP2 :: (k -> *) -> (k -> k -> *) -> [k] -> * where@@ -301,24 +353,7 @@ {----------------------------------------------   Generic derivations for Applicative Editables -----------------------------------------------}--- | A generic 'editor' derivation for data types with a single constructor.---   Doesn't require a 'Default' instance.------   The datatype arguments are layered in vertical fashion and labelled with---   field names if available.-editorGenericSimple-  :: forall a xs.-     (Generic a, HasDatatypeInfo a, All Editable xs, Code a ~ '[xs])-  => Editor a Layout a-editorGenericSimple = dimapE from to $ editorGenericSimple' (datatypeInfo(Proxy @ a)) -editorGenericSimple'-  :: forall xs.-     (All Editable xs)-  => DatatypeInfo '[xs] -> Editor (SOP I '[xs]) Layout (SOP I '[xs])-editorGenericSimple' (ADT _ _ (c :* Nil)) = constructorEditorFor c-editorGenericSimple' (Newtype _ _ c)      = constructorEditorFor c- constructorEditorFor   :: (All Editable xs)   => ConstructorInfo xs@@ -328,19 +363,18 @@ constructorEditorFor Infix{} = dimapE (unZ . unSOP) (SOP . Z) someEditor  -- | A generic 'editor' derivation for SOP types.---   The 'Default' instance is only used when there is more than one constructor. -- --   The datatype arguments are layered in vertical fashion and labelled with --   field names if available. editorGeneric   :: forall a .-     (Generic a, HasDatatypeInfo a, (All (All Editable `And` All Default) (Code a)))+     (Generic a, HasDatatypeInfo a, (All (All Editable `And` All NonEmpty) (Code a)))   => Editor a Layout a editorGeneric = dimapE from to $ editorGeneric' (datatypeInfo(Proxy @ a))  editorGeneric'   :: forall xx.-     (All (All Editable `And` All Default) xx)+     (All (All Editable `And` All NonEmpty) xx)   => DatatypeInfo xx -> Editor (SOP I xx) Layout (SOP I xx) editorGeneric' (ADT _ _ (c :* Nil)) = constructorEditorFor c editorGeneric' (ADT _ _ cc) = editorSum above editors constructor where@@ -354,17 +388,17 @@ instance Show Tag where show (Tag t) = init $ toFieldLabel t  constructorEditorsFor-  :: forall xx . (All (All Editable `And` All Default) xx)+  :: forall xx . (All (All Editable `And` All NonEmpty) xx)   => NP ConstructorInfo xx -> [(String, Editor (SOP I xx) Layout (SOP I xx))] constructorEditorsFor cc =   hcollapse $ hcliftA3 p (\c i p -> (constructorName c,) `mapKK` constructorEditorForUnion c i p) cc     (injections  :: NP (Injection  (NP I) xx) xx)     (projections :: NP (Projection (Compose Maybe (NP I)) xx) xx)   where-    p = Proxy @ (All Editable `And` All Default)+    p = Proxy @ (All Editable `And` All NonEmpty)  constructorEditorForUnion-  :: (SListI xx, All Editable xs, All Default xs)+  :: (SListI xx, All Editable xs, All NonEmpty xs)   => ConstructorInfo xs   -> Injection (NP I) xx xs   -> Projection (Compose Maybe (NP I)) xx xs@@ -375,7 +409,7 @@  composeEditor   :: forall xss xs.-    (SListI xss, All Default xs) =>+    (SListI xss, All NonEmpty xs) =>      Injection (NP I) xss xs   -> Projection (Compose Maybe (NP I)) xss xs   -> Editor (NP I xs) Layout (NP I xs)@@ -383,12 +417,15 @@ composeEditor (Fn inj) (Fn prj) = dimapE f (SOP . unK . inj)   where     f :: SOP I xss -> NP I xs-    f = fromMaybe def . getCompose . prj . K . hexpand (Compose Nothing) . hmap (Compose . Just) . unSOP+    f = fromMaybe def_np . getCompose . prj . K . hexpand (Compose Nothing) . hmap (Compose . Just) . unSOP +def_np :: (All NonEmpty xs) => NP I xs+def_np = hcpure (Proxy @ NonEmpty) gdef+ constructorEditorFor' :: (SListI xs, All Editable xs) => NP FieldInfo xs -> Editor (NP I xs) Layout (NP I xs) constructorEditorFor' fields = vertically $ hsequence $ hliftA Vertically $ fieldsEditor (hliftA (K . fieldName) fields) --- | Tuple editor without fields+-- Tuple editor without fields instance All Editable xs => Editable (NP I xs) where   type EditorWidget (NP I xs) = Layout   editor = horizontally $ hsequence $ hliftA Horizontally tupleEditor@@ -397,7 +434,7 @@ tupleEditor = go id sList where   go :: forall ys. All Editable ys => (forall f . NP f xs -> NP f ys) -> SList ys -> NP (Editor (NP I xs) Layout) ys   go _ SNil  = Nil-  go f SCons = lmapE (unI . hd . f) someEditor :* go (tl . f) sList+  go f SCons = dimapE (unI . hd . f) id someEditor :* go (tl . f) sList  fieldsEditor :: forall xs . All Editable xs => NP (K String) xs -> NP (Editor (NP I xs) Layout) xs fieldsEditor = go id sList where@@ -413,5 +450,24 @@       onHead _ []     = [] toFieldLabel _ = "" -instance (Applicative f, All Default xs) => Default (NP f xs) where-  def = hcpure (Proxy @ Default) (pure def)+----------------------------------+-- Generic default values++class NonEmpty2 (xs :: [k])+instance NonEmpty2 (x ': xs)++class ( Generic a+      , NonEmpty2 (Code a)+      , All NonEmpty (Head (Code a))+      ) =>+      NonEmpty a+instance ( Generic a+         , NonEmpty2 (Code a)+         , All NonEmpty (Head (Code a))+         ) =>+         NonEmpty a++gdef :: forall a. (NonEmpty a) => a+gdef = case sList :: SList (Code a) of+               SCons -> to $ SOP $ Z $ hcpure (Proxy @ NonEmpty) (I gdef)+               SNil  -> error "unreachable"

@@ -8,6 +8,7 @@ {-# LANGUAGE ViewPatterns         #-} {-# OPTIONS_GHC -Wno-name-shadowing     #-} +-- | A custom layout engine and combinators. module Graphics.UI.Threepenny.Editors.Layout   (   -- * Renderableable widgets@@ -43,12 +44,13 @@ import           Graphics.UI.Threepenny.Elements import           Graphics.UI.Threepenny.Widgets --- | Closely related to 'Widget', this class represents types that can be rendered to an 'Element'+-- | Closely related to 'Widget', this class represents types that can be rendered to an 'Element', either directly or via 'Layout'. class Renderable w where   render    :: w -> UI Element   getLayout :: w -> Layout   render = runLayout . getLayout   getLayout = Cell . Just . render+  {-# MINIMAL render | getLayout #-}  instance Renderable Element where   render = return@@ -110,7 +112,7 @@ runLayout (Grid rows) = grid (toList $ fmap (fmap runLayout . toList) rows) runLayout (Cell el)   = fromMaybe new el --- | A layout monoid that places everything in a single column+-- | A monoidal layout builder that places everything in a single column newtype Vertical = Vertical { getVertical :: Layout}  vertical :: Renderable w => w -> Vertical@@ -123,7 +125,7 @@ instance Renderable Vertical where   getLayout = getVertical --- | A layout monoid that places everything in a single row+-- | A monoidal layout builder that places everything in a single row newtype Horizontal = Horizontal { getHorizontal :: Layout}  horizontal :: Renderable w => w -> Horizontal@@ -136,7 +138,7 @@ instance Renderable Horizontal where   getLayout = getHorizontal --- | A layout monoid that lays elements in columns+-- | A monoidal layout builder that lays elements in columns data Columns   = Next  Layout -- ^ Continue in the same column   | Break Layout -- ^ Continue in the next column

@@ -16,20 +16,17 @@   , contents   , widgetControl   , widgetTidings-  , liftElement+  -- * Editors   , Editor(.., Horizontally, horizontally, Vertically, vertically)+  , liftElement   , dimapE-  , lmapE   , applyE-    -- ** GenericWidget composition+    -- ** Editor composition   , (|*|), (|*), (*|)   , (-*-), (-*), (*-)   , field   , fieldLayout-  , edit-  , pattern Horizontally-  , pattern Vertically-    -- ** GenericWidget constructors+    -- ** Editor constructors   , editorUnit   , editorIdentity   , editorString@@ -39,9 +36,6 @@   , editorSelection   , editorSum   , editorJust-    -- ** GenericWidget layout-  , withLayout-  , construct   ) where  import           Data.Biapplicative@@ -58,10 +52,9 @@ import           Graphics.UI.Threepenny.Widgets import           Text.Read --- | A widget for editing values of type @a@. data GenericWidget control a = GenericWidget-  { widgetTidings :: Tidings a-  , widgetControl :: control+  { widgetTidings :: Tidings a -- ^ The dynamic contents of the widget.+  , widgetControl :: control   -- ^ The actual widget.   }   deriving Functor @@ -86,23 +79,19 @@ renderEditor :: Renderable w => GenericWidget w a -> UI (GenericWidget Element a) renderEditor = traverseControl render --- | 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@.+-- | An editor for values of type @inner@ inside a datatype @outer@ realized by a @widget@. -----   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.+--   All the three type arguments are functorial, but @outer@ is contravariant, so @Editor@ is a 'Biapplicative' functor and a 'Profunctor' (via 'dimapE'). -----   For an example of the Applicative interface, let's assemble the editor for a tuple of values:+--  'Biapplicative' allows to compose editors on both their @widget@ and @inner@ structure. When @widget@ is monoidal, widget composition is implicit and 'Applicative' suffices. -----   > editorTuple = (,) <$> lmap fst editable <*> lmap snd editable+--  '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.+-- -newtype Editor a el b = Editor {-  -- | Create an editor to display the argument.-  --   User edits are fed back via the 'edited' 'Event'.-  create :: Behavior a -> UI (GenericWidget el b)+newtype Editor outer widget inner = Editor {+  create :: Behavior outer -> UI (GenericWidget widget inner)   }  -- | Lift an HTML element into a vacuous editor.@@ -117,21 +106,6 @@   where     fmapUIGW = coerce (fmap @ (Compose UI _)) --- | Applies a function over the input-lmapE :: (a' -> a) -> Editor a el b -> Editor a' el b-lmapE f = dimapE f id---- | 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-edit :: (a' -> a) -> Editor a el b -> Editor a' el b-edit = lmapE- applyE :: (el1 -> el2 -> el) -> Editor in_ el1 (a -> b) -> Editor in_ el2 a -> Editor in_ el b applyE combineElements a b = Editor $ \s -> do     a <- create a s@@ -185,10 +159,6 @@ withLayout :: (layout -> layout') -> Editor a layout b -> Editor a layout' b withLayout f = bimap f id --- | Construct a concrete 'Layout'. Useful when combining heterogeneours layout builders.-construct :: Renderable m => Editor a m b -> Editor a Layout b-construct = withLayout getLayout- -- | Left-right editor composition (|*|) :: Editor s Layout (b -> a) -> Editor s Layout b -> Editor s Layout a a |*| b = withLayout getHorizontal $ withLayout Horizontal a <*> withLayout Horizontal b@@ -213,13 +183,13 @@ (-*) :: Editor s Layout a -> UI Element -> Editor s Layout a a -* e = withLayout getVertical $ withLayout Vertical a <* liftElement(return $ vertical e) --- | A helper that arranges a label with the field name---   and the editor horizontally. This version takes a Layout builder as well.+-- | A helper that arranges a label and an editor horizontally,+--   wrapped in the given monoidal layout builder. fieldLayout :: (Renderable m, Renderable m') => (Layout -> m') -> String -> (out -> inn) -> Editor inn m a -> Editor out m' a fieldLayout l name f e = withLayout l (string name *| first getLayout (dimapE f id e)) --- | A helper that arranges a label with the field name---   and the editor horizontally.+-- | A helper that arranges a label+--   and an editor horizontally. field :: Renderable m => String -> (out -> inn) -> Editor inn m a -> Editor out Layout a field name f e = string name *| first getLayout (dimapE f id e) 

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           threepenny-editors-version:        0.5.4.1+version:        0.5.5 synopsis:       Composable algebraic editors description:    This package provides a type class 'Editable' and combinators to                 easily put together form-like editors for algebraic datatypes.@@ -39,7 +39,6 @@       base >= 4.7 && < 5     , bifunctors     , containers-    , data-default     , generics-sop     , profunctors     , threepenny-gui > 0.7@@ -63,7 +62,6 @@       base >= 4.7 && < 5     , bifunctors     , containers-    , data-default     , generics-sop     , profunctors     , threepenny-gui > 0.7@@ -85,7 +83,6 @@       base >= 4.7 && < 5     , bifunctors     , containers-    , data-default     , generics-sop     , profunctors     , threepenny-gui > 0.7@@ -107,7 +104,6 @@       base >= 4.7 && < 5     , bifunctors     , containers-    , data-default     , generics-sop     , profunctors     , threepenny-gui > 0.7