packages feed

threepenny-editors 0.5.2 → 0.5.3

raw patch · 8 files changed

+368/−117 lines, 8 filesdep +template-haskelldep −lensdep ~basedep ~threepenny-guinew-component:exe:crudPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: template-haskell

Dependencies removed: lens

Dependency ranges changed: base, threepenny-gui

API changes (from Hackage documentation)

- Graphics.UI.Threepenny.Editors: [_widgetControl] :: GenericWidget control a -> control
- Graphics.UI.Threepenny.Editors: [_widgetTidings] :: GenericWidget control a -> Tidings a
- Graphics.UI.Threepenny.Editors: widgetControl :: forall control_asaT a_asaU control_asnj. Lens (GenericWidget control_asaT a_asaU) (GenericWidget control_asnj a_asaU) control_asaT control_asnj
- Graphics.UI.Threepenny.Editors: widgetTidings :: forall control_asaT a_asaU a_asnk. Lens (GenericWidget control_asaT a_asaU) (GenericWidget control_asaT a_asnk) (Tidings a_asaU) (Tidings a_asnk)
- Graphics.UI.Threepenny.Editors.Types: [_widgetControl] :: GenericWidget control a -> control
- Graphics.UI.Threepenny.Editors.Types: [_widgetTidings] :: GenericWidget control a -> Tidings a
- Graphics.UI.Threepenny.Editors.Types: editorFactoryElement :: Setter (Editor a el b) (Editor a el' b) el el'
- Graphics.UI.Threepenny.Editors.Types: editorFactoryInput :: Setter (Editor a el b) (Editor a' el b) a' a
- Graphics.UI.Threepenny.Editors.Types: editorFactoryOutput :: Setter (Editor a el b) (Editor a el b') b b'
- Graphics.UI.Threepenny.Editors.Types: widgetControl :: forall control_asaT a_asaU control_asnj. Lens (GenericWidget control_asaT a_asaU) (GenericWidget control_asnj a_asaU) control_asaT control_asnj
- Graphics.UI.Threepenny.Editors.Types: widgetTidings :: forall control_asaT a_asaU a_asnk. Lens (GenericWidget control_asaT a_asaU) (GenericWidget control_asaT a_asnk) (Tidings a_asaU) (Tidings a_asnk)
- Graphics.UI.Threepenny.Editors.Validation: Invalid :: String -> ValidationResult
- Graphics.UI.Threepenny.Editors.Validation: Ok :: ValidationResult
+ Graphics.UI.Threepenny.Editors: [widgetControl] :: GenericWidget control a -> control
+ Graphics.UI.Threepenny.Editors: [widgetTidings] :: GenericWidget control a -> Tidings a
+ Graphics.UI.Threepenny.Editors: class Validable a
+ Graphics.UI.Threepenny.Editors: data ValidationResult
+ Graphics.UI.Threepenny.Editors: edit :: (a' -> a) -> Editor a el b -> Editor a' el b
+ Graphics.UI.Threepenny.Editors: fromWarnings :: [String] -> ValidationResult
+ Graphics.UI.Threepenny.Editors: getLayoutGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> [[Layout]]
+ Graphics.UI.Threepenny.Editors: getWarnings :: ValidationResult -> [String]
+ Graphics.UI.Threepenny.Editors: isValid :: Validable a => a -> Bool
+ Graphics.UI.Threepenny.Editors: ok :: ValidationResult
+ Graphics.UI.Threepenny.Editors: renderGeneric :: forall a xs. (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs]) => a -> UI Element
+ Graphics.UI.Threepenny.Editors: updateIfValid :: Validable a => a -> a -> a
+ Graphics.UI.Threepenny.Editors: validate :: Validable a => a -> ValidationResult
+ Graphics.UI.Threepenny.Editors.Types: [widgetControl] :: GenericWidget control a -> control
+ Graphics.UI.Threepenny.Editors.Types: [widgetTidings] :: GenericWidget control a -> Tidings a
+ Graphics.UI.Threepenny.Editors.Validation: fromWarnings :: [String] -> ValidationResult
+ Graphics.UI.Threepenny.Editors.Validation: getWarnings :: ValidationResult -> [String]
+ Graphics.UI.Threepenny.Editors.Validation: ok :: ValidationResult

Files

CHANGELOG.md view
@@ -1,3 +1,14 @@+# 0.5.3 (2017-08-28)+    * Generic derivation for `render`.+    * Dropped dependency on the lens package.+    * Added a new example CRUD exercising the Biapplicative interface.+    * Fixed building of examples with Cabal 2.+    * Changes to the validation module type signatures.+# 0.5.2 (2017-08-13)+    * Name changes:+      - `EditorFactory` is now `Editor`.+      - `Editor` is now `GenericWidget`.+    * Added a module with utilities for doing data validation. # 0.5.1 (2017-07-30)     * Fix a build issue with GHC 8.2.1 # 0.5.0 (2017-07-30)
+ examples/CRUD.hs view
@@ -0,0 +1,149 @@+{-# LANGUAGE UndecidableInstances #-}+{-# LANGUAGE TemplateHaskell #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecordWildCards #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE DeriveGeneric #-}+{-----------------------------------------------------------------------------+    Example from threepenny-gui extended with Editors:++    Small database with CRUD operations and filtering.+    To keep things simple, the list box is rebuild every time+    that the database is updated. This is perfectly fine for rapid prototyping.+    A more sophisticated approach would use incremental updates.+------------------------------------------------------------------------------}+{-# LANGUAGE RecursiveDo #-}+module CRUD (main) where+import Prelude hiding (lookup)+import Control.Monad  (void)+import Data.Biapplicative+import Data.List      (isPrefixOf)+import Data.Maybe+import qualified Data.Map as Map+import Generics.SOP.TH++import qualified Graphics.UI.Threepenny as UI+import Graphics.UI.Threepenny.Editors hiding (create)+import qualified Graphics.UI.Threepenny.Editors as Editors+import Graphics.UI.Threepenny.Core hiding (delete)++{-----------------------------------------------------------------------------+    Main+------------------------------------------------------------------------------}+main :: IO ()+main = startGUI defaultConfig setup++setup :: Window -> UI ()+setup window = void $ mdo+    return window # set title "CRUD Example (Simple)"++    -- GUI elements+    createBtn   <- UI.button #+ [string "Create"]+    deleteBtn   <- UI.button #+ [string "Delete"]+    listBox     <- UI.listBox  bListBoxItems bSelection bDisplayDataItem+    filterEntry <- UI.entry    bFilterString+    dataItem    <- Editors.create editor (fromMaybe (DataItem "" "") <$> bSelectionDataItem)++    -- GUI layout+    element listBox # set (attr "size") "10" # set style [("width","200px")]++    let glue = string " "+    getBody window #+ [grid+        [[row [string "Filter prefix:", element filterEntry], glue]+        ,[element listBox, render dataItem]+        ,[row [element createBtn, element deleteBtn], glue]+        ]]++    -- events and behaviors+    bFilterString <- stepper "" . rumors $ UI.userText filterEntry+    let tFilter = isPrefixOf <$> UI.userText filterEntry+        bFilter = facts  tFilter+        eFilter = rumors tFilter++    let eSelection  = rumors $ UI.userSelection listBox+        eDataItemIn = edited dataItem+        eCreate     = UI.click createBtn+        eDelete     = UI.click deleteBtn++    -- database+    -- bDatabase :: Behavior (Database DataItem)+    let update' mkey x = flip update x <$> mkey+    bDatabase <- accumB emptydb $ concatenate <$> unions+        [ create (DataItem "Emil" "Example") <$ eCreate+        , filterJust $ update' <$> bSelection <@> eDataItemIn+        , delete <$> filterJust (bSelection <@ eDelete)+        ]++    -- selection+    -- bSelection :: Behavior (Maybe DatabaseKey)+    bSelection <- stepper Nothing $ head <$> unions+        [ eSelection+        , Nothing <$ eDelete+        , Just . nextKey <$> bDatabase <@ eCreate+        , (\b s p -> b >>= \a -> if p (s a) then Just a else Nothing)+            <$> bSelection <*> bShowDataItem <@> eFilter+        ]++    let bLookup :: Behavior (DatabaseKey -> Maybe DataItem)+        bLookup = flip lookup <$> bDatabase++        bShowDataItem :: Behavior (DatabaseKey -> String)+        bShowDataItem = (maybe "" showDataItem .) <$> bLookup++        bDisplayDataItem = (UI.string .) <$> bShowDataItem++        bListBoxItems :: Behavior [DatabaseKey]+        bListBoxItems = (\p show -> filter (p. show) . keys)+                    <$> bFilter <*> bShowDataItem <*> bDatabase++        bSelectionDataItem :: Behavior (Maybe DataItem)+        bSelectionDataItem = (=<<) <$> bLookup <*> bSelection++    -- automatically enable / disable editing+    let+        bDisplayItem :: Behavior Bool+        bDisplayItem = isJust <$> bSelection++    element deleteBtn # sink UI.enabled bDisplayItem+    element (firstName $ widgetControl dataItem) # sink UI.enabled bDisplayItem+    element (lastName  $ widgetControl dataItem) # sink UI.enabled bDisplayItem+++{-----------------------------------------------------------------------------+    Database Model+------------------------------------------------------------------------------}+type DatabaseKey = Int+data Database a  = Database { nextKey :: !Int, db :: Map.Map DatabaseKey a }++emptydb = Database 0 Map.empty+keys    = Map.keys . db++create x     (Database newkey db) = Database (newkey+1) $ Map.insert newkey x db+update key x (Database newkey db) = Database newkey     $ Map.insert key    x db+delete key   (Database newkey db) = Database newkey     $ Map.delete key db+lookup key   (Database _      db) = Map.lookup key db++{-----------------------------------------------------------------------------+    Data items that are stored in the data base+------------------------------------------------------------------------------}+data DataItemDual (usage :: Usage) = DataItem+  { firstName, lastName :: Field usage String+  }++showDataItem :: DataItem -> String+showDataItem DataItem{..} = lastName ++ ", " ++ firstName++type DataItem = DataItemDual Value+type DataItemEditor = DataItemDual Edit++instance Editable DataItem where+  type EditorWidget DataItem = DataItemEditor+  editor = bipure DataItem DataItem+           <<*>> edit firstName editor+           <<*>> edit lastName editor++deriveGeneric ''DataItemDual+instance Renderable DataItemEditor where+  render = renderGeneric
examples/Parser.hs view
@@ -1,7 +1,6 @@ {-# OPTIONS_GHC -fno-warn-name-shadowing #-} {-# LANGUAGE RecursiveDo #-}--module Main(main) where+module Parser(main) where  import qualified Graphics.UI.Threepenny         as UI import           Graphics.UI.Threepenny.Core
examples/Person.hs view
@@ -10,6 +10,7 @@ {-# LANGUAGE TypeFamilies               #-} {-# OPTIONS_GHC -Wno-name-shadowing     #-} {-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}+module Person (main) where import           Control.Monad import           Data.Biapplicative import           Data.Default@@ -18,8 +19,6 @@ import           GHC.Generics                              (Generic) import           Graphics.UI.Threepenny.Core import           Graphics.UI.Threepenny.Editors-import           Graphics.UI.Threepenny.Editors.Types-import           Graphics.UI.Threepenny.Editors.Validation import           Graphics.UI.Threepenny.Elements import           Prelude                                   hiding (span) @@ -40,11 +39,10 @@ type PersonEditor = PersonF Edit  instance Validable Person where-  validate Person{..}-    | null firstName = Invalid "First name cannot be null"-    | null lastName  = Invalid "Last name cannot be null"-    | Just x <- age, x <= 0 = Invalid "Age must be a natural number"-    | otherwise = Ok+  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]  data LegalStatus   = Single@@ -102,23 +100,6 @@ instance SOP.Generic Person instance Default Person where def = Person Basic "First" "Last" (Just 18) def def --- | An editor for 'Person' values that combines the 'Horizontal' and 'Vertical' layout builders-editorPersonHV :: Editor Person Vertical Person-editorPersonHV = do-  (firstName, lastName) <- withLayout Vertical $ construct $ do-      firstName <- fieldLayout Horizontal "First:"     firstName editor-      lastName  <- fieldLayout Horizontal "Last:"      lastName editor-      return (firstName, lastName)-  (age, education) <- withLayout Vertical $ construct $ do-      age       <- fieldLayout Horizontal "Age:"       age editor-      education <- fieldLayout Horizontal "Education:" education editorEducation-      return (age, education)-  (status, brexiteer) <- withLayout Vertical $ construct $ do-      status    <- fieldLayout Horizontal "Status"     status (withSomeWidget $ editorJust $ editorSelection (pure [minBound..]) (pure (string.show)))-      brexiteer <- fieldLayout Horizontal "Brexiter"   brexiteer editor-      return (status, brexiteer)-  return Person{..}- -- | An editor for 'Person' values that uses the 'Columns' layout builder editorPersonColumns :: Editor Person Columns Person editorPersonColumns = do@@ -160,31 +141,26 @@ setup :: Window -> UI () setup w = void $ mdo   _ <- return w # set title "Threepenny editors example"-  person1HV <- create editorPersonHV person1B   person1C <- create editorPersonColumns person1B   person2  <- create editorGeneric person1B   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")]+  _ <- element (firstName (widgetControl person3e)) # set style [("background-color", "Blue")]   person1B <- accumB def (updateIfValid . head <$> unions-                            [ edited person1HV-                            , edited person1C+                            [ edited person1C                             , edited person2                             , edited person3e                             ])    -- We can attach validation to any editor   validation <--      stepper Ok (validate . head <$>-                  unions [ edited person1HV-                          , edited person1C-                          , edited person2-                          , edited person3e])+      stepper ok (validate . head <$>+                  unions [ edited person1C+                         , edited person2+                         , edited person3e])    getBody w #+ [grid     [ [span # sink text (show <$> validation) # set style [("color", "red")]]-    , [render person1HV]-    , [hr]     , [render person1C]     , [hr]     , [render person2]
src/Graphics/UI/Threepenny/Editors.hs view
@@ -27,6 +27,7 @@   , Editor(Horizontally, horizontally, Vertically, vertically)   , someEditor   , create+  , edit   , lmapE   , dimapE   , Editable(..)@@ -66,8 +67,18 @@   -- ** Type level layouts   , type (|*|)(..)   , type (-*-)(..)-  -- ** Layout manipulation+  -- ** Custom layout definition   , Renderable(..)+  , renderGeneric+  , getLayoutGeneric+  -- * Validation+  , Validable(..)+  , ValidationResult+  , ok+  , fromWarnings+  , getWarnings+  , isValid+  , updateIfValid   ) where  import           Data.Biapplicative@@ -76,6 +87,7 @@ import           Data.Functor.Compose import           Data.Functor.Identity import           Data.Maybe+import qualified Data.Sequence as Seq import           Generics.SOP                          hiding (Compose) import           Graphics.UI.Threepenny.Core           as UI import           Graphics.UI.Threepenny.Widgets@@ -83,6 +95,7 @@  import           Graphics.UI.Threepenny.Editors.Layout import           Graphics.UI.Threepenny.Editors.Types+import           Graphics.UI.Threepenny.Editors.Validation  -- | The class of 'Editable' datatypes. --   .@@ -157,9 +170,68 @@   type EditorWidget (Identity a) = EditorWidget a   editor = editorIdentity editor -{---------------------------------------------  Generic derivations----------------------------------------------}+{----------------------------------------------+  Generic derivations for Renderable datatypes+-----------------------------------------------}+-- | 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 ]+--            ]+-- @++renderGeneric+  :: forall a xs.+     (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs])+  => a -> UI Element+renderGeneric = render . (Grid . Seq.fromList . fmap Seq.fromList) . getLayoutGeneric++-- | 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.+getLayoutGeneric+  :: forall a xs.+     (Generic a, HasDatatypeInfo a, All Renderable xs, Code a ~ '[xs])+  => a -> [[Layout]]+getLayoutGeneric = getLayoutGeneric' (datatypeInfo (Proxy @ a)) . from++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"++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+getLayoutConstructor Constructor{} renders = hcollapse $ hcliftA (Proxy @ Renderable) (\(I x) -> K [getLayout x]) renders+getLayoutConstructor (Infix name _ _) (I r1 :* I r2 :* Nil) = [[ getLayout r1, getLayout(string name), getLayout r2]]++getLayoutField :: Renderable x => FieldInfo x -> x -> [Layout]+getLayoutField (FieldInfo name) x =  [getLayout(toFieldLabel name), getLayout x]++{----------------------------------------------+  Generic derivations for Applicative Editables+-----------------------------------------------} -- | A generic editor for record types. editorGenericSimple   :: forall a xs.
src/Graphics/UI/Threepenny/Editors/Types.hs view
@@ -1,9 +1,10 @@-{-# LANGUAGE DataKinds       #-}-{-# LANGUAGE DeriveFunctor   #-}-{-# LANGUAGE PatternSynonyms #-}-{-# LANGUAGE TemplateHaskell #-}-{-# LANGUAGE TupleSections   #-}-{-# LANGUAGE ViewPatterns    #-}+{-# LANGUAGE DataKinds           #-}+{-# LANGUAGE DeriveFunctor       #-}+{-# LANGUAGE PatternSynonyms     #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections       #-}+{-# LANGUAGE TypeApplications    #-}+{-# LANGUAGE ViewPatterns        #-} {-# OPTIONS_GHC -Wno-name-shadowing     #-} {-# OPTIONS_GHC -Wno-duplicate-exports  #-} @@ -20,9 +21,6 @@   , dimapE   , lmapE   , applyE-  , editorFactoryElement-  , editorFactoryInput-  , editorFactoryOutput     -- ** GenericWidget composition   , (|*|), (|*), (*|)   , (-*-), (-*), (*-)@@ -46,11 +44,11 @@   , construct   ) where -import           Control.Applicative-import           Control.Lens                          hiding (beside, children,-                                                        element, set, ( # )) import           Data.Biapplicative+import           Data.Coerce import           Data.Functor.Compose+import           Data.Functor.Identity+import           Data.Profunctor import           Graphics.UI.Threepenny.Attributes import           Graphics.UI.Threepenny.Core           as UI import           Graphics.UI.Threepenny.Editors.Layout@@ -62,58 +60,51 @@  -- | A widget for editing values of type @a@. data GenericWidget control a = GenericWidget-  { _widgetTidings :: Tidings a-  , _widgetControl :: control+  { widgetTidings :: Tidings a+  , widgetControl :: control   }   deriving Functor -makeLenses ''GenericWidget- instance Bifunctor GenericWidget where   bimap f g (GenericWidget t e) = GenericWidget (g <$> t) (f e) +traverseControl :: Applicative f => (control -> f control') -> GenericWidget control a -> f (GenericWidget control' a)+traverseControl f (GenericWidget t e) = GenericWidget t <$> f e+ edited :: GenericWidget el a -> Event a-edited = rumors . _widgetTidings+edited = rumors . widgetTidings  contents :: GenericWidget el a -> Behavior a-contents = facts . _widgetTidings+contents = facts . widgetTidings  instance Widget el => Widget (GenericWidget el a) where-  getElement = getElement . _widgetControl+  getElement = getElement . widgetControl  instance Renderable el => Renderable (GenericWidget el a) where-  render = render . _widgetControl+  render = render . widgetControl  renderEditor :: Renderable w => GenericWidget w a -> UI (GenericWidget Element a)-renderEditor = mapMOf widgetControl render-  where-    mapMOf l cmd = unwrapMonad . l (WrapMonad . cmd)+renderEditor = traverseControl render --- | A function from 'Behavior' @a@ to 'GenericWidget' @b@+-- | 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@.+--   '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+ 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)   } -_Editor :: Iso (Editor a el b) (Editor a' el' b') (Behavior a -> UI (GenericWidget el b)) (Behavior a' -> UI (GenericWidget el' b'))-_Editor = iso create Editor---- | A 'Setter' over the element of the editor being built-editorFactoryElement :: Setter (Editor a el b) (Editor a el' b) el el'-editorFactoryElement = _Editor.mapped.mapped.widgetControl---- | A 'Setter' over the input thing-editorFactoryInput :: Setter (Editor a el b) (Editor a' el b) a' a-editorFactoryInput = _Editor.argument.mapped---- | A 'Setter' over the output thing-editorFactoryOutput :: Setter (Editor a el b) (Editor a el b') b b'-editorFactoryOutput = _Editor.mapped.mapped.mapped- -- | Lift an HTML element into a vacuous editor. liftElement :: UI el -> Editor a el () liftElement el = Editor $ \_ -> GenericWidget (pure ()) <$> el@@ -122,14 +113,15 @@ bimapEditor g h = Editor . fmap (fmap (bimap g h)) . create  dimapE :: (a' -> a) -> (b -> b') -> Editor a el b -> Editor a' el b'-dimapE g h (Editor f) = Editor $ \b -> getCompose $ h <$> Compose (f (g <$> b))+dimapE g h (Editor f) = Editor $ dimap (fmap g) (fmapUIGW h) f+  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 --- | Focus the editor on the field retrieved by the getter.---   Use when composing editors via the Biapplicative interface+-- | Use when composing Biapplicative editors to focus on a field. -- -- > personEditor :: Editor Person PersonEditor Person -- > personEditor =@@ -144,7 +136,7 @@ applyE combineElements a b = Editor $ \s -> do     a <- create a s     b <- create b s-    return $ GenericWidget (_widgetTidings a <*> _widgetTidings b) (_widgetControl a `combineElements` _widgetControl b)+    return $ GenericWidget (widgetTidings a <*> widgetTidings b) (widgetControl a `combineElements` widgetControl b)  instance Functor (Editor a el) where   fmap = dimapE id@@ -191,7 +183,7 @@  -- | Apply a layout builder. withLayout :: (layout -> layout') -> Editor a layout b -> Editor a layout' b-withLayout = over editorFactoryElement+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@@ -257,7 +249,7 @@     let readIt "" = Nothing         readIt x  = readMaybe x     let t = tidings b (readIt <$> edited e)-    return $ GenericWidget t (_widgetControl e)+    return $ GenericWidget t (widgetControl e)  -- An editor that presents a choice of values. editorEnumBounded@@ -278,7 +270,7 @@ editorJust (Editor editor) = Editor $ \b -> do   e <- editor (Just <$> b)   let ev = filterJust (edited e)-  return $ GenericWidget (tidings b ev) (_widgetControl e)+  return $ GenericWidget (tidings b ev) (widgetControl e)  -- | An editor for union types, built from editors for its constructors. editorSum@@ -293,7 +285,7 @@   l <- listBox (pure $ fmap fst options) (Just <$> tag) (pure (string . show))   -- a placeholder for the constructor editor   nestedEditor <--    new # sink children ((\x -> [maybe (error "editorSum") _widgetControl (build x)]) <$> tag')+    new # sink children ((\x -> [maybe (error "editorSum") widgetControl (build x)]) <$> tag')   --   let composed = combineLayout (Single (return $ getElement l)) (Single $ return nestedEditor)   -- the result event fires when any of the nested editors or the tag selector fire.
src/Graphics/UI/Threepenny/Editors/Validation.hs view
@@ -1,21 +1,49 @@+{- | Simple helpers to perform validation of user input.++   @+     -- update only if valid+     value <- accumB def updateIfValid userEdits++     -- collect validation warnings+     warnings <- stepper ok validate userEdits+   @+-}+ module Graphics.UI.Threepenny.Editors.Validation-  ( ValidationResult(..)+  ( ValidationResult+  , ok+  , fromWarnings+  , getWarnings   , Validable(..)   , isValid   , updateIfValid   ) where -data ValidationResult = Ok | Invalid String+newtype ValidationResult = ValidationResult [String]++-- | All is good+ok :: ValidationResult+ok = ValidationResult []++-- | Create a validation result from a list of warnings.+--+--  > fromWarnings [] = ok+fromWarnings :: [String] -> ValidationResult+fromWarnings = ValidationResult++getWarnings :: ValidationResult -> [String]+getWarnings (ValidationResult ww) = ww+ instance Show ValidationResult where-  show Ok            = ""-  show (Invalid msg) = msg+  show = unlines . getWarnings +-- | The class of values that support validation. class Validable a where   validate :: a -> ValidationResult  isValid :: Validable a => a -> Bool isValid x-  | Ok <- validate x = True+  | ValidationResult [] <- validate x = True   | otherwise = False  updateIfValid :: Validable a => a -> a -> a
threepenny-editors.cabal view
@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           threepenny-editors-version:        0.5.2+version:        0.5.3 synopsis:       Composable algebraic editors description:    This package provides a type class 'Editable' and combinators to                 easily put together form-like editors for algebraic datatypes.@@ -41,10 +41,10 @@     , containers     , data-default     , generics-sop-    , lens     , profunctors     , threepenny-gui > 0.7     , casing+    , template-haskell   exposed-modules:       Graphics.UI.Threepenny.Editors       Graphics.UI.Threepenny.Editors.Layout@@ -55,43 +55,67 @@       Paths_threepenny_editors   default-language: Haskell2010 +executable crud+  main-is: CRUD.hs+  hs-source-dirs:+      examples+  ghc-options: -Wall -Wno-name-shadowing -main-is CRUD+  build-depends:+      base >= 4.7 && < 5+    , bifunctors+    , containers+    , data-default+    , generics-sop+    , profunctors+    , threepenny-gui > 0.7+    , casing+  if flag(buildExamples)+    build-depends:+        threepenny-editors+      , containers+  else+    buildable: False+  default-language: Haskell2010+ executable parser   main-is: Parser.hs   hs-source-dirs:       examples-  ghc-options: -Wall -Wno-name-shadowing+  ghc-options: -Wall -Wno-name-shadowing -main-is Parser+  build-depends:+      base >= 4.7 && < 5+    , bifunctors+    , containers+    , data-default+    , generics-sop+    , profunctors+    , threepenny-gui > 0.7+    , casing   if flag(buildExamples)     build-depends:-        base-      , bifunctors-      , data-default-      , generics-sop-      , profunctors-      , threepenny-gui-      , threepenny-editors+        threepenny-editors       , haskell-src-exts   else     buildable: False-  other-modules:-      Person   default-language: Haskell2010  executable person   main-is: Person.hs   hs-source-dirs:       examples-  ghc-options: -Wall -Wno-name-shadowing+  ghc-options: -Wall -Wno-name-shadowing -main-is Person+  build-depends:+      base >= 4.7 && < 5+    , bifunctors+    , containers+    , data-default+    , generics-sop+    , profunctors+    , threepenny-gui > 0.7+    , casing   if flag(buildExamples)     build-depends:-        base-      , bifunctors-      , data-default-      , generics-sop-      , profunctors-      , threepenny-gui-      , threepenny-editors+        threepenny-editors   else     buildable: False-  other-modules:-      Parser   default-language: Haskell2010