vessel 0.2.0.0 → 0.2.1.0

raw patch · 8 files changed

+225/−37 lines, 8 filesdep +base-orphansdep ~dependent-sum-aeson-orphansdep ~thesedep ~witherablePVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: base-orphans

Dependency ranges changed: dependent-sum-aeson-orphans, these, witherable

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• src/Data/Vessel.hs +5/−0
• src/Data/Vessel/Class.hs +2/−1
• src/Data/Vessel/DependentMap.hs +26/−20
• src/Data/Vessel/Internal.hs +8/−8
• src/Data/Vessel/Path.hs +164/−0
• src/Data/Vessel/Vessel.hs +8/−4
• vessel.cabal +6/−4

@@ -1,5 +1,11 @@ # Revision history for vessel +## 0.2.1.0++* Allow `Vessel` and `DMapV` types to be more liberally kinded in their indexes.+* Add Data.Vessel.Path. See that module for documentation.+* Add `singletonDMapV` and `lookupDMapV`+ ## 0.2.0.0  * Add an orphan instance for 'Additive' of 'Compose' this is in line with the other orphans for 'Compose' that will be phased out in a future release in favor of an upstream solution.

@@ -34,6 +34,10 @@   , traverseSubVessel   , singletonSubVessel   , lookupSubVessel+  , Path(..)+  , (~>)+  , Keyed(..)+  , SetKeyed(..)   ) where  import Data.Functor.Compose@@ -52,3 +56,4 @@ import Data.Vessel.Single as X import Data.Vessel.SubVessel as X import Data.Vessel.ViewMorphism as X+import Data.Vessel.Path as X

