glazier 0.7.0.0 → 0.8.0.0

raw patch · 7 files changed

+114/−113 lines, 7 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• glazier.cabal +1/−1
• src/Glazier/Example.hs +3/−3
• src/Glazier/Gadget/Lazy.hs +0/−6
• src/Glazier/Gadget/Strict.hs +0/−6
• src/Glazier/Widget/Lazy.hs +55/−46
• src/Glazier/Widget/Strict.hs +55/−46
• src/Glazier/Window.hs +0/−5

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

@@ -71,7 +71,7 @@   , AsAction a (Maybe s -> Maybe s)   , Monad m   )-  => Prism' a a' -> Widget s v m a' c -> Widget (Maybe s) v m a c+  => Prism' a a' -> Widget m s v m a' c -> Widget m (Maybe s) v m a c optionalExample p w =      (      implant _Just -- original update will only work if model is Just@@ -105,7 +105,7 @@   , AsAction a ([s] -> [s])   , Monad m   )-  => Prism' b a -> Widget s v m a c -> Widget [s] v m b c+  => Prism' b a -> Widget m s v m a c -> Widget m [s] v m b c listExample p (Widget (Window d) u) =      -- Create a list rendering function by      -- interspercing the separator with the View from the original widget.@@ -141,7 +141,7 @@   , Monad m   , Traversable t   )-  => Widget s v m a c -> Widget (t s) v m b c+  => Widget m s v m a c -> Widget m (t s) v m b c indexedExample (Widget (Window d) g) =      -- Create a rendering function by folding the original view function      statically (Window . ReaderT $ \ss -> do

@@ -41,12 +41,6 @@                , MonadIO                ) -class HasGadget s a | s -> a where-  gadget :: Lens' s a--instance HasGadget (Gadget s m a c) (Gadget s m a c) where-  gadget = id- makeWrapped ''Gadget  -- | NB lift can be simulated:

@@ -41,12 +41,6 @@                , MonadIO                ) -class HasGadget s a | s -> a where-  gadget :: Lens' s a--instance HasGadget (Gadget s m a c) (Gadget s m a c) where-  gadget = id- makeWrapped ''Gadget  -- | NB lift can be simulated:

