threepenny-editors (empty) → 0.1.0.0

raw patch · 6 files changed

+348/−0 lines, 6 filesdep +basedep +profunctorsdep +threepenny-editorssetup-changed

Dependencies added: base, profunctors, threepenny-editors, threepenny-gui

Files

LICENSE +30/−0
README.md +6/−0
Setup.hs +2/−0
examples/Person.hs +77/−0
src/Graphics/UI/Threepenny/Editors.hs +174/−0
threepenny-editors.cabal +59/−0

+ LICENSE view

@@ -0,0 +1,30 @@+Copyright Jose Iborra (c) 2017++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Jose Iborra nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.

+ README.md view

@@ -0,0 +1,6 @@+[![Travis Build Status](https://travis-ci.org/pepeiborra/threepenny-editors.svg)](https://travis-ci.org/pepeiborra/threepenny-editors)+[![Hackage](https://img.shields.io/hackage/v/threepenny-editors.svg)](https://hackage.haskell.org/package/threepenny-editors)+[![Stackage Nightly](http://stackage.org/package/threepenny-editors/badge/nightly)](http://stackage.org/nightly/package/threepenny-editors)++# threepenny-editors+A library for writing composable algebraic widgets with three penny.

+ Setup.hs view

@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain

+ examples/Person.hs view

@@ -0,0 +1,77 @@+{-# LANGUAGE RecursiveDo         #-}+{-# LANGUAGE ScopedTypeVariables #-}+import           Control.Monad+import           Data.Maybe+import           Graphics.UI.Threepenny.Core+import           Graphics.UI.Threepenny.Editors+import           Graphics.UI.Threepenny.Elements++main :: IO ()+main = startGUI defaultConfig setup++data LegalStatus+  = Single+  | Married+  | Divorced+  | Widowed+  deriving (Bounded, Enum, Eq, Ord, Show)++data Education+  = Basic_+  | Intermediate_+  | Other_ String+  deriving (Eq, Ord, Read, Show)++getOther :: Education -> Maybe String+getOther (Other_ s) = Just s+getOther _          = Nothing++data EducationTag = Basic | Intermediate | Other deriving (Eq,Ord,Show)++data Person = Person+  { education           :: Education+  , firstName, lastName :: String+  , age                 :: Int+  , brexiteer           :: Bool+  , status              :: Maybe LegalStatus+  }+  deriving Show++instance Editable Education where+  editor b = do+    basicEditor <- fmap (const Basic_) <$> editor (pure ())+    intermediateEditor <- fmap (const Intermediate_) <$> editor (pure ())+    otherEditor <- fmap Other_ <$> editor (fromMaybe "" . getOther <$> b)+    let selector x =+          case x of+            Basic_        -> Basic+            Intermediate_ -> Intermediate+            Other_ _      -> Other+    editorSum+      [ (Basic, basicEditor)+      , (Intermediate, intermediateEditor)+      , (Other, otherEditor)+      ]+      selector+      b++instance Editable Person where+  editor b =+    fmap (\fn ln a e ls b -> Person e fn ln a b ls)+      <$> string "First:"     *| editor (firstName <$> b)+      -*- string "Last:"      *| editor (lastName <$> b)+      -*- string "Age:"       *| editor (age <$> b)+      -*- string "Education:" *| editor (education <$> b)+      -*- string "Status"     *| editorEnumBounded(pure(string.show)) (status <$> b)+      -*- string "Brexiter"   *| editor (brexiteer <$> b)++setup :: Window -> UI ()+setup w = void $ mdo+  _ <- return w # set title "Threepenny editors example"+  person1 :: Editor Person <- editor person1B+  person1B <- stepper (Person Basic_ "" "" 0 False Nothing) (edited person1)++  getBody w #+ [grid+    [ [return $ editorElement person1]+    , [sink text (show <$> contents person1) p]+    ]]

+ src/Graphics/UI/Threepenny/Editors.hs view

@@ -0,0 +1,174 @@+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveFunctor     #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE RecursiveDo       #-}+{-# LANGUAGE TupleSections     #-}+{-# OPTIONS_GHC  #-}+module Graphics.UI.Threepenny.Editors+  ( -- * Editors+    Editor(..)+  , edited+  , contents+    -- ** Editor compoosition+  , (|*|), (|*), (*|)+  , (-*-), (-*), (*-)+    -- ** Editor constructors+  , editorReadShow+  , editorEnumBounded+  , withDefault+  )where++import           Data.Maybe+import           Data.Profunctor+import           Graphics.UI.Threepenny.Attributes+import           Graphics.UI.Threepenny.Core+import           Graphics.UI.Threepenny.Elements+import           Graphics.UI.Threepenny.Events+import           Graphics.UI.Threepenny.Widgets+import           Text.Read++data Editor a = Editor+  { editorTidings :: Tidings a+  , editorElement :: Element+  }+  deriving Functor++instance Widget (Editor a) where+  getElement = editorElement++-- | A newtype wrapper that provides a 'Profunctor' instance.+newtype EditorFactory a b = EditorFactory { run :: Behavior a -> UI (Editor b) }++instance Profunctor EditorFactory where+  dimap g h (EditorFactory f) = EditorFactory $ \b -> fmap h <$> f (g <$> b)++-- | The class of Editable datatypes.+class Editable a where+  -- | The editor factory+  editor :: Behavior a -> UI (Editor a)++edited :: Editor a -> Event a+edited = rumors . editorTidings++contents :: Editor a -> Behavior a+contents = facts . editorTidings++infixl 4 |*|, -*-+infixl 5 |*, *|, -*, *-++-- | Left-right editor composition+(|*|) :: UI(Editor (b -> a)) -> UI(Editor b) -> UI(Editor a)+a |*| b = do+  a <- a+  b <- b+  ab <- row [return $ getElement a, return $ getElement b]+  return $ Editor (editorTidings a <*> editorTidings b) ab++-- | Left-right composition of an element with a editor+(*|) :: UI Element -> UI (Editor a) -> UI (Editor a)+e *| a = do+  e <- e+  a <- a+  ea <- row [return e, return $ getElement a]+  return $ Editor (editorTidings a) ea++-- | Left-right composition of an element with a editor+(|*) :: UI (Editor a) -> UI Element -> UI (Editor a)+a |* e = do+  e <- e+  a <- a+  ea <- row [return $ getElement a, return e]+  return $ Editor (editorTidings a) ea++-- | Top-down editor composition+(-*-) :: UI(Editor (b -> a)) -> UI(Editor b) -> UI(Editor a)+a -*- b = do+  a <- a+  b <- b+  ab <- column [return $ getElement a, return $ getElement b]+  return $ Editor (editorTidings a <*> editorTidings b) ab++-- | Top-down composition of an element with a editor+(*-) :: UI Element -> UI (Editor a) -> UI (Editor a)+e *- a = do+  e <- e+  a <- a+  ea <- column [return e, return $ getElement a]+  return $ Editor (editorTidings a) ea++-- | Top-down composition of an element with a editor+(-*) :: UI (Editor a) -> UI Element -> UI (Editor a)+a -* e = do+  e <- e+  a <- a+  ea <- column [return $ getElement a, return e]+  return $ Editor (editorTidings a) ea++editorReadShow :: (Read a, Show a) => Behavior (Maybe a) -> UI (Editor (Maybe a))+editorReadShow b =+  do+    e <- editor (show <$> b)+    let t = tidings b (filterJust $ readMaybe <$> edited e)+    return $ Editor t (getElement e)++editorEnumBounded+  :: (Bounded a, Enum a, Ord a, Show a)+  => Behavior(a -> UI Element) -> Behavior (Maybe a) -> UI (Editor (Maybe a))+editorEnumBounded display b = do+  l <- listBox (pure $ enumFrom minBound) b display+  return $ Editor (userSelection l) (getElement l)++withDefault+  :: EditorFactory (Maybe a) (Maybe b)+  -> b+  -> EditorFactory a b+withDefault editor def = dimap Just (fromMaybe def) editor++data SumWrapper tag a = A {display :: tag, factory :: Editor a}++instance Eq  tag  => Eq   (SumWrapper tag a) where A a _ == A b _ = a == b+instance Ord tag  => Ord  (SumWrapper tag a) where compare (A a _) (A b _) = compare a b+instance Show tag => Show (SumWrapper tag a) where show = show . display++-- | * Experimental editor, do not use yet.+editorSum+  :: (Ord tag, Show tag)+  => [(tag, Editor a)] -> (a -> tag) -> Behavior a -> UI (Editor a)+editorSum options selector ba = mdo+  let bSelected =+        let build a =+              let tag = selector a+              in A tag <$> lookup tag options+        in build <$> ba+  l <- listBox (pure $ fmap (uncurry A) options) bSelected (pure (string . show))+  let nestedEditor = factory . fromMaybe (uncurry A $ head options) <$> bSelected+  nestedElement <- sink children ((:[]) . getElement <$> nestedEditor) new+  composed <- column [element l, widget nestedElement]+  let joinE :: Event (Event a) -> UI(Event a)+      joinE = undefined -- missing in threepenny-gui+  event <- joinE (edited <$> nestedEditor <@ rumors (userSelection l))+  return $ Editor (tidings ba event) composed++instance Editable () where+  editor b = do+    t <- new+    return $ Editor (tidings b never) (getElement t)++instance a ~ Char => Editable [a] where+  editor b = do+    t <- entry b+    return $ Editor (userText t) (getElement t)++instance Editable Int where+  editor = run $ EditorFactory editor `withDefault` 0++instance Editable Double where+  editor = run $ EditorFactory editor `withDefault` 0++instance Editable Bool where+  editor b = do+    t <- sink checked b $ input # set type_ "checkbox"+    return $ Editor (tidings b $ checkedChange t) t++instance Editable (Maybe Int) where editor = editorReadShow+instance Editable (Maybe Double) where editor = editorReadShow

+ threepenny-editors.cabal view

@@ -0,0 +1,59 @@+-- This file has been generated from package.yaml by hpack version 0.17.0.+--+-- see: https://github.com/sol/hpack++name:           threepenny-editors+version:        0.1.0.0+synopsis:       Composable algebraic editors+description:    This package provides a type class 'Editable' and combinators to+                easily put together form-like editors for algebraic datatypes.+                .+                NOTE: This library contains examples, but they are not built by default.+                To build and install the example, use the @buildExamples@ flag like this+                .+                @cabal install threepenny-gui -fbuildExamples@+category:       Web+homepage:       https://github.com/pepeiborra/threepenny-forms#readme+author:         Jose Iborra+maintainer:     pepeiborra@gmail.com+copyright:      All Rights Reserved+license:        BSD3+license-file:   LICENSE+build-type:     Simple+cabal-version:  >= 1.10++extra-source-files:+    README.md++flag buildExamples+  description: build the examples+  manual: True+  default: False++library+  hs-source-dirs:+      src+  ghc-options: -Wall -Wno-name-shadowing+  build-depends:+      base >= 4.7 && < 5+    , profunctors+    , threepenny-gui > 0.7+  exposed-modules:+      Graphics.UI.Threepenny.Editors+  other-modules:+      Paths_threepenny_editors+  default-language: Haskell2010++executable person+  main-is: Person.hs+  hs-source-dirs:+      examples+  ghc-options: -Wall -Wno-name-shadowing+  if flag(buildExamples)+    build-depends:+        base+      , threepenny-gui+      , threepenny-editors+  else+    buildable: False+  default-language: Haskell2010