@@ -17,6 +17,7 @@ {-# LANGUAGE TypeApplications #-} {-# LANGUAGE TypeFamilies #-} {-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}  module Data.Vessel.Class where @@ -59,7 +60,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 :: (* -> *) -> *) where+class View (v :: (x -> *) -> *) 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.

@@ -26,6 +26,7 @@ import Data.Constraint.Extras import Data.Constraint.Forall import Data.Dependent.Map.Monoidal (MonoidalDMap(..))+import qualified Data.Dependent.Map.Monoidal as MonoidalDMap import Data.Functor.Compose import Data.GADT.Compare import Data.Some (Some(Some))@@ -44,34 +45,34 @@ import Data.Vessel.Internal  -- | A functor-indexed container corrresponding to DMap k v.-newtype DMapV (k :: * -> *) (v :: * -> *) g = DMapV { unDMapV :: MonoidalDMap k (Compose g v) }+newtype DMapV (k :: x -> *) (v :: x -> *) g = DMapV { unDMapV :: MonoidalDMap k (g :.: v) }   deriving (Generic) -deriving instance (GCompare k, Has' Eq k (Compose g v)) => Eq (DMapV k v g)-deriving instance (GCompare k, Has' Eq k (Compose g v), Has' Ord k (Compose g v)) => Ord (DMapV k v g)-deriving instance (GCompare k, Has' Semigroup k (Compose g v)) => Semigroup (DMapV k v g)-deriving instance (GCompare k, Has' Semigroup k (Compose g v), Has' Monoid k (Compose g v)) => Monoid (DMapV k v g)-deriving instance (GCompare k, Has' Semigroup k (Compose g v), Has' Monoid k (Compose g v), Has' Group k (Compose g v)) => Group (DMapV k v g)-deriving instance (GCompare k, Has' Semigroup k (Compose g v), Has' Monoid k (Compose g v), Has' Group k (Compose g v), Has' Additive k (Compose g v)) => Additive (DMapV k v g)+deriving instance (GCompare k, Has' Eq k (g :.: v)) => Eq (DMapV k v g)+deriving instance (GCompare k, Has' Eq k (g :.: v), Has' Ord k (g :.: v)) => Ord (DMapV k v g)+deriving instance (GCompare k, Has' Semigroup k (g :.: v)) => Semigroup (DMapV k v g)+deriving instance (GCompare k, Has' Semigroup k (g :.: v), Has' Monoid k (g :.: v)) => Monoid (DMapV k v g)+deriving instance (GCompare k, Has' Semigroup k (g :.: v), Has' Monoid k (g :.: v), Has' Group k (g :.: v)) => Group (DMapV k v g)+deriving instance (GCompare k, Has' Semigroup k (g :.: v), Has' Monoid k (g :.: v), Has' Group k (g :.: v), Has' Additive k (g :.: v)) => Additive (DMapV k v g) -instance (Has' ToJSON k (Compose g v), ForallF ToJSON k) => ToJSON (DMapV k v g)+instance (Has' ToJSON k (g :.: v), ForallF ToJSON k) => ToJSON (DMapV k v g) -instance (Has' FromJSON k (Compose g v), FromJSON (Some k), GCompare k) => FromJSON (DMapV k v g)+instance (Has' FromJSON k (g :.: v), FromJSON (Some k), GCompare k) => FromJSON (DMapV k v g) -deriving instance (ForallF Show k, Has' Show k (Compose g v)) => Show (DMapV k v g)+deriving instance (ForallF Show k, Has' Show k (g :.: v)) => Show (DMapV k v g)  instance (GCompare k) => View (DMapV k v) where-  cropV f (DMapV s) (DMapV i) = collapseNullV $ DMapV (DMap.intersectionWithKey (\_ (Compose x) (Compose y) -> Compose $ f x y) s i)+  cropV f (DMapV s) (DMapV i) = collapseNullV $ DMapV (DMap.intersectionWithKey (\_ (Comp1 x) (Comp1 y) -> Comp1 $ f x y) s i)   nullV (DMapV m) = DMap.null m-  condenseV m = DMapV . DMap.map assocLCompose . condenseV . fmap unDMapV $ m-  disperseV (DMapV m) = fmap DMapV . disperseV . DMap.map assocRCompose $ m-  mapV f (DMapV m) = DMapV $ DMap.map (\(Compose x) -> Compose (f x)) m-  traverseV f (DMapV m) = DMapV <$> DMap.traverseWithKey (\_ (Compose x) -> Compose <$> f x) m+  condenseV m = DMapV . DMap.map assocLComposeComp . condenseV . fmap unDMapV $ m+  disperseV (DMapV m) = fmap DMapV . disperseV . DMap.map assocRComposeComp $ m+  mapV f (DMapV m) = DMapV $ DMap.map (\(Comp1 x) -> Comp1 (f x)) m+  traverseV f (DMapV m) = DMapV <$> DMap.traverseWithKey (\_ (Comp1 x) -> Comp1 <$> f x) m   mapMaybeV f (DMapV (MonoidalDMap m)) = collapseNullV $ DMapV $ MonoidalDMap $-    DMap'.mapMaybe (fmap Compose . f . getCompose) m-  alignWithV f (DMapV a) (DMapV b) = DMapV (alignWithKeyMonoidalDMap (\_ x -> Compose . f $ bimap getCompose getCompose x) a b)+    DMap'.mapMaybe (fmap Comp1 . f . unComp1) m+  alignWithV f (DMapV a) (DMapV b) = DMapV (alignWithKeyMonoidalDMap (\_ x -> Comp1 . f $ bimap unComp1 unComp1 x) a b)   alignWithMaybeV f (DMapV a) (DMapV b) = collapseNullV . DMapV $-     alignWithKeyMaybeMonoidalDMap (\_ x -> fmap Compose $ f (bimap getCompose getCompose x)) a b+     alignWithKeyMaybeMonoidalDMap (\_ x -> fmap Comp1 $ f (bimap unComp1 unComp1 x)) a b  instance (GCompare k) => EmptyView (DMapV k v) where   emptyV = DMapV DMap.empty@@ -79,6 +80,11 @@ instance (GCompare k) => Selectable (DMapV k v) (Set (Some k)) where   type Selection (DMapV k v) (Set (Some k)) = MonoidalDMap k v   selector p s = DMapV . DMap.fromListWithKey (\_ x _ -> x) $-    fmap (\(Some k) -> k :=> Compose p) (Set.toList s)-  selection _ (DMapV m) = DMap.map (\(Compose (Identity v)) -> v) m+    fmap (\(Some k) -> k :=> Comp1 p) (Set.toList s)+  selection _ (DMapV m) = DMap.map (\(Comp1 (Identity v)) -> v) m +singletonDMapV :: k a -> g (v a) -> DMapV k v g+singletonDMapV k v = DMapV $ MonoidalDMap.singleton k (Comp1 v)++lookupDMapV :: GCompare k => k a -> DMapV k v g -> Maybe (g (v a))+lookupDMapV k (DMapV m) = unComp1 <$> MonoidalDMap.lookup k m

@@ -43,6 +43,7 @@ import Data.Witherable import qualified Data.Map as Map' import qualified Data.Map.Merge.Strict as Map'+import GHC.Generics  import qualified Data.Dependent.Map.Monoidal as DMap -- import qualified Data.Dependent.Map as DMap'@@ -66,7 +67,7 @@   -- A single Vessel key/value pair, essentially a choice of container type, together with a corresponding container.-data VSum (k :: ((* -> *) -> *) -> *) (g :: * -> *) = forall v. k v :~> v g+data VSum (k :: ((x -> *) -> *) -> *) (g :: x -> *) = forall v. k v :~> v g  ------- Serialisation ------- @@ -89,13 +90,6 @@  instance (Has' Group f g, Has' Semigroup f g, GCompare f) => Additive (MonoidalDMap f g) -instance (Semigroup (f (g a))) => Semigroup (Compose f g a) where-  (Compose x) <> (Compose y) = Compose (x <> y)--instance (Monoid (f (g a))) => Monoid (Compose f g a) where-  mempty = Compose mempty-  mappend (Compose x) (Compose y) = Compose (mappend x y)- instance (Additive (f (g a))) => Additive (Compose f g a)  ------- Miscellaneous stuff to be moved elsewhere -------@@ -107,6 +101,12 @@  assocRCompose :: (Functor f) => Compose (Compose f g) h x -> Compose f (Compose g h) x assocRCompose (Compose (Compose x)) = Compose (fmap Compose x)++assocLComposeComp :: (Functor f) => (Compose f (g :.: h)) x -> ((Compose f g) :.: h) x+assocLComposeComp (Compose x) = Comp1 $ Compose (fmap unComp1 x)++assocRComposeComp :: (Functor f) => ((Compose f g) :.: h) x -> Compose f (g :.: h) x+assocRComposeComp (Comp1 (Compose x)) = Compose (fmap Comp1 x)  alignWithKeyMaybeDMap :: GCompare k => (forall a. k a -> These (f a) (g a) -> Maybe (h a)) -> DMap k f -> DMap k g -> DMap k h alignWithKeyMaybeDMap f a b = DMap'.mapMaybeWithKey (\k t -> f k $ dtheseToThese t) $ DMap'.unionWithKey (\_ (DThis x) (DThat y) -> DThese x y) (DMap'.map DThis a) (DMap'.map DThat b)

@@ -0,0 +1,164 @@+{-# Language FlexibleInstances #-}+{-# Language FunctionalDependencies #-}+{-# Language RankNTypes #-}+{-# Language GADTs #-}+module Data.Vessel.Path where++import Control.Applicative+import Control.Monad+import Control.Monad.Fix+import qualified Data.Dependent.Map.Monoidal as MonoidalDMap+import Data.GADT.Compare+import Data.Map (Map)+import qualified Data.Map as Map+import Data.Map.Monoidal+import Data.Semigroup (First(..))+import Data.Set (Set)+import Data.Vessel.Class hiding (mapV)+import Data.Vessel.DependentMap hiding (dmapV)+import Data.Vessel.Identity hiding (identityV)+import Data.Vessel.Map hiding (mapV)+import Data.Vessel.Single hiding (singleV)+import Data.Vessel.SubVessel hiding (subVessel)+import Data.Vessel.Vessel hiding (vessel)+import Reflex++-- | A (Path v w w' v') consists of maps in opposite directions:+--+--  >        v ---> w+--  > Maybe v' <--- w'+--+--  If we think of v / v' as variants of a "small" structure, and w / w' as+--  variants of a "large" structure, this encodes how to on the one hand+--  include v inside a larger structure of type w, and how to (potentially)+--  extract a value of type v' from a structure of type w'.+--+--  Vessels are often used to represent queries and their responses. It may be+--  useful to think of @v@ as being some small part of a query, @w@ as being a+--  larger or more complete query, @w'@ as being a complete response, and @v'@+--  as being the smaller part of the response corresponding to @v@.+--+-- In this way, we can package up parts of the query/response round-trip,+-- and not have to specify twice at which keys we're querying on the one hand+-- and looking up on the other.+--+-- Each @Path@ will often be a pair of the "singleton" constructor of some sort of+-- map-like datastructure and its corresponding lookup.+--+--  For example, given @MapV k v@, @key k@ will produce a @Path@ that describes+--  how to construct a singleton @MapV@ and how to extract the value at key @k@+--  from a @MapV@.+--+--  This becomes particularly useful as your vessels become more complicated.+--  For example given a @SubVessel k (MapV k' a) g@, you can construct a path+--  such as @key k ~> key k'@ that constructs a singleton of a singleton and,+--  in the other direction, looks up the @MapV@ at key @k@ of the @SubVessel@+--  and the value at key @k'@ of the @MapV@.+--+--  Formally, these are arrows in the product category of Hask and the Kleisli+--  category of Maybe.+data Path v w w' v' = Path { _path_to :: v -> w, _path_from :: w' -> Maybe v' }++-- | Compose two paths+(~>) :: Path b c c' b' -> Path a b b' a' -> Path a c c' a'+Path to from ~> Path to' from' = Path (to . to') (from' <=< from)++-- | The identity path+idP :: Path a a b b+idP = Path id pure++-- | Construct a @Path@ which uses the given function on the "input" or "query" side+-- and does nothing on the output side.+preMap :: (a -> b) -> Path a b x x+preMap f = Path f pure++-- | Construct a @Path@ which uses the given function on the "output" or "response" side+-- and does nothing on the input side. Useful for post-processing the results of queries.+postMap :: (a' -> Maybe b') -> Path x x a' b'+postMap f = Path id f++-- | A class for keyed map-like datastructures of various types, giving an appropriate+-- @Path@ for constructing a singleton at the given key, and for extracting the value at+-- that key, if any.+class Keyed k a b b' a'  | k b -> a, k b' -> a' where+  key :: k -> Path a b b' a'++-- | A class for keyed map-like datastructures of various types, giving an appropriate+-- @Path@ for constructing a mapping having the given set of keys, with the same value+-- at every key, and for extracting the restriction of the corresponding map to the given keys.+class SetKeyed k a b b' a'  | k b -> a, k b' -> a' where+  keys :: Set k -> Path a b b' a'++instance (GCompare k, View v) => Keyed (k v) (v g) (Vessel k g) (Vessel k g') (v g') where+  key = vessel++instance (Ord k, View v) => Keyed k (v g) (SubVessel k v g) (SubVessel k v g') (v g') where+  key = subVessel++instance (Ord k) => Keyed k (g v) (MapV k v g) (MapV k v g') (g' v) where+  key = mapV++instance (GCompare k) => Keyed (k a) (g (v a)) (DMapV k v g) (DMapV k v g') (g' (v a)) where+  key = dmapV++instance (Ord k, Applicative g') => SetKeyed k (g v) (MapV k v g) (MapV k v g') (g' (Map k v)) where+  keys = mapVSet++-- | This is the implementation of @key@ for @Vessel@. Given some key of type @k v@, gives a @Path@+-- that on the one hand will transform a value of type @v g@ into a complete singleton @Vessel@+-- and in the other direction, will perform a lookup for the given key on a similar @Vessel@.+vessel :: (GCompare k, View v) => k v -> Path (v g) (Vessel k g) (Vessel k g') (v g')+vessel k = Path { _path_to = singletonV k, _path_from = lookupV k }++-- | This is the implementation of @key@ for @SubVessel@. Given some key of type @k@, gives a @Path@+-- that on the one hand will transform a value of type @v g@ into a complete singleton @SubVessel@+-- and in the other direction, will perform a lookup for the given key on a similar @SubVessel@.+subVessel :: (Ord k, View v) => k -> Path (v g) (SubVessel k v g) (SubVessel k v g') (v g')+subVessel k = Path { _path_to = singletonSubVessel k, _path_from = lookupSubVessel k }++-- | This is the implementation of @key@ for @MapV@. Given some key of type @k@, gives a @Path@+-- that on the one hand will transform a value of type @g v@ into a complete singleton @MapV@+-- and in the other direction, will perform a lookup for the given key on a similar @MapV@.+mapV :: (Ord k) => k -> Path (g v) (MapV k v g) (MapV k v g') (g' v)+mapV k = Path { _path_to = singletonMapV k, _path_from = lookupMapV k }++-- | This is the implementation of @keys@ for @MapV@. Given a set of keys of type @k@, gives a @Path@+-- that on the one hand will transform a value of type @g v@ into a @MapV@ having the given set of keys+-- and the given @g v@ at every key. In the other direction, it will perform a restrictKeys to select+-- the given keys out of the response of type @MapV k v g'@ and fully unpack the result into a+-- @g' (Map k v)@.+mapVSet :: (Ord k, Applicative g') => Set k -> Path (g v) (MapV k v g) (MapV k v g') (g' (Map k v))+mapVSet ks = Path+  { _path_to = \g -> MapV (MonoidalMap (Map.fromSet (const g) ks))+  , _path_from = Just . sequenceA . flip Map.restrictKeys ks . getMonoidalMap . unMapV+  }++-- | This is the implementation of @key@ for @DMapV@. Given some key of type @k a@, gives a @Path@+-- that on the one hand will transform a value of type @g (v a)@ into a complete singleton @DMapV@+-- and in the other direction, will perform a lookup for the given key on a similar @DMapV@.+dmapV :: (GCompare k) => k a -> Path (g (v a)) (DMapV k v g) (DMapV k v g') (g' (v a))+dmapV k = Path+  { _path_to = singletonDMapV k+  , _path_from = lookupDMapV k+  }++-- | This is a @Path@ which wraps/unwraps @IdentityV@. The unwrapping always succeeds of course.+identityV :: Path (g a) (IdentityV a g) (IdentityV a g') (g' a)+identityV = Path+  { _path_to = IdentityV+  , _path_from = Just . unIdentityV+  }++-- | This is a @Path@ which wraps/unwraps @SingleV@. Always produces a @SingleV@ containing @Just@ of+-- the input value on the input side, but unwrapping will result in @Just@ or @Nothing@ according to+-- whether the response contains a @Just@ or @Nothing@.+singleV :: (Traversable g', Functor g) => Path (g a) (SingleV a g) (SingleV a g') (g' a)+singleV = Path+  { _path_to = SingleV . fmap (First . Just)+  , _path_from = sequenceA . fmap getFirst . unSingleV+  }++-- | Combines two @Path@s whose full query type is a @Semigroup@, effectively, asking for two things at once,+-- and extracting the pair of results afterward.+zip :: (Semigroup c) => Path a c c' a' -> Path b c c' b' -> Path (a, b) c c' (a', b')+zip (Path to from) (Path to' from') = Path (\(x,y) -> to x <> to' y) (\c -> liftA2 (,) (from c) (from' c))

@@ -58,13 +58,17 @@ -- 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 * -> *--- Containers taking a functor as a parameter then have kind (* -> *) -> *--- The keys of a vessel are indexed by a functor-parametric container type, so they 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 -> *) -> *) -> * -- Vessel itself, for any such key type, produces a functor-parametric container, so it has kind+-- (((k -> *) -> *) -> *) -> (k -> *) -> *+--+-- The majority of use cases will be working entirely within * so that Vessel will be instantiated to the kind -- (((* -> *) -> *) -> *) -> (* -> *) -> *+-- -- Law: None of the items in the Vessel's MonoidalDMap are nullV-newtype Vessel (k :: ((* -> *) -> *) -> *) (g :: * -> *) = Vessel { unVessel :: MonoidalDMap k (FlipAp g) }+newtype Vessel (k :: ((x -> *) -> *) -> *) (g :: x -> *) = Vessel { unVessel :: MonoidalDMap k (FlipAp g) }   deriving (Generic)  deriving instance (GCompare k, Has' Eq k (FlipAp g)) => Eq (Vessel k g)

