packages feed

vessel 0.3.0.0 → 0.3.0.1

raw patch · 15 files changed

+224/−164 lines, 15 filesdep ~aesondep ~basedep ~base-orphansnew-uploader

Dependency ranges changed: aeson, base, base-orphans, bifunctors, commutative-semigroups, containers, mtl, these, witherable

Files

ChangeLog.md view
@@ -1,5 +1,16 @@ # Revision history for vessel +## 0.3.0.1++* Support GHC 9.8 and 9.10+* Support witherable 0.5++* Add flag for enabling/disabling tutorial build++## 0.3.0.0-r1++* Loosen reflex bounds+ ## 0.3.0.0  * Fix singleV: absent query /= present query for deleted item
README.md view
@@ -1,5 +1,5 @@ # vessel: functor-parametric containers-[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/vessel.svg)](https://hackage.haskell.org/package/vessel) [![Hackage CI](https://matrix.hackage.haskell.org/api/v2/packages/vessel/badge)](https://matrix.hackage.haskell.org/#/package/vessel) [![Github CI](https://github.com/obsidiansystems/vessel/workflows/github-action/badge.svg)](https://github.com/obsidiansystems/vessel/actions) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/obsidiansystems/vessel/blob/master/LICENSE)+[![Haskell](https://img.shields.io/badge/language-Haskell-orange.svg)](https://haskell.org) [![Hackage](https://img.shields.io/hackage/v/vessel.svg)](https://hackage.haskell.org/package/vessel) [![Github CI](https://github.com/obsidiansystems/vessel/workflows/github-action/badge.svg)](https://github.com/obsidiansystems/vessel/actions) [![BSD3 License](https://img.shields.io/badge/license-BSD3-blue.svg)](https://github.com/obsidiansystems/vessel/blob/master/LICENSE)  See the [tutorial](https://github.com/obsidiansystems/vessel/blob/develop/tutorial/Tutorial.md) for a worked example of how to use this library.
src/Data/Vessel/Class.hs view
@@ -31,6 +31,7 @@ import Data.Functor.Compose import Data.Functor.Identity import Data.GADT.Compare+import Data.Kind (Type) import Data.Map.Monoidal (MonoidalMap(..)) import Data.Maybe (fromMaybe) import Data.Proxy@@ -60,7 +61,7 @@ -- -- It also specifies the cropV operation which restricts a view to a particular selection, as well -- as operations for mapping functions over all the leaves of the container.-class View (v :: (x -> *) -> *) where+class View (v :: (x -> Type) -> Type) where   -- | Transpose a sufficiently-Map-like structure into a container, effectively aggregating   -- many structures into a single one containing information about which keys each part of it   -- came from originally.
src/Data/Vessel/DependentMap.hs view
@@ -34,6 +34,7 @@ import Data.Functor.Compose import Data.Functor.Identity import Data.GADT.Compare+import Data.Kind (Type) import Data.Patch (Group(..)) import Data.Semigroup.Commutative import Data.Set (Set)@@ -46,7 +47,7 @@ import Data.Vessel.Selectable  -- | A functor-indexed container corrresponding to DMap k v.-newtype DMapV (k :: x -> *) (v :: x -> *) g = DMapV { unDMapV :: MonoidalDMap k (g :.: v) }+newtype DMapV (k :: x -> Type) (v :: x -> Type) g = DMapV { unDMapV :: MonoidalDMap k (g :.: v) }   deriving (Generic)  deriving instance (GCompare k, Has' Eq k (g :.: v)) => Eq (DMapV k v g)
src/Data/Vessel/Identity.hs view
@@ -23,6 +23,7 @@ import Data.Functor.Compose import Data.Functor.Const import Data.Functor.Identity+import Data.Kind (Type) import Data.Patch (Group(..)) import Data.Semigroup.Commutative import Data.These@@ -33,7 +34,7 @@ import Data.Vessel.ViewMorphism  -- | A functor-indexed container corresponding to Identity. (i.e. a single non-deletable item)-newtype IdentityV (a :: *) (g :: * -> *) = IdentityV { unIdentityV :: g a }+newtype IdentityV (a :: Type) (g :: Type -> Type) = IdentityV { unIdentityV :: g a }   deriving (Eq, Ord, Show, Read, Semigroup, Monoid, Group, Commutative, Generic, ToJSON, FromJSON)  instance View (IdentityV a) where
src/Data/Vessel/Internal.hs view
@@ -34,6 +34,7 @@ import Data.Functor.Compose import Data.Functor.Const import Data.GADT.Compare+import Data.Kind (Type) import qualified Data.Map as Map' import qualified Data.Map.Merge.Strict as Map' import Data.Map.Monoidal (MonoidalMap(..))@@ -49,7 +50,7 @@ import qualified Data.Dependent.Map.Monoidal as DMap -- import qualified Data.Dependent.Map as DMap' -newtype FlipAp (g :: k) (v :: k -> *) = FlipAp { unFlipAp :: v g }+newtype FlipAp (g :: k) (v :: k -> Type) = FlipAp { unFlipAp :: v g }   deriving (Eq, Ord, Show)  ------- Instances for FlipAp -------@@ -59,7 +60,6 @@  instance Monoid (v g) => Monoid (FlipAp g v) where   mempty = FlipAp mempty-  mappend (FlipAp x) (FlipAp y) = FlipAp (mappend x y)  instance Group (v g) => Group (FlipAp g v) where   negateG (FlipAp x) = FlipAp (negateG x)@@ -68,7 +68,7 @@   -- A single Vessel key/value pair, essentially a choice of container type, together with a corresponding container.-data VSum (k :: ((x -> *) -> *) -> *) (g :: x -> *) = forall v. k v :~> v g+data VSum (k :: ((x -> Type) -> Type) -> Type) (g :: x -> Type) = forall v. k v :~> v g  ------- Serialisation ------- @@ -159,7 +159,7 @@   (l, Just v, r) -> (Map.insert k v l, r)   (l, Nothing, r) -> (l, r) -data PivotD (k :: l -> *) (g :: l -> *) = NoneD | forall v. OneD (k v) (g v) | forall v. SplitD (k v) (DMap k g) (DMap k g)+data PivotD (k :: l -> Type) (g :: l -> Type) = NoneD | forall v. OneD (k v) (g v) | forall v. SplitD (k v) (DMap k g) (DMap k g)  condenseD' :: (GCompare k, Foldable t, Filterable t)            => DMap k g
src/Data/Vessel/Map.hs view
@@ -56,7 +56,6 @@           xy = x <> y  instance (Ord k, Eq g, Monoid g) => Monoid (MapV k v (Const g)) where-  mappend = (<>)   mempty = MapV Map.empty  instance (Ord k, Eq g, Group g) => Group (MapV k v (Const g)) where@@ -78,7 +77,6 @@                 xy = x <> y  instance (Ord k1, Ord k2, Monoid g, Eq g) => Monoid (MapV k1 v (Compose (MonoidalMap k2) (Const g))) where-  mappend = (<>)   mempty = MapV Map.empty  instance (Ord k1, Ord k2, Group g, Eq g) => Group (MapV k1 v (Compose (MonoidalMap k2) (Const g))) where
src/Data/Vessel/Single.hs view
@@ -25,6 +25,7 @@ import Data.Functor.Compose import Data.Functor.Const import Data.Functor.Identity+import Data.Kind (Type) import Data.Patch (Group(..)) import Data.Semigroup import Data.Semigroup.Commutative@@ -39,7 +40,7 @@ ------- Simple structure components -------  -- | A functor-indexed container for a single deletable item.-newtype SingleV (a :: *) (g :: * -> *) = SingleV { unSingleV :: g (First (Maybe a)) }+newtype SingleV (a :: Type) (g :: Type -> Type) = SingleV { unSingleV :: g (First (Maybe a)) }   deriving (Generic)  deriving instance (Eq (g (First (Maybe a)))) => Eq (SingleV a g)@@ -52,7 +53,6 @@  instance (Monoid (g (First (Maybe a)))) => Monoid (SingleV a g) where   mempty = SingleV mempty-  mappend (SingleV x) (SingleV y) = SingleV (mappend x y)  instance (Group (g (First (Maybe a)))) => Group (SingleV a g) where   negateG (SingleV x) = SingleV (negateG x)
src/Data/Vessel/SubVessel.hs view
@@ -33,6 +33,7 @@ import Data.Functor.Identity import Data.GADT.Compare import Data.GADT.Show+import Data.Kind (Type) import Data.Map.Monoidal (MonoidalMap(..)) import qualified Data.Map.Monoidal as Map import Data.Orphans ()@@ -50,7 +51,7 @@ import Data.Vessel.Vessel import Data.Vessel.ViewMorphism -data SubVesselKey k (f :: (* -> *) -> *) (g :: (* -> *) -> *) where+data SubVesselKey k (f :: (Type -> Type) -> Type) (g :: (Type -> Type) -> Type) where   SubVesselKey :: k -> SubVesselKey k f f deriving instance Show k => Show (SubVesselKey k f g) instance Show k => GShow (SubVesselKey k f) where gshowsPrec = showsPrec@@ -76,7 +77,7 @@ -- -- TODO: this representation has the advantage that all of it's instances come "free", but the mostly "right" representation is probably -- ... Vessel v (Compose (MonoidalMap k) f)-newtype SubVessel (k :: *)  (v :: (* -> *) -> *) (f :: * -> *) = SubVessel { unSubVessel :: Vessel (SubVesselKey k v) f }+newtype SubVessel (k :: Type)  (v :: (Type -> Type) -> Type) (f :: Type -> Type) = SubVessel { unSubVessel :: Vessel (SubVesselKey k v) f }   deriving (FromJSON, ToJSON, Semigroup, Monoid, Generic, Group, Commutative, Eq)  deriving instance (Show k, Show (v f)) => Show (SubVessel k v f)@@ -105,7 +106,7 @@     , Query (Vessel (SubVesselKey k v) g)     , Semigroup (v (Compose c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g)))))     )-    => Query (SubVessel k v (Compose c (g :: * -> *))) where+    => Query (SubVessel k v (Compose c (g :: Type -> Type))) where   type QueryResult (SubVessel k v (Compose c g)) = SubVessel k v     (Compose c (VesselLeafWrapper (QueryResult (Vessel (SubVesselKey k v) g))))   crop (SubVessel q) (SubVessel r) = SubVessel (crop q r)@@ -202,7 +203,7 @@   }  -mapMaybeWithKeySubVessel :: forall k v (g :: * -> *) (g' :: * -> *) . (View v, Ord k) => (k -> v g -> Maybe (v g')) -> SubVessel k v g -> SubVessel k v g'+mapMaybeWithKeySubVessel :: forall k v (g :: Type -> Type) (g' :: Type -> Type) . (View v, Ord k) => (k -> v g -> Maybe (v g')) -> SubVessel k v g -> SubVessel k v g' mapMaybeWithKeySubVessel f (SubVessel xs) = SubVessel (mapMaybeWithKeyV @(SubVesselKey k v) f' xs)   where     f' :: forall x . SubVesselKey k v x -> x g -> Maybe (x g')@@ -221,7 +222,7 @@  -- | A gadget to "traverse" over all of the keys in a SubVessel in one step handleSubVesselSelector-  ::  forall k m tag (f :: * -> *) (g :: * -> *).+  ::  forall k m tag (f :: Type -> Type) (g :: Type -> Type).   ( Ord k, Applicative m, Has View tag, GCompare tag )   => (forall v.  tag v              ->    MonoidalMap k (v f)
src/Data/Vessel/Vessel.hs view
@@ -38,6 +38,7 @@ import Data.Functor.Identity import Data.GADT.Compare import Data.GADT.Show+import Data.Kind (Type) import Data.Maybe (fromMaybe) import Data.Patch (Group(..)) import Data.Proxy@@ -58,18 +59,18 @@ -- | This type is a container for storing an arbitrary collection of functor-parametric container types of the sort -- discussed above, keyed by a GADT whose index will specify which sort of container goes in each position. ----- Ordinary types with values have kind *--- Functors have kind k -> *--- Containers taking a functor as a parameter then have kind (k -> *) -> *--- The keys of a vessel are indexed by a functor-parametric container type, so they have kind ((k -> *) -> *) -> *+-- Ordinary types with values have kind Type+-- Functors have kind k -> Type+-- Containers taking a functor as a parameter then have kind (k -> Type) -> Type+-- The keys of a vessel are indexed by a functor-parametric container type, so they have kind ((k -> Type) -> Type) -> Type -- Vessel itself, for any such key type, produces a functor-parametric container, so it has kind--- (((k -> *) -> *) -> *) -> (k -> *) -> *+-- (((k -> Type) -> Type) -> Type) -> (k -> Type) -> Type ----- The majority of use cases will be working entirely within * so that Vessel will be instantiated to the kind--- (((* -> *) -> *) -> *) -> (* -> *) -> *+-- The majority of use cases will be working entirely within Type so that Vessel will be instantiated to the kind+-- (((Type -> Type) -> Type) -> Type) -> (Type -> Type) -> Type -- -- Law: None of the items in the Vessel's MonoidalDMap are nullV-newtype Vessel (k :: ((x -> *) -> *) -> *) (g :: x -> *) = Vessel { unVessel :: MonoidalDMap k (FlipAp g) }+newtype Vessel (k :: ((x -> Type) -> Type) -> Type) (g :: x -> Type) = Vessel { unVessel :: MonoidalDMap k (FlipAp g) }   deriving (Generic)  deriving instance (GCompare k, Has' Eq k (FlipAp g)) => Eq (Vessel k g)@@ -113,7 +114,6 @@  instance (Has' Semigroup k (FlipAp g), GCompare k, Has View k) => Monoid (Vessel k g) where   mempty = Vessel DMap.empty-  mappend = (<>)  instance (Has' Semigroup k (FlipAp g), Has' Group k (FlipAp g), GCompare k, Has View k) => Group (Vessel k g) where   negateG (Vessel m) = Vessel (negateG m) --TODO: Do we know that nullV can't be the result of negateG?@@ -180,6 +180,21 @@  traverseWithKeyV_ :: (GCompare k, Has View k, Applicative m) => (forall v. View v => k v -> v g -> m ()) -> Vessel k g -> m () traverseWithKeyV_ f (Vessel x) = void $ DMap.traverseWithKey (\k (FlipAp v) -> has @View k $ Const () <$ f k v) x++mapVesselKeysWith :: GCompare k' => (forall v. k' v -> v g -> v g -> v g) -> (forall v. k v -> k' v) -> Vessel k g -> Vessel k' g+mapVesselKeysWith combineValues changeKey (Vessel m) = Vessel $ DMap.mapKeysWith (\k (FlipAp a) (FlipAp b) -> FlipAp $ combineValues k a b) changeKey m++mapVesselKeysMonotonic+  :: (forall v. k v -> k' v) -- ^ Warning: this function MUST be monotonic+  -> Vessel k g+  -> Vessel k' g+mapVesselKeysMonotonic changeKey (Vessel m) = Vessel $ DMap.mapKeysMonotonic changeKey m++mapVesselKeysMonotonicMaybe+  :: (forall v. k v -> Maybe (k' v)) -- ^ Warning: this function MUST be monotonic for all Just results+  -> Vessel k g+  -> Vessel k' g+mapVesselKeysMonotonicMaybe changeKey (Vessel m) = Vessel $ MonoidalDMap $ DMap'.fromDistinctAscList $ mapMaybe (\(k :=> v) -> (:=>) <$> changeKey k <*> pure v) $ DMap'.toAscList $ unMonoidalDMap m  buildV :: (GCompare k, Has View k, Applicative m) => Vessel k g -> (forall v. k v -> v g -> m (v h)) -> m (Vessel k h) buildV v f = traverseWithKeyV f v
src/Data/Vessel/ViewMorphism.hs view
@@ -30,6 +30,7 @@ import Data.Align import Data.Bifunctor import Data.Functor.Identity+import Data.Kind (Type) import Data.These import Data.Vessel.Internal () import Prelude hiding ((.), id)@@ -67,7 +68,6 @@   ViewHalfMorphism f f' <> ViewHalfMorphism g g' = ViewHalfMorphism (f <> g) (f' <> g')  instance (Monoid (m b) , Monoid (n (ViewQueryResult a))) => Monoid (ViewHalfMorphism m n a b) where-  mappend = (<>)   mempty = ViewHalfMorphism mempty mempty  instance@@ -80,7 +80,6 @@     ( Monoid (m b), Monoid (m (ViewQueryResult b))     , Monoid (n a), Monoid (n (ViewQueryResult a))     )  => Monoid (ViewMorphism m n a b) where-  mappend = (<>)   mempty = ViewMorphism mempty mempty  -- | query for two things simultaneously, return as much result as is available.@@ -109,7 +108,7 @@     , _viewMorphism_mapQueryResult = these id id ((<>)) . bimap a2c' b2c'     } -queryViewMorphism :: forall t (p :: *) (q :: *) m partial.+queryViewMorphism :: forall t (p :: Type) (q :: Type) m partial.   ( Reflex t   , MonadQuery t q m   , Monad m
+ src/Data/Vessel/Void.hs view
@@ -0,0 +1,38 @@+{-# LANGUAGE KindSignatures #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE DeriveGeneric #-}++module Data.Vessel.Void where++import Data.Aeson+import GHC.Generics+import Data.Functor.Const+import Data.Functor.Identity+import Data.Kind (Type)+import Data.Patch (Group(..))+import Data.Vessel.Class+import Reflex.Query.Class++-- | Completely empty View.+data VoidV (v :: Type -> Type) = VoidV+  deriving (Eq, Ord, Show, Generic)++instance FromJSON (VoidV a)+instance ToJSON (VoidV a)++instance Semigroup (VoidV x) where+  _ <> _ = VoidV+instance Monoid (VoidV x) where+  mempty = VoidV+instance Group (VoidV x) where+  negateG _ = VoidV++instance View VoidV where++instance Query (VoidV (Const x)) where+  type QueryResult (VoidV (Const x)) = VoidV Identity+  crop _ = id++instance EmptyView VoidV where+  emptyV = VoidV
tutorial/Tutorial.lhs view
@@ -18,6 +18,7 @@ import Data.Aeson.GADT.TH (deriveJSONGADT) import Data.Align import Data.Proxy+import Data.Kind (Type) import Data.Map (Map) import Data.Map.Monoidal (MonoidalMap(..)) import Data.Semigroup (First(..), Max(..))@@ -53,6 +54,9 @@   , _q_latestPostId :: GrpMap () g -- ^ morally a "bool"; for if the maxPost Id is being requested.   } deriving (Eq, Ord, Show, Read) +newtype GrpMap k v = GrpMap { unGrpMap :: Map k v } deriving (Eq, Ord, Show, Read)+type role GrpMap nominal nominal+ ```  And the corresponding result type.  Note that we have the same set of fields occur in both.@@ -73,13 +77,44 @@ have.  The latter is almost always quicker.  ```haskell- instance (Eq g, Monoid g) => Semigroup (Qsimple g) where Qsimple x y <> Qsimple x' y' = Qsimple (x <> x') (y <> y') instance (Eq g, Monoid g) => Monoid (Qsimple g) where mempty = Qsimple mempty mempty instance (Eq g, Group g) => Group (Qsimple g) where negateG (Qsimple x y) = Qsimple (negateG x) (negateG y) instance (Eq g, Monoid g, Commutative g) => Commutative (Qsimple g) instance GrpFunctor Qsimple where mapG f (Qsimple x y) = Qsimple (mapG f x) (mapG f y) +class (forall g. (Eq g, Group g) => Group (f g)) => GrpFunctor f where+  mapG :: (Eq b, Group b) => (a -> b) -> f a -> f b++instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where+  GrpMap xs <> GrpMap ys = GrpMap $ Map.merge id id (Map.zipWithMaybeMatched $ const $ liftNonZero (<>)) xs ys+++instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where+  mempty = GrpMap Map.empty++instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where+  negateG (GrpMap xs) = GrpMap $ fmap negateG xs+  GrpMap xs ~~ GrpMap ys = GrpMap $ Map.merge id (Map.mapMissing $ const $ negateG) (Map.zipWithMaybeMatched $ const $ liftNonZero (~~)) xs ys++liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a+liftNonZero f x y = if (xy /= mempty)+  then Just x+  else Nothing+  where xy = f x y++-- distributive functors can still be groups.+instance GrpFunctor ((->) r) where mapG = fmap+instance GrpFunctor Proxy where mapG = fmap+instance GrpFunctor Identity where mapG = fmap++instance Ord k => GrpFunctor (GrpMap k) where+  mapG f (GrpMap xs) = GrpMap $ Map.mapMaybe (\x ->+    let fx = f x+    in if fx /= mempty+    then Just fx+    else Nothing) xs+ ```  MonadQuery Also requires that QueryResult be a monoid;  this reflects the idea@@ -125,7 +160,7 @@  ```haskell -watchPost +watchPost   :: ( MonadQuery t (Qsimple SelectedCount) m      , QueryResult (Qsimple SelectedCount) ~ Rsimple      , Reflex t@@ -186,6 +221,17 @@         Nothing -> text "Post Not Found"         Just dPost -> dynText dPost +-- To avoid requiring reflex-dom, we stub out a few functions that you'd normally get from reflex-dom-core.+type Widget t m = (NotReady t m, Adjustable t m, PostBuild t m)++dyn_ :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m ()+dyn_ = void . networkView++text :: Monad m => Text -> m ()+text _ = pure ()++dynText :: Monad m => Dynamic t Text -> m ()+dynText _ = pure () ```  We can try to improve the situation in essentially all of@@ -198,7 +244,7 @@  ```haskell -data Qhkd (f :: * -> *) = Qhkd+data Qhkd (f :: Type -> Type) = Qhkd   { _qhkd_posts :: MonoidalMap PostId (f (First (Maybe Post))) -- ^ posts   , _qhkd_latestPostId :: MonoidalMap () (f (Max (Maybe PostId))) -- ^ the max post id;   }@@ -214,7 +260,7 @@  ```haskell -data Qtag (a :: *) where+data Qtag (a :: Type) where   Qtag_Posts        :: PostId -> Qtag (First (Maybe Post))   Qtag_LatestPostId :: Qtag (Max (Maybe PostId)) @@ -229,7 +275,7 @@  ```haskell -data Qvessel (v :: (* -> *) -> *) where+data Qvessel (v :: (Type -> Type) -> Type) where   Posts        :: Qvessel (MapV PostId (First (Maybe Post)))   LatestPostId :: Qvessel (IdentityV (Max (Maybe PostId))) @@ -239,6 +285,11 @@ remaining instances follow from the view types in vessel:  ```haskell+deriveArgDict ''Qvessel+deriveJSONGADT ''Qvessel+deriveGEq ''Qvessel+deriveGCompare ''Qvessel+deriveGShow ''Qvessel  viewPost :: (MonadQuery t (Vessel Qvessel (Const SelectedCount)) m, Reflex t, Monad m)   => Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))@@ -255,19 +306,6 @@ ***  ```haskell---- To avoid requiring reflex-dom, we stub out a few functions that you'd normally get from reflex-dom-core.-type Widget t m = (NotReady t m, Adjustable t m, PostBuild t m)--dyn_ :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m ()-dyn_ = void . networkView--text :: Monad m => Text -> m ()-text _ = pure ()--dynText :: Monad m => Dynamic t Text -> m ()-dynText _ = pure ()- positive :: forall x. (Monoid x, Ord x) => x -> SelectedCount positive x   | x > mempty = 1@@ -319,47 +357,4 @@     promtForIt q = liftIO $ do       print q       readLn---- annoying stuff that needs to exist but doesn't.-newtype GrpMap k v = GrpMap { unGrpMap :: Map k v } deriving (Eq, Ord, Show, Read)-type role GrpMap nominal nominal--liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a-liftNonZero f x y = if (xy /= mempty)-  then Just x-  else Nothing-  where xy = f x y--instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where-  GrpMap xs <> GrpMap ys = GrpMap $ Map.merge id id (Map.zipWithMaybeMatched $ const $ liftNonZero (<>)) xs ys--instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where-  mempty = GrpMap Map.empty-  mappend = (<>)--instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where-  negateG (GrpMap xs) = GrpMap $ fmap negateG xs-  GrpMap xs ~~ GrpMap ys = GrpMap $ Map.merge id (Map.mapMissing $ const $ negateG) (Map.zipWithMaybeMatched $ const $ liftNonZero (~~)) xs ys--class (forall g. (Eq g, Group g) => Group (f g)) => GrpFunctor f where-  mapG :: (Eq b, Group b) => (a -> b) -> f a -> f b---- distributive functors can still be groups.-instance GrpFunctor ((->) r) where mapG = fmap-instance GrpFunctor Proxy where mapG = fmap-instance GrpFunctor Identity where mapG = fmap--instance Ord k => GrpFunctor (GrpMap k) where-  mapG f (GrpMap xs) = GrpMap $ Map.mapMaybe (\x ->-    let fx = f x-    in if fx /= mempty-    then Just fx-    else Nothing) xs--deriveArgDict ''Qvessel-deriveJSONGADT ''Qvessel-deriveGEq ''Qvessel-deriveGCompare ''Qvessel-deriveGShow ''Qvessel- ```
tutorial/Tutorial.md view
@@ -18,6 +18,7 @@ import Data.Aeson.GADT.TH (deriveJSONGADT) import Data.Align import Data.Proxy+import Data.Kind (Type) import Data.Map (Map) import Data.Map.Monoidal (MonoidalMap(..)) import Data.Semigroup (First(..), Max(..))@@ -53,6 +54,9 @@   , _q_latestPostId :: GrpMap () g -- ^ morally a "bool"; for if the maxPost Id is being requested.   } deriving (Eq, Ord, Show, Read) +newtype GrpMap k v = GrpMap { unGrpMap :: Map k v } deriving (Eq, Ord, Show, Read)+type role GrpMap nominal nominal+ ```  And the corresponding result type.  Note that we have the same set of fields occur in both.@@ -73,13 +77,44 @@ have.  The latter is almost always quicker.  ```haskell- instance (Eq g, Monoid g) => Semigroup (Qsimple g) where Qsimple x y <> Qsimple x' y' = Qsimple (x <> x') (y <> y') instance (Eq g, Monoid g) => Monoid (Qsimple g) where mempty = Qsimple mempty mempty instance (Eq g, Group g) => Group (Qsimple g) where negateG (Qsimple x y) = Qsimple (negateG x) (negateG y) instance (Eq g, Monoid g, Commutative g) => Commutative (Qsimple g) instance GrpFunctor Qsimple where mapG f (Qsimple x y) = Qsimple (mapG f x) (mapG f y) +class (forall g. (Eq g, Group g) => Group (f g)) => GrpFunctor f where+  mapG :: (Eq b, Group b) => (a -> b) -> f a -> f b++instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where+  GrpMap xs <> GrpMap ys = GrpMap $ Map.merge id id (Map.zipWithMaybeMatched $ const $ liftNonZero (<>)) xs ys+++instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where+  mempty = GrpMap Map.empty++instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where+  negateG (GrpMap xs) = GrpMap $ fmap negateG xs+  GrpMap xs ~~ GrpMap ys = GrpMap $ Map.merge id (Map.mapMissing $ const $ negateG) (Map.zipWithMaybeMatched $ const $ liftNonZero (~~)) xs ys++liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a+liftNonZero f x y = if (xy /= mempty)+  then Just x+  else Nothing+  where xy = f x y++-- distributive functors can still be groups.+instance GrpFunctor ((->) r) where mapG = fmap+instance GrpFunctor Proxy where mapG = fmap+instance GrpFunctor Identity where mapG = fmap++instance Ord k => GrpFunctor (GrpMap k) where+  mapG f (GrpMap xs) = GrpMap $ Map.mapMaybe (\x ->+    let fx = f x+    in if fx /= mempty+    then Just fx+    else Nothing) xs+ ```  MonadQuery Also requires that QueryResult be a monoid;  this reflects the idea@@ -125,7 +160,7 @@  ```haskell -watchPost +watchPost   :: ( MonadQuery t (Qsimple SelectedCount) m      , QueryResult (Qsimple SelectedCount) ~ Rsimple      , Reflex t@@ -186,6 +221,17 @@         Nothing -> text "Post Not Found"         Just dPost -> dynText dPost +-- To avoid requiring reflex-dom, we stub out a few functions that you'd normally get from reflex-dom-core.+type Widget t m = (NotReady t m, Adjustable t m, PostBuild t m)++dyn_ :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m ()+dyn_ = void . networkView++text :: Monad m => Text -> m ()+text _ = pure ()++dynText :: Monad m => Dynamic t Text -> m ()+dynText _ = pure () ```  We can try to improve the situation in essentially all of@@ -198,7 +244,7 @@  ```haskell -data Qhkd (f :: * -> *) = Qhkd+data Qhkd (f :: Type -> Type) = Qhkd   { _qhkd_posts :: MonoidalMap PostId (f (First (Maybe Post))) -- ^ posts   , _qhkd_latestPostId :: MonoidalMap () (f (Max (Maybe PostId))) -- ^ the max post id;   }@@ -214,7 +260,7 @@  ```haskell -data Qtag (a :: *) where+data Qtag (a :: Type) where   Qtag_Posts        :: PostId -> Qtag (First (Maybe Post))   Qtag_LatestPostId :: Qtag (Max (Maybe PostId)) @@ -229,7 +275,7 @@  ```haskell -data Qvessel (v :: (* -> *) -> *) where+data Qvessel (v :: (Type -> Type) -> Type) where   Posts        :: Qvessel (MapV PostId (First (Maybe Post)))   LatestPostId :: Qvessel (IdentityV (Max (Maybe PostId))) @@ -239,6 +285,11 @@ remaining instances follow from the view types in vessel:  ```haskell+deriveArgDict ''Qvessel+deriveJSONGADT ''Qvessel+deriveGEq ''Qvessel+deriveGCompare ''Qvessel+deriveGShow ''Qvessel  viewPost :: (MonadQuery t (Vessel Qvessel (Const SelectedCount)) m, Reflex t, Monad m)   => Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))@@ -255,19 +306,6 @@ ***  ```haskell---- To avoid requiring reflex-dom, we stub out a few functions that you'd normally get from reflex-dom-core.-type Widget t m = (NotReady t m, Adjustable t m, PostBuild t m)--dyn_ :: (NotReady t m, Adjustable t m, PostBuild t m) => Dynamic t (m a) -> m ()-dyn_ = void . networkView--text :: Monad m => Text -> m ()-text _ = pure ()--dynText :: Monad m => Dynamic t Text -> m ()-dynText _ = pure ()- positive :: forall x. (Monoid x, Ord x) => x -> SelectedCount positive x   | x > mempty = 1@@ -319,47 +357,4 @@     promtForIt q = liftIO $ do       print q       readLn---- annoying stuff that needs to exist but doesn't.-newtype GrpMap k v = GrpMap { unGrpMap :: Map k v } deriving (Eq, Ord, Show, Read)-type role GrpMap nominal nominal--liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a-liftNonZero f x y = if (xy /= mempty)-  then Just x-  else Nothing-  where xy = f x y--instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where-  GrpMap xs <> GrpMap ys = GrpMap $ Map.merge id id (Map.zipWithMaybeMatched $ const $ liftNonZero (<>)) xs ys--instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where-  mempty = GrpMap Map.empty-  mappend = (<>)--instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where-  negateG (GrpMap xs) = GrpMap $ fmap negateG xs-  GrpMap xs ~~ GrpMap ys = GrpMap $ Map.merge id (Map.mapMissing $ const $ negateG) (Map.zipWithMaybeMatched $ const $ liftNonZero (~~)) xs ys--class (forall g. (Eq g, Group g) => Group (f g)) => GrpFunctor f where-  mapG :: (Eq b, Group b) => (a -> b) -> f a -> f b---- distributive functors can still be groups.-instance GrpFunctor ((->) r) where mapG = fmap-instance GrpFunctor Proxy where mapG = fmap-instance GrpFunctor Identity where mapG = fmap--instance Ord k => GrpFunctor (GrpMap k) where-  mapG f (GrpMap xs) = GrpMap $ Map.mapMaybe (\x ->-    let fx = f x-    in if fx /= mempty-    then Just fx-    else Nothing) xs--deriveArgDict ''Qvessel-deriveJSONGADT ''Qvessel-deriveGEq ''Qvessel-deriveGCompare ''Qvessel-deriveGShow ''Qvessel- ```
vessel.cabal view
@@ -1,5 +1,5 @@ name:               vessel-version:            0.3.0.0+version:            0.3.0.1 description:   A dependently-typed key-value data structure that allows for storage of both "queries", (wherein keys are stored along with reasons for selecting the items or counts of the number of times something has been selected), as well as the responses to those queries, in which the type of the key additionally determines the type of the response @@ -18,8 +18,11 @@ cabal-version:      2.0 category:           Data synopsis:           Functor-parametric containers-tested-with:        GHC ==8.6.5 || ==8.8.4 || ==8.10.7+tested-with:        GHC ==8.6.5 || ==8.8.4 || ==8.10.7 || ==9.0.2 || ==9.2.5 || ==9.4.5 || ==9.6.1 || ==9.8.2 || ==9.10.1 +flag build-tutorial+  default: True+ library   exposed-modules:     Data.Vessel@@ -35,6 +38,7 @@     Data.Vessel.SubVessel     Data.Vessel.Vessel     Data.Vessel.ViewMorphism+    Data.Vessel.Void    other-extensions:     FlexibleInstances@@ -46,31 +50,31 @@     UndecidableInstances    build-depends:-      aeson                        >=1.4     && <2.2-    , base                         >=4.9     && <4.17-    , base-orphans                 ^>=0.8.5-    , bifunctors                   ^>=5.5-    , commutative-semigroups       ^>=0.1+      aeson                        >=1.4     && <2.3+    , base                         >=4.9     && <4.21+    , base-orphans                 >=0.8.5   && <0.10+    , bifunctors                   >=5.5     && <5.7+    , commutative-semigroups       >=0.1     && <0.3     , constraints                  >=0.10    && <0.15     , constraints-extras           ^>=0.4-    , containers                   ^>=0.6+    , containers                   >=0.6     && <0.8     , dependent-map                ^>=0.4     , dependent-monoidal-map       ^>=0.1.1.0     , dependent-sum                ^>=0.7     , dependent-sum-aeson-orphans  ^>=0.3.1     , monoidal-containers          ^>=0.6-    , mtl                          ^>=2.2+    , mtl                          >=2.2     && <2.4     , patch                        ^>=0.0.7.0-    , reflex                       >=0.6.4   && <0.9+    , reflex                       >=0.6.4   && <1     , semialign                    >=1-    , these                        >=1 && <1.2-    , witherable                   >=0.2 && <0.5+    , these                        >=1       && <1.3+    , witherable                   >=0.2     && <0.6    hs-source-dirs:   src   default-language: Haskell2010  library vessel-tutorial-  if impl(ghcjs)+  if impl(ghcjs) || !flag(build-tutorial)     buildable: False    hs-source-dirs:     tutorial@@ -93,6 +97,7 @@     StandaloneDeriving     TemplateHaskell     TypeFamilies+    TypeOperators     UndecidableInstances    ghc-options:        -Wall -pgmL markdown-unlit