module Glazier.Example where
import Control.Category
import Control.Lens
import Control.Monad.Reader
import Data.List
import Data.Semigroup
import Glazier
import Prelude hiding (id, (.))
newtype Action a = Action { getAction :: a }
class AsAction s a | s -> a where
_Action :: Prism' s (Action a)
instance AsAction (Action a) a where
_Action = id
newtype ConsAction a = ConsAction { getConsAction :: a }
class AsConsAction s a | s -> a where
_ConsAction :: Prism' s (ConsAction a)
instance AsConsAction (ConsAction a) a where
_ConsAction = id
data Reset = Reset
class AsReset s where
_Reset :: Prism' s Reset
instance AsReset Reset where
_Reset = id
data Tail = Tail
class AsTail s where
_Tail :: Prism' s Tail
instance AsTail Tail where
_Tail = id
newtype Set a = Set { getSet :: a }
class AsSet s a | s -> a where
_Set :: Prism' s (Set a)
instance AsSet (Set a) a where
_Set = id
optionalExample ::
( Monoid c
, Monoid r
, Semigroup c
, Semigroup r
, AsSet a s
, AsReset a
, AsAction a (Maybe s -> Maybe s)
, Monad m
)
=> Prism' a a' -> Widget v m r a' s m c -> Widget v m r a (Maybe s) m c
optionalExample p w =
(
implant _Just
>>> dispatch p
) w
<> statically mempty
<> dynamically
( dispatch _Set (review _GadgetT $ \a _ -> pure (mempty, Just $ getSet a))
<> dispatch _Action (review _GadgetT $ \(Action f) s -> pure (mempty, f s))
<> dispatch _Reset (review _GadgetT $ \_ _ -> pure (mempty, Nothing))
)
listExample ::
( Monoid r
, Monoid c
, Semigroup r
, Semigroup c
, AsTail a
, AsConsAction a s
, AsAction a ([s] -> [s])
, Monad m
)
=> Prism' b a -> Widget v m r a s m c -> Widget v m [r] b [s] m c
listExample p (Widget (WindowT d) g) =
statically (WindowT . ReaderT $ \ss -> do
let ms = runReaderT d <$> ss
sequenceA ms)
<> dynamically
( implant (ix 0) g
<> dispatch _Tail (review _GadgetT $ \_ s -> pure (mempty, tail s))
<> dispatch _ConsAction (review _GadgetT $ \(ConsAction a) s -> pure (mempty, a : s))
<> dispatch _Action (review _GadgetT $ \(Action f) s -> pure (mempty, f s))
)
& dispatch p
indexedExample ::
( Monoid r
, Monoid c
, Monoid (t r)
, Field2 b b a a
, Field1 b b (Index (t s)) (Index (t s))
, Ixed (t s)
, Semigroup r
, Semigroup c
, Semigroup (t r)
, AsAction b (t s -> t s)
, IxValue (t s) ~ s
, Monad m
, Traversable t
)
=> Widget v m r a s m c -> Widget v m (t r) b (t s) m c
indexedExample (Widget (WindowT d) g) =
statically (WindowT . ReaderT $ \ss -> do
let ms = runReaderT d <$> ss
sequenceA ms)
<>
dynamically
(
(do
x <- ask
let k = x ^. _1
zoom (ix k) (magnify _2 g)
)
<>
dispatch _Action (review _GadgetT $ \(Action f) s -> pure (mempty, f s))
)