threepenny-editors 0.2.0.4 → 0.2.0.5

raw patch · 5 files changed

+199/−19 lines, 5 filesdep +data-defaultdep +generics-sopPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: data-default, generics-sop

API changes (from Hackage documentation)

Files

• CHANGELOG.md +6/−0
• examples/Person.hs +47/−15
• src/Graphics/UI/Threepenny/Editors.hs +3/−0
• src/Graphics/UI/Threepenny/Editors/Profunctor.hs +137/−3
• threepenny-editors.cabal +6/−1

@@ -0,0 +1,6 @@+# 0.2.1.0 (2017-05-14)++	* Add `editorGeneric` and `editorGenericSimple` for types with generics-sop instances.+	The latter is only for record and newtypes, whereas the former supports also+	Union types, but comes with additional type class constraints.+	* Give `Editable` default implementations for generic types.

@@ -1,8 +1,13 @@+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE DeriveGeneric       #-} {-# LANGUAGE RecursiveDo         #-} {-# LANGUAGE ScopedTypeVariables #-} import           Control.Monad+import           Data.Default import           Data.Maybe import           Data.Profunctor+import qualified Generics.SOP                    as SOP+import           GHC.Generics import           Graphics.UI.Threepenny.Core import           Graphics.UI.Threepenny.Editors import           Graphics.UI.Threepenny.Elements@@ -15,22 +20,29 @@   | Married   | Divorced   | Widowed-  deriving (Bounded, Enum, Eq, Ord, Show)+  deriving (Bounded, Enum, Eq, Ord, Show, Generic) +instance Editable LegalStatus+instance SOP.HasDatatypeInfo LegalStatus+instance SOP.Generic LegalStatus+instance Default LegalStatus where def = Single+ data Education   = Basic_   | Intermediate_   | Other_ String-  deriving (Eq, Ord, Read, Show)+  deriving (Eq, Ord, Read, Show, Generic) +instance Default Education where def = Basic_+ getOther :: Education -> Maybe String getOther (Other_ s) = Just s getOther _          = Nothing -data EducationTag = Basic | Intermediate | Other deriving (Eq,Ord,Show)+data EducationTag = Basic | Intermediate | Other deriving (Eq,Ord,Show, Generic) -instance Editable Education where-  editor = do+editorEducation :: EditorFactory Education Education+editorEducation = do     let selector x =           case x of             Basic_        -> Basic@@ -43,36 +55,56 @@       ]       selector +instance Editable Education+instance SOP.HasDatatypeInfo Education+instance SOP.Generic Education +newtype Brexiteer = Brexiteer Bool deriving (Eq, Show, Ord, Generic)++instance Default Brexiteer where def = Brexiteer False+instance Editable Brexiteer where editor = editorGenericSimple+instance SOP.HasDatatypeInfo Brexiteer+instance SOP.Generic Brexiteer+ data Person = Person   { education           :: Education   , firstName, lastName :: String   , age                 :: Maybe Int-  , brexiteer           :: Bool+  , brexiteer           :: Brexiteer   , status              :: LegalStatus   }-  deriving Show+  deriving (Generic, Show) -instance Editable LegalStatus where-  editor = editorJust $ editorEnumBounded(pure(string.show))+instance Editable Person+instance SOP.HasDatatypeInfo Person+instance SOP.Generic Person+instance Default Person where def = Person Basic_ "First" "Last" (Just 18) def def -instance Editable Person where-  editor =+editorLegalStatus :: EditorFactory LegalStatus LegalStatus+editorLegalStatus = editorJust $ editorEnumBounded(pure(string.show))++editorPerson :: EditorFactory Person Person+editorPerson =     (\fn ln a e ls b -> Person e fn ln a b ls)       <$> field "First:"     firstName editor       -*- field "Last:"      lastName editor       -*- field "Age:"       age editor-      -*- field "Education:" education editor-      -*- field "Status"     status editor+      -*- field "Education:" education editorEducation+      -*- field "Status"     status editorLegalStatus       -*- field "Brexiter"   brexiteer editor  setup :: Window -> UI () setup w = void $ mdo   _ <- return w # set title "Threepenny editors example"-  person1 <- createEditor editor person1B-  person1B <- stepper (Person Basic_ "First" "Last" (Just 18) False Single) (edited person1)+  person1 <- createEditor editorPerson person1B+  person1B <- stepper def (edited person1) +  person2 <- createEditor editorGeneric person1B+   getBody w #+ [grid     [ [return $ editorElement person1]+    , [hr]+    , [return $ editorElement person2]+    , [hr]     , [sink text (show <$> contents person1) p]     ]]

