glazier 0.5.0.0 → 0.6.0.0

raw patch · 5 files changed

+165/−49 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• glazier.cabal +1/−1
• src/Glazier.hs +20/−18
• src/Glazier/Example.hs +7/−7
• src/Glazier/Lazy.hs +70/−12
• src/Glazier/Strict.hs +67/−11

@@ -1,5 +1,5 @@ name:                glazier-version:             0.5.0.0+version:             0.6.0.0 synopsis:            Composable widgets framework description:         Please see README.md homepage:            https://github.com/louispan/glazier#readme

@@ -37,8 +37,8 @@ -- * 'implant' is used to modify the model type. module Glazier     ( Window(..)-    , _WindowT-    , _WindowT'+    , _Window+    , _Window'     , hoistWindow     , Implanted     , Implant(..)@@ -85,17 +85,13 @@  makeWrapped ''Window --- | lens 4.15.1 doesn't have a general enough ReaderT iso-_WrappingReaderT :: Iso (ReaderT r m a) (ReaderT r' m' a') (r -> m a) (r' -> m' a')-_WrappingReaderT = iso runReaderT ReaderT- -- | NB lift can be simulated: -- liftWindow :: (MonadTrans t, Monad m) => Window m s v -> Window (t m) s v -- liftWindow = hoistWindow lift hoistWindow :: (Monad m) => (forall a. m a -> n a) -> Window m s v -> Window n s v hoistWindow g = _Wrapping Window %~ hoist g --- | This in conjuction with Wrapped instance gives the following functions:+-- | This Iso gives the following functions: -- liftWindow :: (MonadTrans t, Monad m) => Window m s v -> Window (t m) s v -- liftWindow = hoistWindow lift --@@ -106,16 +102,22 @@ -- overWindow f = _Unwrapping Window %~ f -- -- belowWindow :: ((s -> m v) -> (s' -> m' v')) -> Window m s v -> Window m' s' v'--- belowWindow f = _WindowT %~ f+-- belowWindow f = _Window %~ f -- -- aboveWindow :: (Window m s v -> Window m' s' v') -> (s -> m v) -> (s' -> m' v')--- aboveWindow f = from _WindowT %~ f-_WindowT :: Iso (Window m s v) (Window m' s' v') (s -> m v) (s' -> m' v')-_WindowT = _Wrapping Window . iso runReaderT ReaderT -- lens 4.15.1 doesn't have a general enough ReaderT iso+-- aboveWindow f = from _Window %~ f+--+-- mkWindow' :: (s -> m v) -> Window m s v+-- mkWindow' = review _Window+--+-- runWindow' :: Window m s v -> (s -> m v)+-- runWindow' = view _Window+_Window :: Iso (Window m s v) (Window m' s' v') (s -> m v) (s' -> m' v')+_Window = _Wrapping Window . iso runReaderT ReaderT -- lens 4.15.1 doesn't have a general enough ReaderT iso  -- | Non polymorphic version of _WindowT-_WindowT' :: Iso' (Window m s v) (s -> m v)-_WindowT' = _WindowT+_Window' :: Iso' (Window m s v) (s -> m v)+_Window' = _Window  instance (Applicative m, Semigroup v) => Semigroup (Window m s v) where     (Window f) <> (Window g) = Window $ ReaderT $ \a ->@@ -127,10 +129,10 @@         mappend <$> runReaderT f a <*> runReaderT g a  instance Monad m => Profunctor (Window m) where-    dimap f g = _WindowT %~ (runKleisli . dimap f g . Kleisli)+    dimap f g = _Window %~ (runKleisli . dimap f g . Kleisli)  instance Monad m => Strong (Window m) where-    first' = _WindowT %~ (runKleisli . first' . Kleisli)+    first' = _Window %~ (runKleisli . first' . Kleisli)  instance Monad m => C.Category (Window m) where     id = Window . ReaderT $ runKleisli C.id@@ -138,13 +140,13 @@  instance Monad m => Arrow (Window m) where     arr f = Window $ ReaderT $ runKleisli $ arr f-    first = _WindowT %~ (runKleisli . first . Kleisli)+    first = _Window %~ (runKleisli . first . Kleisli)  instance Monad m => Choice (Window m) where-    left' = _WindowT %~ (runKleisli . left' . Kleisli)+    left' = _Window %~ (runKleisli . left' . Kleisli)  instance Monad m => ArrowChoice (Window m) where-    left = _WindowT %~ (runKleisli . left . Kleisli)+    left = _Window %~ (runKleisli . left . Kleisli)  instance Monad m => ArrowApply (Window m) where     app = Window . ReaderT $ \(Window (ReaderT bc), b) -> bc b

@@ -80,9 +80,9 @@      ) w   <> statically mempty -- change mempty to specify a rendering function when Nothing   <> 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))+    (  dispatch _Set    (review _Gadget $ \a _ -> pure (mempty,Just $ getSet a))+    <> dispatch _Action (review _Gadget $ \(Action f) s -> pure (mempty, f s))+    <> dispatch _Reset  (review _Gadget $ \_ _ -> pure (mempty, Nothing))     )  -- | Transforms a widget into an list widget.@@ -115,9 +115,9 @@                         pure (fold $ intersperse separator ss'))   <> dynamically     (  implant (ix 0) u -- original update will only work on the head of list-    <> 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 _Tail       (review _Gadget $ \_ s -> pure (mempty, tail s))+    <> dispatch _ConsAction (review _Gadget $ \(ConsAction a) s -> pure (mempty, a : s))+    <> dispatch _Action     (review _Gadget $ \(Action f) s -> pure (mempty, f s))     )   & dispatch p -- make original action part of a smaller action  where separator = mempty -- change mempty to specify a rendering function@@ -162,5 +162,5 @@          zoom (ix k) (magnify _2 g)        )     <>-      dispatch _Action     (review _GadgetT $ \(Action f) s -> pure (mempty, f s))+      dispatch _Action     (review _Gadget $ \(Action f) s -> pure (mempty, f s))     )

@@ -9,10 +9,14 @@  module Glazier.Lazy     ( Gadget(..)-    , _GadgetT-    , _GadgetT'+    , _Gadget+    , _Gadget'     , hoistGadget     , Widget(..)+    , _Widget+    , _Widget'+    , _WrappingWidget+    , _WrappingWidget'     , hoistWidget     , HasWindow(..)     , HasGadget(..)@@ -28,7 +32,7 @@ import Control.Monad.Fix (MonadFix) import Control.Monad.Morph import Control.Monad.Reader-import Control.Monad.State.Lazy+import Control.Monad.State.Strict import Data.Functor.Apply import Data.Maybe import Data.Profunctor@@ -62,7 +66,7 @@ hoistGadget :: (Monad m) => (forall b. m b -> n b) -> Gadget s m a c -> Gadget s n a c hoistGadget g = _Wrapping Gadget %~ hoist (hoist g) --- | This in conjuction with Wrapped instance gives the following functions:+-- | This Iso gives the following functions: -- underGadget :: (ReaderT a (StateT s m) c -> ReaderT a' (StateT s' m') c') -> Gadget s m a c -> Gadget s' m' a' c' -- underGadget f = _Wrapping Gadget %~ f --@@ -70,16 +74,22 @@ -- overGadget f = _Unwrapping Gadget %~ f -- -- belowGadget :: (a -> s -> m (c, s)) (a' -> s' -> m' (c', s')) -> Gadget s m a c -> Gadget s' m' a' c'--- belowGadget f = _GadgetT %~ f+-- belowGadget f = _Gadget %~ f -- -- aboveGadget :: (Gadget s m a c -> Gadget s' m' a' c') -> (a -> s -> m (c, s)) (a' -> s' -> m' (c', s'))--- aboveGadget f = from _GadgetT %~ f-_GadgetT :: Iso (Gadget s m a c) (Gadget s' m' a' c') (a -> s -> m (c, s)) (a' -> s' -> m' (c', s'))-_GadgetT = _Wrapping Gadget . iso runReaderT ReaderT . iso (runStateT .) (StateT .)+-- aboveGadget f = from _Gadget %~ f+--+-- mkGadget' :: (a -> s -> m (c, s)) -> Gadget s m a c+-- mkGadget' = review _Gadget+--+-- runGadget' :: Gadget s m a c -> (a -> s -> m (c, s))+-- runGadget' = view _Gadget+_Gadget :: Iso (Gadget s m a c) (Gadget s' m' a' c') (a -> s -> m (c, s)) (a' -> s' -> m' (c', s'))+_Gadget = _Wrapping Gadget . iso runReaderT ReaderT . iso (runStateT .) (StateT .) --- | Non polymorphic version of _GadgetT-_GadgetT' :: Iso' (Gadget s m a c) (a -> s -> m (c, s))-_GadgetT' = _GadgetT+-- | Non polymorphic version of _Gadget+_Gadget' :: Iso' (Gadget s m a c) (a -> s -> m (c, s))+_Gadget' = _Gadget  instance (Monad m, Semigroup c) => Semigroup (Gadget s m a c) where     (Gadget f) <> (Gadget g) = Gadget $ (<>) <$> f <*> g@@ -99,6 +109,7 @@ instance Monad m => C.Category (Gadget s m) where     id = Gadget $ ReaderT $ \a -> StateT $ \s -> pure (a, s)     Gadget (ReaderT bc) . Gadget (ReaderT ab) = Gadget $ ReaderT $ \a -> StateT $ \s -> do+        -- This line is the main difference between Strict and Lazy versions         ~(b, s') <- runStateT (ab a) s         runStateT (bc b) s' @@ -109,6 +120,7 @@ instance Monad m => Choice (Gadget s m) where     left' (Gadget (ReaderT bc)) = Gadget $ ReaderT $ \db -> StateT $ \s -> case db of         Left b -> do+            -- This line is the main difference between Strict and Lazy versions             ~(c, s') <- runStateT (bc b) s             pure (Left c, s')         Right d -> pure (Right d, s)@@ -155,11 +167,55 @@  makeFields ''Widget +-- | This Iso gives the following functions:+-- belowWidget :: ((s -> m v, a -> s -> m (c, s)) -> (s' -> m' v', a' -> s' -> m' (c', s'))) -> Widget s v m a c -> Widget s' v' m' a' c'+-- belowWidget f = _Widget %~ f+--+-- aboveWidget :: (Widget s v m a c -> Widget s' v' m' a' c') -> (s -> m v, a -> s -> m (c, s)) -> (s' -> m' v', a' -> s' -> m' (c', s'))+-- aboveWidget f = from _Widget %~ f+--+-- mkWidget' :: (s -> m v, a -> s -> m (c, s)) -> Widget s v m a c+-- mkWidget' = review _Widget+--+-- runWidget' :: Widget s v m a c -> (s -> m v, a -> s -> m (c, s))+-- runWidget' = view _Widget+--+_Widget :: Iso (Widget s v m a c) (Widget s' v' m' a' c')+           (s -> m v, a -> s -> m (c, s)) (s' -> m' v', a' -> s' -> m' (c', s'))+_Widget = iso (\(Widget w g) -> (view _Window w, view _Gadget g))+               (\(w, g) -> Widget (review _Window w) (review _Gadget g))++-- | This Iso gives the following functions:+-- underWidget :: ((Window m s v, Gadget s m a c) -> (Window m' s' v', Gadget s' m' a' c')) -> Widget s v m a c -> Widget s' v' m' a' c'+-- underWidget f = _WrappingWidget %~ f+--+-- overWidget :: (Widget s v m a c -> Widget s' v' m' a' c') -> (Window m s v, Gadget s m a c) -> (Window m' s' v', Gadget s' m' a' c')+-- overWidget f = from _WrappingWidget %~ f+--+-- mkWidget :: (Window m s v, Gadget s m a c) -> Widget s v m a c+-- mkWidget = review _WrappingWidget+--+-- runWidget :: Widget s v m a c -> (Window m s v, Gadget s m a c)+-- runWidget = view _WrappingWidget+_WrappingWidget :: Iso (Widget s v m a c) (Widget s' v' m' a' c')+           (Window m s v, Gadget s m a c) (Window m' s' v', Gadget s' m' a' c')+_WrappingWidget = iso (\(Widget w g) -> (w, g))+               (\(w, g) -> Widget w g)++-- | Non polymorphic version of _WrappingWidget+_WrappingWidget' :: Iso' (Widget s v m a c) (Window m s v, Gadget s m a c)+_WrappingWidget' = _WrappingWidget++-- | Non polymorphic version of _Widget+_Widget' :: Iso' (Widget s v m a c) (s -> m v, a -> s -> m (c, s))+_Widget' = _Widget+ -- | NB lift can be simulated: -- liftWidget :: (MonadTrans t, Monad m) => Widget s v m a c -> Widget s v (t m) a c -- liftWidget = hoistWidget lift hoistWidget :: (Monad m) => (forall x. m x -> n x) -> Widget s v m a c -> Widget s v n a c-hoistWidget f (Widget w g) = Widget (hoistWindow f w) (hoistGadget f g)+-- hoistWidget f (Widget w g) = Widget (hoistWindow f w) (hoistGadget f g)+hoistWidget f = _WrappingWidget %~ \(w, g) -> (hoistWindow f w, hoistGadget f g)  instance (Monad m, Semigroup c, Semigroup v) => Semigroup (Widget s v m a c) where     w1 <> w2 = Widget@@ -245,6 +301,8 @@   implant l w = Widget     (implant (sndLensLike l) $ widgetWindow w)     (implant (fstLensLike l) $ widgetGadget w)++-- -------------------------------------------------------------------------------  -- | This can be used to hold two LensLike functors. -- The inner LensLike functor can be extracted from a @LensLike (PairMaybeFunctor f g) s t a b@

@@ -9,10 +9,14 @@  module Glazier.Strict     ( Gadget(..)-    , _GadgetT-    , _GadgetT'+    , _Gadget+    , _Gadget'     , hoistGadget     , Widget(..)+    , _Widget+    , _Widget'+    , _WrappingWidget+    , _WrappingWidget'     , hoistWidget     , HasWindow(..)     , HasGadget(..)@@ -62,7 +66,7 @@ hoistGadget :: (Monad m) => (forall b. m b -> n b) -> Gadget s m a c -> Gadget s n a c hoistGadget g = _Wrapping Gadget %~ hoist (hoist g) --- | This in conjuction with Wrapped instance gives the following functions:+-- | This Iso gives the following functions: -- underGadget :: (ReaderT a (StateT s m) c -> ReaderT a' (StateT s' m') c') -> Gadget s m a c -> Gadget s' m' a' c' -- underGadget f = _Wrapping Gadget %~ f --@@ -70,16 +74,22 @@ -- overGadget f = _Unwrapping Gadget %~ f -- -- belowGadget :: (a -> s -> m (c, s)) (a' -> s' -> m' (c', s')) -> Gadget s m a c -> Gadget s' m' a' c'--- belowGadget f = _GadgetT %~ f+-- belowGadget f = _Gadget %~ f -- -- aboveGadget :: (Gadget s m a c -> Gadget s' m' a' c') -> (a -> s -> m (c, s)) (a' -> s' -> m' (c', s'))--- aboveGadget f = from _GadgetT %~ f-_GadgetT :: Iso (Gadget s m a c) (Gadget s' m' a' c') (a -> s -> m (c, s)) (a' -> s' -> m' (c', s'))-_GadgetT = _Wrapping Gadget . iso runReaderT ReaderT . iso (runStateT .) (StateT .)+-- aboveGadget f = from _Gadget %~ f+--+-- mkGadget' :: (a -> s -> m (c, s)) -> Gadget s m a c+-- mkGadget' = review _Gadget+--+-- runGadget' :: Gadget s m a c -> (a -> s -> m (c, s))+-- runGadget' = view _Gadget+_Gadget :: Iso (Gadget s m a c) (Gadget s' m' a' c') (a -> s -> m (c, s)) (a' -> s' -> m' (c', s'))+_Gadget = _Wrapping Gadget . iso runReaderT ReaderT . iso (runStateT .) (StateT .) --- | Non polymorphic version of _GadgetT-_GadgetT' :: Iso' (Gadget s m a c) (a -> s -> m (c, s))-_GadgetT' = _GadgetT+-- | Non polymorphic version of _Gadget+_Gadget' :: Iso' (Gadget s m a c) (a -> s -> m (c, s))+_Gadget' = _Gadget  instance (Monad m, Semigroup c) => Semigroup (Gadget s m a c) where     (Gadget f) <> (Gadget g) = Gadget $ (<>) <$> f <*> g@@ -99,6 +109,7 @@ instance Monad m => C.Category (Gadget s m) where     id = Gadget $ ReaderT $ \a -> StateT $ \s -> pure (a, s)     Gadget (ReaderT bc) . Gadget (ReaderT ab) = Gadget $ ReaderT $ \a -> StateT $ \s -> do+        -- This line is the main difference between Strict and Lazy versions         (b, s') <- runStateT (ab a) s         runStateT (bc b) s' @@ -109,6 +120,7 @@ instance Monad m => Choice (Gadget s m) where     left' (Gadget (ReaderT bc)) = Gadget $ ReaderT $ \db -> StateT $ \s -> case db of         Left b -> do+            -- This line is the main difference between Strict and Lazy versions             (c, s') <- runStateT (bc b) s             pure (Left c, s')         Right d -> pure (Right d, s)@@ -155,11 +167,55 @@  makeFields ''Widget +-- | This Iso gives the following functions:+-- belowWidget :: ((s -> m v, a -> s -> m (c, s)) -> (s' -> m' v', a' -> s' -> m' (c', s'))) -> Widget s v m a c -> Widget s' v' m' a' c'+-- belowWidget f = _Widget %~ f+--+-- aboveWidget :: (Widget s v m a c -> Widget s' v' m' a' c') -> (s -> m v, a -> s -> m (c, s)) -> (s' -> m' v', a' -> s' -> m' (c', s'))+-- aboveWidget f = from _Widget %~ f+--+-- mkWidget' :: (s -> m v, a -> s -> m (c, s)) -> Widget s v m a c+-- mkWidget' = review _Widget+--+-- runWidget' :: Widget s v m a c -> (s -> m v, a -> s -> m (c, s))+-- runWidget' = view _Widget+--+_Widget :: Iso (Widget s v m a c) (Widget s' v' m' a' c')+           (s -> m v, a -> s -> m (c, s)) (s' -> m' v', a' -> s' -> m' (c', s'))+_Widget = iso (\(Widget w g) -> (view _Window w, view _Gadget g))+               (\(w, g) -> Widget (review _Window w) (review _Gadget g))++-- | This Iso gives the following functions:+-- underWidget :: ((Window m s v, Gadget s m a c) -> (Window m' s' v', Gadget s' m' a' c')) -> Widget s v m a c -> Widget s' v' m' a' c'+-- underWidget f = _WrappingWidget %~ f+--+-- overWidget :: (Widget s v m a c -> Widget s' v' m' a' c') -> (Window m s v, Gadget s m a c) -> (Window m' s' v', Gadget s' m' a' c')+-- overWidget f = from _WrappingWidget %~ f+--+-- mkWidget :: (Window m s v, Gadget s m a c) -> Widget s v m a c+-- mkWidget = review _WrappingWidget+--+-- runWidget :: Widget s v m a c -> (Window m s v, Gadget s m a c)+-- runWidget = view _WrappingWidget+_WrappingWidget :: Iso (Widget s v m a c) (Widget s' v' m' a' c')+           (Window m s v, Gadget s m a c) (Window m' s' v', Gadget s' m' a' c')+_WrappingWidget = iso (\(Widget w g) -> (w, g))+               (\(w, g) -> Widget w g)++-- | Non polymorphic version of _WrappingWidget+_WrappingWidget' :: Iso' (Widget s v m a c) (Window m s v, Gadget s m a c)+_WrappingWidget' = _WrappingWidget++-- | Non polymorphic version of _Widget+_Widget' :: Iso' (Widget s v m a c) (s -> m v, a -> s -> m (c, s))+_Widget' = _Widget+ -- | NB lift can be simulated: -- liftWidget :: (MonadTrans t, Monad m) => Widget s v m a c -> Widget s v (t m) a c -- liftWidget = hoistWidget lift hoistWidget :: (Monad m) => (forall x. m x -> n x) -> Widget s v m a c -> Widget s v n a c-hoistWidget f (Widget w g) = Widget (hoistWindow f w) (hoistGadget f g)+-- hoistWidget f (Widget w g) = Widget (hoistWindow f w) (hoistGadget f g)+hoistWidget f = _WrappingWidget %~ \(w, g) -> (hoistWindow f w, hoistGadget f g)  instance (Monad m, Semigroup c, Semigroup v) => Semigroup (Widget s v m a c) where     w1 <> w2 = Widget