module Graphics.UI.Threepenny.Editors.Profunctor
(
Base.Editor(..)
, Base.edited
, Base.contents
, EditorFactory
, createEditor
, Editable(..)
, (|*|), (|*), (*|)
, (-*-), (-*), (*-)
, field
, editorUnit
, editorReadShow
, editorEnumBounded
, editorSum
, editorJust
, Compose(..)
)where
import Data.Functor.Compose
import Data.Profunctor
import Graphics.UI.Threepenny.Core
import qualified Graphics.UI.Threepenny.Editors.Base as Base
newtype EditorFactory a b = EditorFactory
{ run :: Behavior a -> Compose UI Base.Editor b
}
createEditor :: EditorFactory b a -> Behavior b -> UI (Base.Editor a)
createEditor e b = getCompose $ run e b
instance Functor (EditorFactory a) where
fmap = dimap id
instance Profunctor EditorFactory where
dimap g h (EditorFactory f) = EditorFactory $ \b -> h <$> f (g <$> b)
class Editable a where
editor :: EditorFactory a a
infixl 4 |*|, -*-
infixl 5 |*, *|, -*, *-
(|*|) :: EditorFactory s (b->a) -> EditorFactory s b -> EditorFactory s a
a |*| b = EditorFactory $ \s -> run a s Base.|*| run b s
(|*) :: EditorFactory s a -> UI Element -> EditorFactory s a
a |* e = EditorFactory $ \s -> run a s Base.|* e
(*|) :: UI Element -> EditorFactory s a -> EditorFactory s a
e *| a = EditorFactory $ \s -> e Base.*| run a s
(-*-) :: EditorFactory s (b->a) -> EditorFactory s b -> EditorFactory s a
a -*- b = EditorFactory $ \s -> run a s Base.-*- run b s
(-*) :: EditorFactory s a -> UI Element -> EditorFactory s a
a -* e = EditorFactory $ \s -> run a s Base.-* e
(*-) :: UI Element -> EditorFactory s a -> EditorFactory s a
e *- a = EditorFactory $ \s -> e Base.*- run a s
field :: String -> (out -> inn) -> EditorFactory inn a -> EditorFactory out a
field name f e = string name *| lmap f e
editorUnit :: EditorFactory a ()
editorUnit = EditorFactory $ \_ -> Base.editor (pure ())
editorReadShow :: (Read a, Show a) => EditorFactory (Maybe a) (Maybe a)
editorReadShow = EditorFactory Base.editorReadShow
editorEnumBounded
:: (Show a, Ord a, Enum a, Bounded a)
=> Behavior (a -> UI Element) -> EditorFactory (Maybe a) (Maybe a )
editorEnumBounded display = EditorFactory $ Base.editorEnumBounded display
editorJust :: EditorFactory (Maybe a) (Maybe a) -> EditorFactory a a
editorJust e = EditorFactory $ Base.editorJust (run e)
editorSum
:: (Show tag, Ord tag)
=> [(tag, EditorFactory b b)] -> (b -> tag) -> EditorFactory b b
editorSum nested tagger = EditorFactory $ \b ->
let nested' = [ (tag, run f b) | (tag, f) <- nested ]
in Base.editorSum nested' tagger b
instance Editable () where editor = EditorFactory Base.editor
instance Editable String where editor = EditorFactory Base.editor
instance Editable Bool where editor = EditorFactory Base.editor
instance Editable Int where editor = EditorFactory Base.editor
instance Editable Double where editor = EditorFactory Base.editor
instance Editable (Maybe Int) where editor = EditorFactory Base.editor
instance Editable (Maybe Double) where editor = EditorFactory Base.editor
instance (Editable a, Editable b) => Editable (a,b) where
editor = (,) <$> lmap fst editor |*| lmap snd editor