@@ -17,6 +17,9 @@   , editorEnumBounded   , editorSum   , editorJust+    -- ** Generic editors+  , editorGeneric+  , editorGenericSimple   -- * Reexports   , Compose(..)   )where

@@ -1,7 +1,19 @@+{-# LANGUAGE DefaultSignatures #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-}-{-# LANGUAGE TupleSections     #-}-{-# LANGUAGE TypeFamilies      #-}-{-# OPTIONS_GHC  #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE RankNTypes #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TupleSections #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE TypeApplications #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeInType #-}+{-# OPTIONS -Wno-orphans #-}+ module Graphics.UI.Threepenny.Editors.Profunctor   ( -- * Editors     Base.Editor(..)@@ -20,13 +32,21 @@   , editorEnumBounded   , editorSum   , editorJust+    -- ** Generic editors+  , editorGeneric+  , editorGenericSimple   -- * Reexports   , Compose(..)   )where +import           Data.Bifunctor+import           Data.Default import           Data.Functor.Compose import           Data.Functor.Identity+import           Data.Maybe import           Data.Profunctor+import           Data.Proxy+import           Generics.SOP hiding (Compose) import           Graphics.UI.Threepenny.Core import qualified Graphics.UI.Threepenny.Editors.Base as Base @@ -46,6 +66,8 @@  class Editable a where   editor :: EditorFactory a a+  default editor :: (Generic a, HasDatatypeInfo a, (All (All Editable `And` All Default) (Code a))) => EditorFactory a a+  editor = editorGeneric  infixl 4 |*|, -*- infixl 5 |*, *|, -*, *-@@ -108,3 +130,115 @@  instance Editable a => Editable (Identity a) where   editor = dimap Identity runIdentity editor++{--------------------------------------------+  Generic derivations+---------------------------------------------}++editorGenericSimple+  :: forall a xs.+     (Generic a, HasDatatypeInfo a, All Editable xs, Code a ~ '[xs])+  => EditorFactory a a+editorGenericSimple = dimap from to $ editorGenericSimple' (datatypeInfo(Proxy @ a))++editorGenericSimple'+  :: forall xs.+     (All Editable xs)+  => DatatypeInfo '[xs] -> EditorFactory (SOP I '[xs]) (SOP I '[xs])+editorGenericSimple' (ADT _ _ (c :* Nil)) = constructorEditorFor c+editorGenericSimple' (Newtype _ _ c) = constructorEditorFor c++constructorEditorFor+  :: (All Editable xs)+  => ConstructorInfo xs+  -> EditorFactory (SOP I '[xs]) (SOP I '[xs])+constructorEditorFor (Record _ fields) = dimap (unZ . unSOP) (SOP . Z) $ constructorEditorFor' fields+constructorEditorFor (Constructor _) = dimap (unZ . unSOP) (SOP . Z) editor+constructorEditorFor Infix{} = dimap (unZ . unSOP) (SOP . Z) editor++editorGeneric+  :: forall a .+     (Generic a, HasDatatypeInfo a, (All (All Editable `And` All Default) (Code a)))+  => EditorFactory a a+editorGeneric = dimap from to $ editorGeneric' (datatypeInfo(Proxy @ a))++editorGeneric'+  :: forall xx.+     (All (All Editable `And` All Default) xx)+  => DatatypeInfo xx -> EditorFactory (SOP I xx) (SOP I xx)+editorGeneric' (ADT _ _ (c :* Nil)) = constructorEditorFor c+editorGeneric' (ADT _ _ cc) = editorSum editors constructor where+  editors :: [(Tag, EditorFactory (SOP I xx) (SOP I xx))]+  editors = map (first Tag) $ constructorEditorsFor cc+  constructors = hmap (K . constructorName) cc+  constructor a = Tag $ hcollapse $ hliftA2 const constructors (unSOP a)+editorGeneric' (Newtype _ _ c) = constructorEditorFor c++newtype Tag = Tag String deriving (Eq, Ord)+instance Show Tag where show (Tag t) = t++constructorEditorsFor+  :: forall xx . (All (All Editable `And` All Default) xx)+  => NP ConstructorInfo xx -> [(String, EditorFactory (SOP I xx) (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)++constructorEditorForUnion+  :: (SListI xx, All Editable xs, All Default xs)+  => ConstructorInfo xs+  -> Injection (NP I) xx xs+  -> Projection (Compose Maybe (NP I)) xx xs+  -> K (EditorFactory (SOP I xx) (SOP I xx)) xs+constructorEditorForUnion (Constructor _) inj prj = K $ composeEditorFactory inj prj editor+constructorEditorForUnion Infix{} inj prj = K $ composeEditorFactory inj prj editor+constructorEditorForUnion (Record _ fields) inj prj = K $ composeEditorFactory inj prj $ constructorEditorFor' fields++composeEditorFactory+  :: forall xss xs.+    (SListI xss, All Default xs) =>+     Injection (NP I) xss xs+  -> Projection (Compose Maybe (NP I)) xss xs+  -> EditorFactory (NP I xs) (NP I xs)+  -> EditorFactory (SOP I xss) (SOP I xss)+composeEditorFactory (Fn inj) (Fn prj) = dimap 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++constructorEditorFor' :: (SListI xs, All Editable xs) => NP FieldInfo xs -> EditorFactory (NP I xs) (NP I xs)+constructorEditorFor' fields = unVEF $ hsequence $ hliftA VEF $ fieldsEditor (hliftA (K . fieldName) fields)++-- | Tuple editor without fields+instance All Editable xs => Editable (NP I xs) where+  editor = unHEF $ hsequence $ hliftA HEF tupleEditor++tupleEditor :: forall xs . All Editable xs => NP (EditorFactory (NP I xs)) xs+tupleEditor = go id sList where+  go :: forall ys. All Editable ys => (forall f . NP f xs -> NP f ys) -> SList ys -> NP (EditorFactory (NP I xs)) ys+  go _ SNil = Nil+  go f SCons = lmap (unI . hd . f) editor :* go (tl . f) sList++fieldsEditor :: forall xs . All Editable xs => NP (K String) xs -> NP (EditorFactory (NP I xs)) xs+fieldsEditor = go id sList where+  go :: forall ys. All Editable ys => (forall f . NP f xs -> NP f ys) -> SList ys -> NP (K String) ys -> NP (EditorFactory (NP I xs)) ys+  go _ SNil Nil = Nil+  go f SCons (K fn :* xs) = field fn (unI . hd . f) editor :* go (tl . f) sList xs++-- | EditorFactory with an Applicative instance for vertical composition+newtype VEF a b = VEF {unVEF :: EditorFactory a b} deriving (Functor, Profunctor)+instance Applicative (VEF a) where+  pure x = VEF $ const x <$> editorUnit+  VEF a <*> VEF b = VEF (a -*- b)++-- | EditorFactory with an Applicative instance for horizontal composition+newtype HEF a b = HEF {unHEF :: EditorFactory a b} deriving (Functor, Profunctor)+instance Applicative (HEF a) where+  pure x = HEF $ const x <$> editorUnit+  HEF a <*> HEF b = HEF (a |*| b)++instance (Applicative f, All Default xs) => Default (NP f xs) where+  def = hcpure (Proxy @ Default) (pure def)

@@ -3,7 +3,7 @@ -- see: https://github.com/sol/hpack  name:           threepenny-editors-version:        0.2.0.4+version:        0.2.0.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.@@ -23,6 +23,7 @@ cabal-version:  >= 1.10  extra-source-files:+    CHANGELOG.md     README.md  flag buildExamples@@ -36,6 +37,8 @@   ghc-options: -Wall -Wno-name-shadowing   build-depends:       base >= 4.7 && < 5+    , data-default+    , generics-sop     , profunctors     , threepenny-gui > 0.7   exposed-modules:@@ -54,6 +57,8 @@   if flag(buildExamples)     build-depends:         base+      , data-default+      , generics-sop       , profunctors       , threepenny-gui       , threepenny-editors