@@ -1,3 +1,5 @@+{-# LANGUAGE MonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -9,11 +11,12 @@  module Glazier.Widget.Lazy     ( Widget(..)+    , _gadget+    , _window     , _Widget     , _Widget'     , _WrappingWidget     , _WrappingWidget'-    , hoistWidget     , statically     , dynamically     ) where@@ -30,14 +33,28 @@ import Glazier.Gadget.Lazy import Glazier.Window --- | A widget is basically a tuple with Gadget and Window.-data Widget s v m a c = Widget-  { widgetWindow :: Window m s v-  , widgetGadget :: Gadget s m a c+-- | A widget is basically a tuple with Gadget and Window, but with handy instances for implant and dispatch.+data Widget m s v n a c = Widget+  { window :: Window m s v+  , gadget :: Gadget s n a c   } -makeFields ''Widget+-- | polymorphic lens to the window of a widget+_window :: Lens (Widget m s v n a c) (Widget m' s v' n a c) (Window m s v) (Window m' s v')+_window = lens window (\(Widget _ g) w -> Widget w g) +-- | polymorphic lens to the gadget of a widget+_gadget :: Lens (Widget m s v n a c) (Widget m s v n' a' c') (Gadget s n a c) (Gadget s n' a' c')+_gadget = lens gadget (\(Widget w _) g -> Widget w g)++-- | non polymorphic lens to the window of a widget+_window' :: Lens' (Widget m s v n a c) (Window m s v)+_window' = _window++-- | non polymorphic lens to the gadget of a widget+_gadget' :: Lens' (Widget m s v n a c) (Gadget s n a c)+_gadget' = _gadget+ -- | This Iso gives the following functions: -- -- @@@ -54,8 +71,8 @@ -- 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 m s v n a c) (Widget m' s' v' n' a' c')+           (s -> m v, a -> s -> n (c, s)) (s' -> m' v', a' -> s' -> n' (c', s')) _Widget = iso (\(Widget w g) -> (view _Window w, view _Gadget g))                (\(w, g) -> Widget (review _Window w) (review _Gadget g)) {-# INLINABLE _Widget #-}@@ -76,43 +93,35 @@ -- 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 m s v n a c) (Widget m' s' v' n' a' c')+           (Window m s v, Gadget s n a c) (Window m' s' v', Gadget s' n' a' c') _WrappingWidget = iso (\(Widget w g) -> (w, g))                (\(w, g) -> Widget w g) {-# INLINABLE _WrappingWidget #-}  -- | Non polymorphic version of _WrappingWidget-_WrappingWidget' :: Iso' (Widget s v m a c) (Window m s v, Gadget s m a c)+_WrappingWidget' :: Iso' (Widget m s v n a c) (Window m s v, Gadget s n a c) _WrappingWidget' = _WrappingWidget {-# INLINABLE _WrappingWidget' #-}  -- | Non polymorphic version of _Widget-_Widget' :: Iso' (Widget s v m a c) (s -> m v, a -> s -> m (c, s))+_Widget' :: Iso' (Widget m s v n a c) (s -> m v, a -> s -> n (c, s)) _Widget' = _Widget {-# INLINABLE _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 = _WrappingWidget %~ \(w, g) -> (hoistWindow f w, hoistGadget f g)-{-# INLINABLE hoistWidget #-}--instance (Monad m, Semigroup c, Semigroup v) => Semigroup (Widget s v m a c) where+instance (Applicative m, Monad n, Semigroup c, Semigroup v) => Semigroup (Widget m s v n a c) where     w1 <> w2 = Widget-      (widgetWindow w1 <> widgetWindow w2)-      (widgetGadget w1 <> widgetGadget w2)+      (window w1 <> window w2)+      (gadget w1 <> gadget w2)     {-# INLINABLE (<>) #-} -instance (Monad m, Monoid c, Monoid v) => Monoid (Widget s v m a c) where+instance (Applicative m, Monad n, Monoid c, Monoid v) => Monoid (Widget m s v n a c) where     mempty = Widget mempty mempty     {-# INLINABLE mempty #-}      mappend w1 w2 = Widget-        (widgetWindow w1 `mappend` widgetWindow w2)-        (widgetGadget w1 `mappend` widgetGadget w2)+        (window w1 `mappend` window w2)+        (gadget w1 `mappend` gadget w2)     {-# INLINABLE mappend #-}  -- | Widget Functor is lawful@@ -120,7 +129,7 @@ -- (Widget w g) = Widget w (id <$> g) =  Widget w g -- 2: fmap (f . g) = fmap f . fmap g -- (Widget w gad) = Widget w ((f . g) <$> gad) = Widget w ((fmap f . fmap g) gad)-instance Functor m => Functor (Widget s v m a) where+instance Functor n => Functor (Widget m s v n a) where     fmap f (Widget w g) = Widget         w         (f <$> g)@@ -142,22 +151,22 @@ --     = Widget (uw <> mempty) (ug <*> pure y) --     = Widget (mempty <> uw) (pure ($ y) <*> ug) --     = Widget mempty (pure $y) <*> Widget uw ug-instance (Semigroup v, Monad m, Monoid v) => Applicative (Widget s v m a) where+instance (Applicative m, Monad n, Semigroup v, Monoid v) => Applicative (Widget m s v n a) where     pure c = Widget mempty (pure c)     {-# INLINABLE pure #-}      (Widget w1 fg) <*> (Widget w2 g) = Widget (w1 <> w2) (fg <*> g)     {-# INLINABLE (<*>) #-} -instance Monad m => Profunctor (Widget s v m) where+instance (Applicative m, Monad n) => Profunctor (Widget m s v n) where     dimap f g (Widget w m) = Widget w (dimap f g m)     {-# INLINABLE dimap #-} -instance Monad m => Strong (Widget s v m) where+instance (Applicative m, Monad n) => Strong (Widget m s v n) where     first' (Widget w g) = Widget w (first' g)     {-# INLINABLE first' #-} -instance (Monad m, Monoid v) => C.Category (Widget s v m) where+instance (Applicative m, Monad n, Monoid v) => C.Category (Widget m s v n) where     id = Widget mempty C.id     {-# INLINABLE id #-} @@ -168,43 +177,43 @@  -- | No monad instance for Widget is possible, however an arrow is possible. -- The Arrow instance monoidally appends the Window, and uses the inner Gadget Arrow instance.-instance (Monad m, Monoid v) => Arrow (Widget s v m) where+instance (Applicative m, Monad n, Monoid v) => Arrow (Widget m s v n) where     arr f = dimap f id C.id     {-# INLINABLE arr #-}      first = first'     {-# INLINABLE first #-} -instance (Monad m) => Choice (Widget s v m) where+instance (Applicative m, Monad n) => Choice (Widget m s v n) where     left' (Widget w bc) = Widget w (left' bc)     {-# INLINABLE left' #-} -instance (Monad m, Monoid v) => ArrowChoice (Widget s v m) where+instance (Applicative m, Monad n, Monoid v) => ArrowChoice (Widget m s v n) where     left = left'     {-# INLINABLE left #-} -statically :: (Monad m, Monoid c) => Window m s v -> Widget s v m a c+statically :: (Monad n, Monoid c) => Window m s v -> Widget m s v n a c statically w = Widget w mempty {-# INLINABLE statically #-} -dynamically :: (Monad m, Monoid v) => Gadget s m a c -> Widget s v m a c+dynamically :: (Applicative m, Monad n, Monoid v) => Gadget s n a c -> Widget m s v n a c dynamically = Widget mempty {-# INLINABLE dynamically #-} -type instance Dispatched (Widget s v m a c) = Dispatched (Gadget s m a c)-instance Monad m => Dispatch (Widget s v m a c) (Widget s v m b c) a b where+type instance Dispatched (Widget m s v n a c) = Dispatched (Gadget s n a c)+instance Monad n => Dispatch (Widget m s v n a c) (Widget m s v n b c) a b where     dispatch p w = Widget-        (widgetWindow w)-        (dispatch p $ widgetGadget w)+        (window w)+        (dispatch p $ gadget w)     {-# INLINABLE dispatch #-} -type instance Implanted (Widget s v m a c) =-     PairMaybeFunctor (Implanted (Gadget s m a c))-       (Implanted (Window m s v))-instance Monad m => Implant (Widget s v m a c) (Widget t v m a c) s t where+type instance Implanted (Widget m s v n a c) =+     PairMaybeFunctor (Implanted (Window m s v))+       (Implanted (Gadget s n a c))+instance (Monad m, Monad n) => Implant (Widget m s v n a c) (Widget m t v n a c) s t where     implant l w = Widget-        (implant (sndLensLike l) $ widgetWindow w)-        (implant (fstLensLike l) $ widgetGadget w)+        (implant (fstLensLike l) $ window w)+        (implant (sndLensLike l) $ gadget w)     {-# INLINABLE implant #-}  -- -------------------------------------------------------------------------------

@@ -1,3 +1,5 @@+{-# LANGUAGE MonomorphismRestriction #-}+{-# LANGUAGE FlexibleContexts #-} {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE FunctionalDependencies #-} {-# LANGUAGE GeneralizedNewtypeDeriving #-}@@ -9,11 +11,12 @@  module Glazier.Widget.Strict     ( Widget(..)+    , _gadget+    , _window     , _Widget     , _Widget'     , _WrappingWidget     , _WrappingWidget'-    , hoistWidget     , statically     , dynamically     ) where@@ -30,14 +33,28 @@ import Glazier.Gadget.Strict import Glazier.Window --- | A widget is basically a tuple with Gadget and Window.-data Widget s v m a c = Widget-  { widgetWindow :: Window m s v-  , widgetGadget :: Gadget s m a c+-- | A widget is basically a tuple with Gadget and Window, but with handy instances for implant and dispatch.+data Widget m s v n a c = Widget+  { window :: Window m s v+  , gadget :: Gadget s n a c   } -makeFields ''Widget+-- | polymorphic lens to the window of a widget+_window :: Lens (Widget m s v n a c) (Widget m' s v' n a c) (Window m s v) (Window m' s v')+_window = lens window (\(Widget _ g) w -> Widget w g) +-- | polymorphic lens to the gadget of a widget+_gadget :: Lens (Widget m s v n a c) (Widget m s v n' a' c') (Gadget s n a c) (Gadget s n' a' c')+_gadget = lens gadget (\(Widget w _) g -> Widget w g)++-- | non polymorphic lens to the window of a widget+_window' :: Lens' (Widget m s v n a c) (Window m s v)+_window' = _window++-- | non polymorphic lens to the gadget of a widget+_gadget' :: Lens' (Widget m s v n a c) (Gadget s n a c)+_gadget' = _gadget+ -- | This Iso gives the following functions: -- -- @@@ -54,8 +71,8 @@ -- 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 m s v n a c) (Widget m' s' v' n' a' c')+           (s -> m v, a -> s -> n (c, s)) (s' -> m' v', a' -> s' -> n' (c', s')) _Widget = iso (\(Widget w g) -> (view _Window w, view _Gadget g))                (\(w, g) -> Widget (review _Window w) (review _Gadget g)) {-# INLINABLE _Widget #-}@@ -76,43 +93,35 @@ -- 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 m s v n a c) (Widget m' s' v' n' a' c')+           (Window m s v, Gadget s n a c) (Window m' s' v', Gadget s' n' a' c') _WrappingWidget = iso (\(Widget w g) -> (w, g))                (\(w, g) -> Widget w g) {-# INLINABLE _WrappingWidget #-}  -- | Non polymorphic version of _WrappingWidget-_WrappingWidget' :: Iso' (Widget s v m a c) (Window m s v, Gadget s m a c)+_WrappingWidget' :: Iso' (Widget m s v n a c) (Window m s v, Gadget s n a c) _WrappingWidget' = _WrappingWidget {-# INLINABLE _WrappingWidget' #-}  -- | Non polymorphic version of _Widget-_Widget' :: Iso' (Widget s v m a c) (s -> m v, a -> s -> m (c, s))+_Widget' :: Iso' (Widget m s v n a c) (s -> m v, a -> s -> n (c, s)) _Widget' = _Widget {-# INLINABLE _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 = _WrappingWidget %~ \(w, g) -> (hoistWindow f w, hoistGadget f g)-{-# INLINABLE hoistWidget #-}--instance (Monad m, Semigroup c, Semigroup v) => Semigroup (Widget s v m a c) where+instance (Applicative m, Monad n, Semigroup c, Semigroup v) => Semigroup (Widget m s v n a c) where     w1 <> w2 = Widget-      (widgetWindow w1 <> widgetWindow w2)-      (widgetGadget w1 <> widgetGadget w2)+      (window w1 <> window w2)+      (gadget w1 <> gadget w2)     {-# INLINABLE (<>) #-} -instance (Monad m, Monoid c, Monoid v) => Monoid (Widget s v m a c) where+instance (Applicative m, Monad n, Monoid c, Monoid v) => Monoid (Widget m s v n a c) where     mempty = Widget mempty mempty     {-# INLINABLE mempty #-}      mappend w1 w2 = Widget-        (widgetWindow w1 `mappend` widgetWindow w2)-        (widgetGadget w1 `mappend` widgetGadget w2)+        (window w1 `mappend` window w2)+        (gadget w1 `mappend` gadget w2)     {-# INLINABLE mappend #-}  -- | Widget Functor is lawful@@ -120,7 +129,7 @@ -- (Widget w g) = Widget w (id <$> g) =  Widget w g -- 2: fmap (f . g) = fmap f . fmap g -- (Widget w gad) = Widget w ((f . g) <$> gad) = Widget w ((fmap f . fmap g) gad)-instance Functor m => Functor (Widget s v m a) where+instance Functor n => Functor (Widget m s v n a) where     fmap f (Widget w g) = Widget         w         (f <$> g)@@ -142,22 +151,22 @@ --     = Widget (uw <> mempty) (ug <*> pure y) --     = Widget (mempty <> uw) (pure ($ y) <*> ug) --     = Widget mempty (pure $y) <*> Widget uw ug-instance (Semigroup v, Monad m, Monoid v) => Applicative (Widget s v m a) where+instance (Applicative m, Monad n, Semigroup v, Monoid v) => Applicative (Widget m s v n a) where     pure c = Widget mempty (pure c)     {-# INLINABLE pure #-}      (Widget w1 fg) <*> (Widget w2 g) = Widget (w1 <> w2) (fg <*> g)     {-# INLINABLE (<*>) #-} -instance Monad m => Profunctor (Widget s v m) where+instance (Applicative m, Monad n) => Profunctor (Widget m s v n) where     dimap f g (Widget w m) = Widget w (dimap f g m)     {-# INLINABLE dimap #-} -instance Monad m => Strong (Widget s v m) where+instance (Applicative m, Monad n) => Strong (Widget m s v n) where     first' (Widget w g) = Widget w (first' g)     {-# INLINABLE first' #-} -instance (Monad m, Monoid v) => C.Category (Widget s v m) where+instance (Applicative m, Monad n, Monoid v) => C.Category (Widget m s v n) where     id = Widget mempty C.id     {-# INLINABLE id #-} @@ -168,43 +177,43 @@  -- | No monad instance for Widget is possible, however an arrow is possible. -- The Arrow instance monoidally appends the Window, and uses the inner Gadget Arrow instance.-instance (Monad m, Monoid v) => Arrow (Widget s v m) where+instance (Applicative m, Monad n, Monoid v) => Arrow (Widget m s v n) where     arr f = dimap f id C.id     {-# INLINABLE arr #-}      first = first'     {-# INLINABLE first #-} -instance (Monad m) => Choice (Widget s v m) where+instance (Applicative m, Monad n) => Choice (Widget m s v n) where     left' (Widget w bc) = Widget w (left' bc)     {-# INLINABLE left' #-} -instance (Monad m, Monoid v) => ArrowChoice (Widget s v m) where+instance (Applicative m, Monad n, Monoid v) => ArrowChoice (Widget m s v n) where     left = left'     {-# INLINABLE left #-} -statically :: (Monad m, Monoid c) => Window m s v -> Widget s v m a c+statically :: (Monad n, Monoid c) => Window m s v -> Widget m s v n a c statically w = Widget w mempty {-# INLINABLE statically #-} -dynamically :: (Monad m, Monoid v) => Gadget s m a c -> Widget s v m a c+dynamically :: (Applicative m, Monad n, Monoid v) => Gadget s n a c -> Widget m s v n a c dynamically = Widget mempty {-# INLINABLE dynamically #-} -type instance Dispatched (Widget s v m a c) = Dispatched (Gadget s m a c)-instance Monad m => Dispatch (Widget s v m a c) (Widget s v m b c) a b where+type instance Dispatched (Widget m s v n a c) = Dispatched (Gadget s n a c)+instance Monad n => Dispatch (Widget m s v n a c) (Widget m s v n b c) a b where     dispatch p w = Widget-        (widgetWindow w)-        (dispatch p $ widgetGadget w)+        (window w)+        (dispatch p $ gadget w)     {-# INLINABLE dispatch #-} -type instance Implanted (Widget s v m a c) =-     PairMaybeFunctor (Implanted (Gadget s m a c))-       (Implanted (Window m s v))-instance Monad m => Implant (Widget s v m a c) (Widget t v m a c) s t where+type instance Implanted (Widget m s v n a c) =+     PairMaybeFunctor (Implanted (Window m s v))+       (Implanted (Gadget s n a c))+instance (Monad m, Monad n) => Implant (Widget m s v n a c) (Widget m t v n a c) s t where     implant l w = Widget-        (implant (sndLensLike l) $ widgetWindow w)-        (implant (fstLensLike l) $ widgetGadget w)+        (implant (fstLensLike l) $ window w)+        (implant (sndLensLike l) $ gadget w)     {-# INLINABLE implant #-}  -- -------------------------------------------------------------------------------

@@ -74,11 +74,6 @@                , MonadIO                , MonadZip                )-class HasWindow s a | s -> a where-  window :: Lens' s a--instance HasWindow (Window m s v) (Window m s v) where-  window = id  makeWrapped ''Window