@@ -1,5 +1,5 @@ name:               vessel-version:            0.2.0.0+version:            0.2.1.0 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 @@ -29,6 +29,7 @@     Data.Vessel.Identity     Data.Vessel.Internal     Data.Vessel.Map+    Data.Vessel.Path     Data.Vessel.Selectable     Data.Vessel.Single     Data.Vessel.SubVessel@@ -47,6 +48,7 @@   build-depends:       aeson                        >=1.4     && <1.6     , base                         >=4.9     && <4.15+    , base-orphans                 ^>=0.8.5     , bifunctors                   ^>=5.5     , constraints                  >=0.10    && <0.15     , constraints-extras           ^>=0.3@@ -54,14 +56,14 @@     , dependent-map                ^>=0.4     , dependent-monoidal-map       ^>=0.1.1.0     , dependent-sum                ^>=0.7-    , dependent-sum-aeson-orphans  ^>=0.3+    , dependent-sum-aeson-orphans  ^>=0.3.1     , monoidal-containers          ^>=0.6     , mtl                          ^>=2.2     , patch                        ^>=0.0.4.0     , reflex                       >=0.6.4   && <0.9     , semialign                    >=1-    , these                        ^>=1-    , witherable                   >=0.2     && <=0.3.2+    , these                        >=1 && <1.2+    , witherable                   >=0.2 && <0.5    hs-source-dirs:   src   default-language: Haskell2010