# A tutorial introduction to vessel

In this example, we're going to sketch out a blog application using vessel.

First, some preliminaries:

```haskell

module Tutorial where

import Prelude hiding (id, (.), filter)

import Control.Category
import Control.Lens
import Control.Monad
import Control.Monad.IO.Class
import Control.Monad.Fix
import Data.Aeson.GADT.TH (deriveJSONGADT)
import Data.Align
import Data.Proxy
import Data.Map (Map)
import Data.Map.Monoidal (MonoidalMap(..))
import Data.Semigroup (First(..), Max(..))
import Data.Dependent.Map (DMap)
import Data.Text (Text)
import Reflex
import Reflex.Network
import qualified Data.Map as Map
import qualified Data.Map.Merge.Strict as Map
import Data.Semigroup.Commutative

import Data.Vessel
import Data.Vessel.ViewMorphism
import Data.Vessel.Vessel
import Data.Vessel.Map
import Data.Vessel.Identity

import Data.GADT.Compare.TH
import Data.GADT.Show.TH
import Data.Constraint.Extras.TH

type PostId = Int
type Post = Text

```

Next we'll define "query" type, which captures the kinds of queries we can have...

```haskell

data Qsimple g = Qsimple
  { Qsimple g -> GrpMap PostId g
_q_posts :: GrpMap PostId g -- ^ a map from post ID's to refcounts, represents querying for that post
  , Qsimple g -> GrpMap () g
_q_latestPostId :: GrpMap () g -- ^ morally a "bool"; for if the maxPost Id is being requested.
  } deriving (Qsimple g -> Qsimple g -> Bool
(Qsimple g -> Qsimple g -> Bool)
-> (Qsimple g -> Qsimple g -> Bool) -> Eq (Qsimple g)
forall g. Eq g => Qsimple g -> Qsimple g -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Qsimple g -> Qsimple g -> Bool
$c/= :: forall g. Eq g => Qsimple g -> Qsimple g -> Bool
== :: Qsimple g -> Qsimple g -> Bool
$c== :: forall g. Eq g => Qsimple g -> Qsimple g -> Bool
Eq, Eq (Qsimple g)
Eq (Qsimple g)
-> (Qsimple g -> Qsimple g -> Ordering)
-> (Qsimple g -> Qsimple g -> Bool)
-> (Qsimple g -> Qsimple g -> Bool)
-> (Qsimple g -> Qsimple g -> Bool)
-> (Qsimple g -> Qsimple g -> Bool)
-> (Qsimple g -> Qsimple g -> Qsimple g)
-> (Qsimple g -> Qsimple g -> Qsimple g)
-> Ord (Qsimple g)
Qsimple g -> Qsimple g -> Bool
Qsimple g -> Qsimple g -> Ordering
Qsimple g -> Qsimple g -> Qsimple g
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall g. Ord g => Eq (Qsimple g)
forall g. Ord g => Qsimple g -> Qsimple g -> Bool
forall g. Ord g => Qsimple g -> Qsimple g -> Ordering
forall g. Ord g => Qsimple g -> Qsimple g -> Qsimple g
min :: Qsimple g -> Qsimple g -> Qsimple g
$cmin :: forall g. Ord g => Qsimple g -> Qsimple g -> Qsimple g
max :: Qsimple g -> Qsimple g -> Qsimple g
$cmax :: forall g. Ord g => Qsimple g -> Qsimple g -> Qsimple g
>= :: Qsimple g -> Qsimple g -> Bool
$c>= :: forall g. Ord g => Qsimple g -> Qsimple g -> Bool
> :: Qsimple g -> Qsimple g -> Bool
$c> :: forall g. Ord g => Qsimple g -> Qsimple g -> Bool
<= :: Qsimple g -> Qsimple g -> Bool
$c<= :: forall g. Ord g => Qsimple g -> Qsimple g -> Bool
< :: Qsimple g -> Qsimple g -> Bool
$c< :: forall g. Ord g => Qsimple g -> Qsimple g -> Bool
compare :: Qsimple g -> Qsimple g -> Ordering
$ccompare :: forall g. Ord g => Qsimple g -> Qsimple g -> Ordering
$cp1Ord :: forall g. Ord g => Eq (Qsimple g)
Ord, PostId -> Qsimple g -> ShowS
[Qsimple g] -> ShowS
Qsimple g -> String
(PostId -> Qsimple g -> ShowS)
-> (Qsimple g -> String)
-> ([Qsimple g] -> ShowS)
-> Show (Qsimple g)
forall g. Show g => PostId -> Qsimple g -> ShowS
forall g. Show g => [Qsimple g] -> ShowS
forall g. Show g => Qsimple g -> String
forall a.
(PostId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Qsimple g] -> ShowS
$cshowList :: forall g. Show g => [Qsimple g] -> ShowS
show :: Qsimple g -> String
$cshow :: forall g. Show g => Qsimple g -> String
showsPrec :: PostId -> Qsimple g -> ShowS
$cshowsPrec :: forall g. Show g => PostId -> Qsimple g -> ShowS
Show, ReadPrec [Qsimple g]
ReadPrec (Qsimple g)
PostId -> ReadS (Qsimple g)
ReadS [Qsimple g]
(PostId -> ReadS (Qsimple g))
-> ReadS [Qsimple g]
-> ReadPrec (Qsimple g)
-> ReadPrec [Qsimple g]
-> Read (Qsimple g)
forall g. Read g => ReadPrec [Qsimple g]
forall g. Read g => ReadPrec (Qsimple g)
forall g. Read g => PostId -> ReadS (Qsimple g)
forall g. Read g => ReadS [Qsimple g]
forall a.
(PostId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Qsimple g]
$creadListPrec :: forall g. Read g => ReadPrec [Qsimple g]
readPrec :: ReadPrec (Qsimple g)
$creadPrec :: forall g. Read g => ReadPrec (Qsimple g)
readList :: ReadS [Qsimple g]
$creadList :: forall g. Read g => ReadS [Qsimple g]
readsPrec :: PostId -> ReadS (Qsimple g)
$creadsPrec :: forall g. Read g => PostId -> ReadS (Qsimple g)
Read)

```

And the corresponding result type.  Note that we have the same set of fields occur in both.

```haskell

data Rsimple = Rsimple
  { Rsimple -> MonoidalMap PostId (First (Maybe Post))
_r_posts :: MonoidalMap PostId (First (Maybe Post)) -- ^ posts
  , Rsimple -> MonoidalMap () (Max (Maybe PostId))
_r_latestPostId :: MonoidalMap () (Max (Maybe PostId)) -- ^ the max post id;
  } deriving (Rsimple -> Rsimple -> Bool
(Rsimple -> Rsimple -> Bool)
-> (Rsimple -> Rsimple -> Bool) -> Eq Rsimple
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Rsimple -> Rsimple -> Bool
$c/= :: Rsimple -> Rsimple -> Bool
== :: Rsimple -> Rsimple -> Bool
$c== :: Rsimple -> Rsimple -> Bool
Eq, Eq Rsimple
Eq Rsimple
-> (Rsimple -> Rsimple -> Ordering)
-> (Rsimple -> Rsimple -> Bool)
-> (Rsimple -> Rsimple -> Bool)
-> (Rsimple -> Rsimple -> Bool)
-> (Rsimple -> Rsimple -> Bool)
-> (Rsimple -> Rsimple -> Rsimple)
-> (Rsimple -> Rsimple -> Rsimple)
-> Ord Rsimple
Rsimple -> Rsimple -> Bool
Rsimple -> Rsimple -> Ordering
Rsimple -> Rsimple -> Rsimple
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: Rsimple -> Rsimple -> Rsimple
$cmin :: Rsimple -> Rsimple -> Rsimple
max :: Rsimple -> Rsimple -> Rsimple
$cmax :: Rsimple -> Rsimple -> Rsimple
>= :: Rsimple -> Rsimple -> Bool
$c>= :: Rsimple -> Rsimple -> Bool
> :: Rsimple -> Rsimple -> Bool
$c> :: Rsimple -> Rsimple -> Bool
<= :: Rsimple -> Rsimple -> Bool
$c<= :: Rsimple -> Rsimple -> Bool
< :: Rsimple -> Rsimple -> Bool
$c< :: Rsimple -> Rsimple -> Bool
compare :: Rsimple -> Rsimple -> Ordering
$ccompare :: Rsimple -> Rsimple -> Ordering
$cp1Ord :: Eq Rsimple
Ord, PostId -> Rsimple -> ShowS
[Rsimple] -> ShowS
Rsimple -> String
(PostId -> Rsimple -> ShowS)
-> (Rsimple -> String) -> ([Rsimple] -> ShowS) -> Show Rsimple
forall a.
(PostId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Rsimple] -> ShowS
$cshowList :: [Rsimple] -> ShowS
show :: Rsimple -> String
$cshow :: Rsimple -> String
showsPrec :: PostId -> Rsimple -> ShowS
$cshowsPrec :: PostId -> Rsimple -> ShowS
Show, ReadPrec [Rsimple]
ReadPrec Rsimple
PostId -> ReadS Rsimple
ReadS [Rsimple]
(PostId -> ReadS Rsimple)
-> ReadS [Rsimple]
-> ReadPrec Rsimple
-> ReadPrec [Rsimple]
-> Read Rsimple
forall a.
(PostId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Rsimple]
$creadListPrec :: ReadPrec [Rsimple]
readPrec :: ReadPrec Rsimple
$creadPrec :: ReadPrec Rsimple
readList :: ReadS [Rsimple]
$creadList :: ReadS [Rsimple]
readsPrec :: PostId -> ReadS Rsimple
$creadsPrec :: PostId -> ReadS Rsimple
Read)

```
Now we end up needing to produce some boilerplate instances for our queries;
QueryT (the only "real" instance for MonadQuery) requires that the query type
be a Group.  It does this for essentially performance reasons.  If 100 widgets
have queries, and one of them "goes away", then we can either add the remaining
99 queries **or** subtract the removed query from the total for all 100 we already
have.  The latter is almost always quicker.

```haskell

instance (Eq g, Monoid g) => Semigroup (Qsimple g) where Qsimple GrpMap PostId g
x GrpMap () g
y <> :: Qsimple g -> Qsimple g -> Qsimple g
<> Qsimple GrpMap PostId g
x' GrpMap () g
y' = GrpMap PostId g -> GrpMap () g -> Qsimple g
forall g. GrpMap PostId g -> GrpMap () g -> Qsimple g
Qsimple (GrpMap PostId g
x GrpMap PostId g -> GrpMap PostId g -> GrpMap PostId g
forall a. Semigroup a => a -> a -> a
<> GrpMap PostId g
x') (GrpMap () g
y GrpMap () g -> GrpMap () g -> GrpMap () g
forall a. Semigroup a => a -> a -> a
<> GrpMap () g
y')
instance (Eq g, Monoid g) => Monoid (Qsimple g) where mempty :: Qsimple g
mempty = GrpMap PostId g -> GrpMap () g -> Qsimple g
forall g. GrpMap PostId g -> GrpMap () g -> Qsimple g
Qsimple GrpMap PostId g
forall a. Monoid a => a
mempty GrpMap () g
forall a. Monoid a => a
mempty
instance (Eq g, Group g) => Group (Qsimple g) where negateG :: Qsimple g -> Qsimple g
negateG (Qsimple GrpMap PostId g
x GrpMap () g
y) = GrpMap PostId g -> GrpMap () g -> Qsimple g
forall g. GrpMap PostId g -> GrpMap () g -> Qsimple g
Qsimple (GrpMap PostId g -> GrpMap PostId g
forall q. Group q => q -> q
negateG GrpMap PostId g
x) (GrpMap () g -> GrpMap () g
forall q. Group q => q -> q
negateG GrpMap () g
y)
instance (Eq g, Monoid g, Commutative g) => Commutative (Qsimple g)
instance GrpFunctor Qsimple where mapG :: (a -> b) -> Qsimple a -> Qsimple b
mapG a -> b
f (Qsimple GrpMap PostId a
x GrpMap () a
y) = GrpMap PostId b -> GrpMap () b -> Qsimple b
forall g. GrpMap PostId g -> GrpMap () g -> Qsimple g
Qsimple ((a -> b) -> GrpMap PostId a -> GrpMap PostId b
forall (f :: * -> *) b a.
(GrpFunctor f, Eq b, Group b) =>
(a -> b) -> f a -> f b
mapG a -> b
f GrpMap PostId a
x) ((a -> b) -> GrpMap () a -> GrpMap () b
forall (f :: * -> *) b a.
(GrpFunctor f, Eq b, Group b) =>
(a -> b) -> f a -> f b
mapG a -> b
f GrpMap () a
y)

```

MonadQuery Also requires that QueryResult be a monoid;  this reflects the idea
that the result can be updated as new data is sent to the frontend; with
"updates" being appended to the left.  That's the reason for the First and Max
values above.

Those are also the reason for the Maybe wrappers in both cases,  it's
necessary to distinguish the two states of "the data is absent because it
doesn't exist in the backend" from "the data is absent because you haven't
received it yet".

```haskell

instance Semigroup Rsimple where Rsimple MonoidalMap PostId (First (Maybe Post))
posts MonoidalMap () (Max (Maybe PostId))
maxId <> :: Rsimple -> Rsimple -> Rsimple
<> Rsimple MonoidalMap PostId (First (Maybe Post))
posts' MonoidalMap () (Max (Maybe PostId))
maxId' = MonoidalMap PostId (First (Maybe Post))
-> MonoidalMap () (Max (Maybe PostId)) -> Rsimple
Rsimple (MonoidalMap PostId (First (Maybe Post))
posts MonoidalMap PostId (First (Maybe Post))
-> MonoidalMap PostId (First (Maybe Post))
-> MonoidalMap PostId (First (Maybe Post))
forall a. Semigroup a => a -> a -> a
<> MonoidalMap PostId (First (Maybe Post))
posts') (MonoidalMap () (Max (Maybe PostId))
maxId MonoidalMap () (Max (Maybe PostId))
-> MonoidalMap () (Max (Maybe PostId))
-> MonoidalMap () (Max (Maybe PostId))
forall a. Semigroup a => a -> a -> a
<> MonoidalMap () (Max (Maybe PostId))
maxId')
instance Monoid Rsimple where { mempty :: Rsimple
mempty = MonoidalMap PostId (First (Maybe Post))
-> MonoidalMap () (Max (Maybe PostId)) -> Rsimple
Rsimple MonoidalMap PostId (First (Maybe Post))
forall a. Monoid a => a
mempty MonoidalMap () (Max (Maybe PostId))
forall a. Monoid a => a
mempty }

```

We associate the two types, query and response, with Query;  which is also
essentially boilerplate code.  The single method for Query; crop, should
restrict the query result to only that which matches the query.  Crop has two
essential duties.  It's used in query handlers that call runQueryT.

```haskell

instance Query (Qsimple g) where
  type QueryResult (Qsimple g) = Rsimple
  crop :: Qsimple g -> QueryResult (Qsimple g) -> QueryResult (Qsimple g)
crop (Qsimple GrpMap PostId g
postsQ GrpMap () g
maxIdQ) (Rsimple postsR maxIdR) = MonoidalMap PostId (First (Maybe Post))
-> MonoidalMap () (Max (Maybe PostId)) -> Rsimple
Rsimple (GrpMap PostId g
-> MonoidalMap PostId (First (Maybe Post))
-> MonoidalMap PostId (First (Maybe Post))
forall k b a.
Ord k =>
GrpMap k b -> MonoidalMap k a -> MonoidalMap k a
cropMap GrpMap PostId g
postsQ MonoidalMap PostId (First (Maybe Post))
postsR) (GrpMap () g
-> MonoidalMap () (Max (Maybe PostId))
-> MonoidalMap () (Max (Maybe PostId))
forall k b a.
Ord k =>
GrpMap k b -> MonoidalMap k a -> MonoidalMap k a
cropMap GrpMap () g
maxIdQ MonoidalMap () (Max (Maybe PostId))
maxIdR)
    where cropMap :: GrpMap k b -> MonoidalMap k a -> MonoidalMap k a
cropMap GrpMap k b
q MonoidalMap k a
r = Map k a -> MonoidalMap k a
forall k a. Map k a -> MonoidalMap k a
MonoidalMap (Map k a -> MonoidalMap k a) -> Map k a -> MonoidalMap k a
forall a b. (a -> b) -> a -> b
$ Map k a -> Map k b -> Map k a
forall k a b. Ord k => Map k a -> Map k b -> Map k a
Map.intersection (MonoidalMap k a -> Map k a
forall k a. MonoidalMap k a -> Map k a
getMonoidalMap MonoidalMap k a
r) (GrpMap k b -> Map k b
forall k v. GrpMap k v -> Map k v
unGrpMap GrpMap k b
q)

```

We now can write code that "queries" for posts.  Note that the distinction
between "not yet loaded" and "doesnt exist at all" is reflected in two
different Maybe's.  Resist the urge to "join" the two together.  That's a sure
recipe for annoying glitches which flash "deleted" right before showing the
user their data.

Once again we see some amount of boilerplate; we construct the query by
building up from the given field; and then need to tear down the query result
by examining the corresponding field.

```haskell

watchPost 
  :: ( MonadQuery t (Qsimple SelectedCount) m
     , QueryResult (Qsimple SelectedCount) ~ Rsimple
     , Reflex t
     , Monad m
     )
  => Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
watchPost :: Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
watchPost Dynamic t PostId
postIds = do
  Dynamic t Rsimple
queryResult <- Dynamic t (Qsimple SelectedCount)
-> m (Dynamic t (QueryResult (Qsimple SelectedCount)))
forall t q (m :: * -> *).
(Reflex t, MonadQuery t q m) =>
Dynamic t q -> m (Dynamic t (QueryResult q))
queryDyn (Dynamic t (Qsimple SelectedCount)
 -> m (Dynamic t (QueryResult (Qsimple SelectedCount))))
-> Dynamic t (Qsimple SelectedCount)
-> m (Dynamic t (QueryResult (Qsimple SelectedCount)))
forall a b. (a -> b) -> a -> b
$ Dynamic t PostId
-> (PostId -> Qsimple SelectedCount)
-> Dynamic t (Qsimple SelectedCount)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t PostId
postIds ((PostId -> Qsimple SelectedCount)
 -> Dynamic t (Qsimple SelectedCount))
-> (PostId -> Qsimple SelectedCount)
-> Dynamic t (Qsimple SelectedCount)
forall a b. (a -> b) -> a -> b
$ \PostId
postId -> Qsimple SelectedCount
forall a. Monoid a => a
mempty { _q_posts :: GrpMap PostId SelectedCount
_q_posts = Map PostId SelectedCount -> GrpMap PostId SelectedCount
forall k v. Map k v -> GrpMap k v
GrpMap (PostId -> SelectedCount -> Map PostId SelectedCount
forall k a. k -> a -> Map k a
Map.singleton PostId
postId SelectedCount
1) }
  Dynamic t (Maybe (Maybe Post))
-> m (Dynamic t (Maybe (Maybe Post)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t (Maybe (Maybe Post))
 -> m (Dynamic t (Maybe (Maybe Post))))
-> Dynamic t (Maybe (Maybe Post))
-> m (Dynamic t (Maybe (Maybe Post)))
forall a b. (a -> b) -> a -> b
$ Dynamic t PostId
-> Dynamic t Rsimple
-> (PostId -> Rsimple -> Maybe (Maybe Post))
-> Dynamic t (Maybe (Maybe Post))
forall (f :: * -> *) a b c.
Applicative f =>
f a -> f b -> (a -> b -> c) -> f c
ffor2 Dynamic t PostId
postIds Dynamic t Rsimple
queryResult ((PostId -> Rsimple -> Maybe (Maybe Post))
 -> Dynamic t (Maybe (Maybe Post)))
-> (PostId -> Rsimple -> Maybe (Maybe Post))
-> Dynamic t (Maybe (Maybe Post))
forall a b. (a -> b) -> a -> b
$ \PostId
postId Rsimple
r -> First (Maybe Post) -> Maybe Post
forall a. First a -> a
getFirst (First (Maybe Post) -> Maybe Post)
-> Maybe (First (Maybe Post)) -> Maybe (Maybe Post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Maybe (First (Maybe Post)))
  (MonoidalMap PostId (First (Maybe Post)))
  (Maybe (First (Maybe Post)))
-> MonoidalMap PostId (First (Maybe Post))
-> Maybe (First (Maybe Post))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Index (MonoidalMap PostId (First (Maybe Post)))
-> Lens'
     (MonoidalMap PostId (First (Maybe Post)))
     (Maybe (IxValue (MonoidalMap PostId (First (Maybe Post)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at PostId
Index (MonoidalMap PostId (First (Maybe Post)))
postId) (Rsimple -> MonoidalMap PostId (First (Maybe Post))
_r_posts Rsimple
r)

watchLatestPostId
  :: ( MonadQuery t (Qsimple SelectedCount) m
     , QueryResult (Qsimple SelectedCount) ~ Rsimple
     , Reflex t
     , Monad m
     )
  => m (Dynamic t (Maybe (Maybe PostId)))
watchLatestPostId :: m (Dynamic t (Maybe (Maybe PostId)))
watchLatestPostId = do
  Dynamic t Rsimple
queryResult <- Dynamic t (Qsimple SelectedCount)
-> m (Dynamic t (QueryResult (Qsimple SelectedCount)))
forall t q (m :: * -> *).
(Reflex t, MonadQuery t q m) =>
Dynamic t q -> m (Dynamic t (QueryResult q))
queryDyn (Dynamic t (Qsimple SelectedCount)
 -> m (Dynamic t (QueryResult (Qsimple SelectedCount))))
-> Dynamic t (Qsimple SelectedCount)
-> m (Dynamic t (QueryResult (Qsimple SelectedCount)))
forall a b. (a -> b) -> a -> b
$ Qsimple SelectedCount -> Dynamic t (Qsimple SelectedCount)
forall k (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (Qsimple SelectedCount -> Dynamic t (Qsimple SelectedCount))
-> Qsimple SelectedCount -> Dynamic t (Qsimple SelectedCount)
forall a b. (a -> b) -> a -> b
$  Qsimple SelectedCount
forall a. Monoid a => a
mempty { _q_latestPostId :: GrpMap () SelectedCount
_q_latestPostId = Map () SelectedCount -> GrpMap () SelectedCount
forall k v. Map k v -> GrpMap k v
GrpMap (() -> SelectedCount -> Map () SelectedCount
forall k a. k -> a -> Map k a
Map.singleton () SelectedCount
1) }
  Dynamic t (Maybe (Maybe PostId))
-> m (Dynamic t (Maybe (Maybe PostId)))
forall (m :: * -> *) a. Monad m => a -> m a
return (Dynamic t (Maybe (Maybe PostId))
 -> m (Dynamic t (Maybe (Maybe PostId))))
-> Dynamic t (Maybe (Maybe PostId))
-> m (Dynamic t (Maybe (Maybe PostId)))
forall a b. (a -> b) -> a -> b
$ Dynamic t Rsimple
-> (Rsimple -> Maybe (Maybe PostId))
-> Dynamic t (Maybe (Maybe PostId))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t Rsimple
queryResult ((Rsimple -> Maybe (Maybe PostId))
 -> Dynamic t (Maybe (Maybe PostId)))
-> (Rsimple -> Maybe (Maybe PostId))
-> Dynamic t (Maybe (Maybe PostId))
forall a b. (a -> b) -> a -> b
$ \Rsimple
r -> Max (Maybe PostId) -> Maybe PostId
forall a. Max a -> a
getMax (Max (Maybe PostId) -> Maybe PostId)
-> Maybe (Max (Maybe PostId)) -> Maybe (Maybe PostId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Getting
  (Maybe (Max (Maybe PostId)))
  (MonoidalMap () (Max (Maybe PostId)))
  (Maybe (Max (Maybe PostId)))
-> MonoidalMap () (Max (Maybe PostId))
-> Maybe (Max (Maybe PostId))
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Index (MonoidalMap () (Max (Maybe PostId)))
-> Lens'
     (MonoidalMap () (Max (Maybe PostId)))
     (Maybe (IxValue (MonoidalMap () (Max (Maybe PostId)))))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at ()) (Rsimple -> MonoidalMap () (Max (Maybe PostId))
_r_latestPostId Rsimple
r)

displayLatestPost
  :: ( MonadHold t m
     , MonadFix m
     , MonadQuery t (Qsimple SelectedCount) m
     , QueryResult (Qsimple SelectedCount) ~ Rsimple
     , Reflex t
     , PostBuild t m
     , Widget t m
     )
  => m ()
displayLatestPost :: m ()
displayLatestPost = do
  Dynamic t (Maybe (Dynamic t (Maybe PostId)))
mdmId <- Dynamic t (Maybe (Maybe PostId))
-> m (Dynamic t (Maybe (Dynamic t (Maybe PostId))))
forall k (t :: k) a (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn (Dynamic t (Maybe (Maybe PostId))
 -> m (Dynamic t (Maybe (Dynamic t (Maybe PostId)))))
-> m (Dynamic t (Maybe (Maybe PostId)))
-> m (Dynamic t (Maybe (Dynamic t (Maybe PostId))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< m (Dynamic t (Maybe (Maybe PostId)))
forall t (m :: * -> *).
(MonadQuery t (Qsimple SelectedCount) m,
 QueryResult (Qsimple SelectedCount) ~ Rsimple, Reflex t,
 Monad m) =>
m (Dynamic t (Maybe (Maybe PostId)))
watchLatestPostId
  Dynamic t (m ()) -> m ()
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m ()
dyn_ (Dynamic t (m ()) -> m ()) -> Dynamic t (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Maybe (Dynamic t (Maybe PostId)))
-> (Maybe (Dynamic t (Maybe PostId)) -> m ()) -> Dynamic t (m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe (Dynamic t (Maybe PostId)))
mdmId ((Maybe (Dynamic t (Maybe PostId)) -> m ()) -> Dynamic t (m ()))
-> (Maybe (Dynamic t (Maybe PostId)) -> m ()) -> Dynamic t (m ())
forall a b. (a -> b) -> a -> b
$ \case
    Maybe (Dynamic t (Maybe PostId))
Nothing -> Post -> m ()
forall (m :: * -> *). Monad m => Post -> m ()
text Post
"Loading ..."
    Just Dynamic t (Maybe PostId)
dmId -> do
      Dynamic t (Maybe (Dynamic t PostId))
mdId <- Dynamic t (Maybe PostId)
-> m (Dynamic t (Maybe (Dynamic t PostId)))
forall k (t :: k) a (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn Dynamic t (Maybe PostId)
dmId
      Dynamic t (m ()) -> m ()
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m ()
dyn_ (Dynamic t (m ()) -> m ()) -> Dynamic t (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Maybe (Dynamic t PostId))
-> (Maybe (Dynamic t PostId) -> m ()) -> Dynamic t (m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe (Dynamic t PostId))
mdId ((Maybe (Dynamic t PostId) -> m ()) -> Dynamic t (m ()))
-> (Maybe (Dynamic t PostId) -> m ()) -> Dynamic t (m ())
forall a b. (a -> b) -> a -> b
$ \case
        Maybe (Dynamic t PostId)
Nothing -> Post -> m ()
forall (m :: * -> *). Monad m => Post -> m ()
text Post
"No posts found"
        Just Dynamic t PostId
dId -> Dynamic t PostId -> m ()
forall t (m :: * -> *).
(MonadQuery t (Qsimple SelectedCount) m,
 QueryResult (Qsimple SelectedCount) ~ Rsimple, PostBuild t m,
 MonadHold t m, MonadFix m, Widget t m) =>
Dynamic t PostId -> m ()
displayPost Dynamic t PostId
dId

displayPost
  :: ( MonadQuery t (Qsimple SelectedCount) m
     , QueryResult (Qsimple SelectedCount) ~ Rsimple
     , PostBuild t m
     , MonadHold t m
     , MonadFix m
     , Widget t m
     )
  => Dynamic t PostId -> m ()
displayPost :: Dynamic t PostId -> m ()
displayPost Dynamic t PostId
postId = do
  Dynamic t (Maybe (Dynamic t (Maybe Post)))
mdmPost <- Dynamic t (Maybe (Maybe Post))
-> m (Dynamic t (Maybe (Dynamic t (Maybe Post))))
forall k (t :: k) a (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn (Dynamic t (Maybe (Maybe Post))
 -> m (Dynamic t (Maybe (Dynamic t (Maybe Post)))))
-> m (Dynamic t (Maybe (Maybe Post)))
-> m (Dynamic t (Maybe (Dynamic t (Maybe Post))))
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
forall t (m :: * -> *).
(MonadQuery t (Qsimple SelectedCount) m,
 QueryResult (Qsimple SelectedCount) ~ Rsimple, Reflex t,
 Monad m) =>
Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
watchPost Dynamic t PostId
postId
  Dynamic t (m ()) -> m ()
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m ()
dyn_ (Dynamic t (m ()) -> m ()) -> Dynamic t (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Maybe (Dynamic t (Maybe Post)))
-> (Maybe (Dynamic t (Maybe Post)) -> m ()) -> Dynamic t (m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe (Dynamic t (Maybe Post)))
mdmPost ((Maybe (Dynamic t (Maybe Post)) -> m ()) -> Dynamic t (m ()))
-> (Maybe (Dynamic t (Maybe Post)) -> m ()) -> Dynamic t (m ())
forall a b. (a -> b) -> a -> b
$ \case
    Maybe (Dynamic t (Maybe Post))
Nothing -> Post -> m ()
forall (m :: * -> *). Monad m => Post -> m ()
text Post
"Loading post ..."
    Just Dynamic t (Maybe Post)
dmPost -> do
      Dynamic t (Maybe (Dynamic t Post))
mdPost <- Dynamic t (Maybe Post) -> m (Dynamic t (Maybe (Dynamic t Post)))
forall k (t :: k) a (m :: * -> *).
(Reflex t, MonadFix m, MonadHold t m) =>
Dynamic t (Maybe a) -> m (Dynamic t (Maybe (Dynamic t a)))
maybeDyn Dynamic t (Maybe Post)
dmPost
      Dynamic t (m ()) -> m ()
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m ()
dyn_ (Dynamic t (m ()) -> m ()) -> Dynamic t (m ()) -> m ()
forall a b. (a -> b) -> a -> b
$ Dynamic t (Maybe (Dynamic t Post))
-> (Maybe (Dynamic t Post) -> m ()) -> Dynamic t (m ())
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t (Maybe (Dynamic t Post))
mdPost ((Maybe (Dynamic t Post) -> m ()) -> Dynamic t (m ()))
-> (Maybe (Dynamic t Post) -> m ()) -> Dynamic t (m ())
forall a b. (a -> b) -> a -> b
$ \case
        Maybe (Dynamic t Post)
Nothing -> Post -> m ()
forall (m :: * -> *). Monad m => Post -> m ()
text Post
"Post Not Found"
        Just Dynamic t Post
dPost -> Dynamic t Post -> m ()
forall (m :: * -> *) t. Monad m => Dynamic t Post -> m ()
dynText Dynamic t Post
dPost

```

We can try to improve the situation in essentially all of
these cases above by factoring out the common parts using
something resembling the HKD Pattern; when we need to
associate a group with each query; we can use `Const g`; and
for the result which demands only the result data for that
key, we can use Identity. A downside is boilerplate
instances, even ones that can normally be derived.

```haskell

data Qhkd (f :: * -> *) = Qhkd
  { Qhkd f -> MonoidalMap PostId (f (First (Maybe Post)))
_qhkd_posts :: MonoidalMap PostId (f (First (Maybe Post))) -- ^ posts
  , Qhkd f -> MonoidalMap () (f (Max (Maybe PostId)))
_qhkd_latestPostId :: MonoidalMap () (f (Max (Maybe PostId))) -- ^ the max post id;
  }

type Qhkd_query g = Qhkd (Const g)
type Qhkd_response = Qhkd Identity

```

We can instead observe the pattern that "most" of the shape of a record of
queries/responses can be  decomposed into products of maps.  Another way of
expressing the same concept is with a DMap.  with this approach:

```haskell

data Qtag (a :: *) where
  Qtag_Posts        :: PostId -> Qtag (First (Maybe Post))
  Qtag_LatestPostId :: Qtag (Max (Maybe PostId))

type Qtag_query g = DMap Qtag (Const g)
type Qtag_response = DMap Qtag Identity

```

Vessel takes this idea a bit further; where the above approach uses parameters
as values, vessel makes it "recursive";  the GADTs used have "functor"
parameters, and most of the applied types are also functor parametric.

```haskell

data Qvessel (v :: (* -> *) -> *) where
  Posts        :: Qvessel (MapV PostId (First (Maybe Post)))
  LatestPostId :: Qvessel (IdentityV (Max (Maybe PostId)))

```
Using this sort of construction allows us to eliminate nearly all of the
boilerplate; there's a small amount of TH to derive GCompare and all of the
remaining instances follow from the view types in vessel:

```haskell

viewPost :: (MonadQuery t (Vessel Qvessel (Const SelectedCount)) m, Reflex t, Monad m)
  => Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
viewPost :: Dynamic t PostId -> m (Dynamic t (Maybe (Maybe Post)))
viewPost Dynamic t PostId
postIds = ((Dynamic t (Maybe (Identity (First (Maybe Post))))
 -> Dynamic t (Maybe (Maybe Post)))
-> m (Dynamic t (Maybe (Identity (First (Maybe Post)))))
-> m (Dynamic t (Maybe (Maybe Post)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Dynamic t (Maybe (Identity (First (Maybe Post))))
  -> Dynamic t (Maybe (Maybe Post)))
 -> m (Dynamic t (Maybe (Identity (First (Maybe Post)))))
 -> m (Dynamic t (Maybe (Maybe Post))))
-> ((Identity (First (Maybe Post)) -> Maybe Post)
    -> Dynamic t (Maybe (Identity (First (Maybe Post))))
    -> Dynamic t (Maybe (Maybe Post)))
-> (Identity (First (Maybe Post)) -> Maybe Post)
-> m (Dynamic t (Maybe (Identity (First (Maybe Post)))))
-> m (Dynamic t (Maybe (Maybe Post)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.(Maybe (Identity (First (Maybe Post))) -> Maybe (Maybe Post))
-> Dynamic t (Maybe (Identity (First (Maybe Post))))
-> Dynamic t (Maybe (Maybe Post))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe (Identity (First (Maybe Post))) -> Maybe (Maybe Post))
 -> Dynamic t (Maybe (Identity (First (Maybe Post))))
 -> Dynamic t (Maybe (Maybe Post)))
-> ((Identity (First (Maybe Post)) -> Maybe Post)
    -> Maybe (Identity (First (Maybe Post))) -> Maybe (Maybe Post))
-> (Identity (First (Maybe Post)) -> Maybe Post)
-> Dynamic t (Maybe (Identity (First (Maybe Post))))
-> Dynamic t (Maybe (Maybe Post))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.(Identity (First (Maybe Post)) -> Maybe Post)
-> Maybe (Identity (First (Maybe Post))) -> Maybe (Maybe Post)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (First (Maybe Post) -> Maybe Post
forall a. First a -> a
getFirst (First (Maybe Post) -> Maybe Post)
-> (Identity (First (Maybe Post)) -> First (Maybe Post))
-> Identity (First (Maybe Post))
-> Maybe Post
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity (First (Maybe Post)) -> First (Maybe Post)
forall a. Identity a -> a
runIdentity) (m (Dynamic t (Maybe (Identity (First (Maybe Post)))))
 -> m (Dynamic t (Maybe (Maybe Post))))
-> m (Dynamic t (Maybe (Identity (First (Maybe Post)))))
-> m (Dynamic t (Maybe (Maybe Post)))
forall a b. (a -> b) -> a -> b
$ Const SelectedCount (First (Maybe Post))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (First (Maybe Post)))
        (Vessel Qvessel (Const SelectedCount)))
-> m (Dynamic
        t
        (Maybe
           (ViewQueryResult (Const SelectedCount (First (Maybe Post))))))
forall t p q (m :: * -> *) (partial :: * -> *).
(Reflex t, MonadQuery t q m, Monad m,
 QueryResult q ~ ViewQueryResult q) =>
p
-> Dynamic t (ViewMorphism Identity partial p q)
-> m (Dynamic t (partial (ViewQueryResult p)))
queryViewMorphism Const SelectedCount (First (Maybe Post))
1 (Dynamic
   t
   (ViewMorphism
      Identity
      Maybe
      (Const SelectedCount (First (Maybe Post)))
      (Vessel Qvessel (Const SelectedCount)))
 -> m (Dynamic
         t
         (Maybe
            (ViewQueryResult (Const SelectedCount (First (Maybe Post)))))))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (First (Maybe Post)))
        (Vessel Qvessel (Const SelectedCount)))
-> m (Dynamic
        t
        (Maybe
           (ViewQueryResult (Const SelectedCount (First (Maybe Post))))))
forall a b. (a -> b) -> a -> b
$ Dynamic t PostId
-> (PostId
    -> ViewMorphism
         Identity
         Maybe
         (Const SelectedCount (First (Maybe Post)))
         (Vessel Qvessel (Const SelectedCount)))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (First (Maybe Post)))
        (Vessel Qvessel (Const SelectedCount)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
ffor Dynamic t PostId
postIds ((PostId
  -> ViewMorphism
       Identity
       Maybe
       (Const SelectedCount (First (Maybe Post)))
       (Vessel Qvessel (Const SelectedCount)))
 -> Dynamic
      t
      (ViewMorphism
         Identity
         Maybe
         (Const SelectedCount (First (Maybe Post)))
         (Vessel Qvessel (Const SelectedCount))))
-> (PostId
    -> ViewMorphism
         Identity
         Maybe
         (Const SelectedCount (First (Maybe Post)))
         (Vessel Qvessel (Const SelectedCount)))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (First (Maybe Post)))
        (Vessel Qvessel (Const SelectedCount)))
forall a b. (a -> b) -> a -> b
$ \PostId
pid -> Qvessel (MapV PostId (First (Maybe Post)))
-> ViewMorphism
     Identity
     Maybe
     (MapV PostId (First (Maybe Post)) (Const SelectedCount))
     (Vessel Qvessel (Const SelectedCount))
forall x (k :: ((x -> *) -> *) -> *) (v :: (x -> *) -> *)
       (g :: x -> *) (n :: * -> *) (m :: * -> *).
(GCompare k, ViewQueryResult (v g) ~ v (ViewQueryResult g), View v,
 Alternative n, Applicative m) =>
k v -> ViewMorphism m n (v g) (Vessel k g)
vessel Qvessel (MapV PostId (First (Maybe Post)))
Posts ViewMorphism
  Identity
  Maybe
  (MapV PostId (First (Maybe Post)) (Const SelectedCount))
  (Vessel Qvessel (Const SelectedCount))
-> ViewMorphism
     Identity
     Maybe
     (Const SelectedCount (First (Maybe Post)))
     (MapV PostId (First (Maybe Post)) (Const SelectedCount))
-> ViewMorphism
     Identity
     Maybe
     (Const SelectedCount (First (Maybe Post)))
     (Vessel Qvessel (Const SelectedCount))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. PostId
-> ViewMorphism
     Identity
     Maybe
     (Const SelectedCount (First (Maybe Post)))
     (MapV PostId (First (Maybe Post)) (Const SelectedCount))
forall k1 k2 (g :: k1 -> *) (v :: k1) (n :: * -> *) (m :: * -> *).
(Ord k2, ViewQueryResult (g v) ~ ViewQueryResult g v,
 Alternative n, Applicative m) =>
k2 -> ViewMorphism m n (g v) (MapV k2 v g)
mapVMorphism PostId
pid

viewLatestPostId :: (MonadQuery t (Vessel Qvessel (Const SelectedCount)) m, Reflex t, Monad m)
  => m (Dynamic t (Maybe (Maybe PostId)))
viewLatestPostId :: m (Dynamic t (Maybe (Maybe PostId)))
viewLatestPostId = ((Dynamic t (Maybe (Identity (Max (Maybe PostId))))
 -> Dynamic t (Maybe (Maybe PostId)))
-> m (Dynamic t (Maybe (Identity (Max (Maybe PostId)))))
-> m (Dynamic t (Maybe (Maybe PostId)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Dynamic t (Maybe (Identity (Max (Maybe PostId))))
  -> Dynamic t (Maybe (Maybe PostId)))
 -> m (Dynamic t (Maybe (Identity (Max (Maybe PostId)))))
 -> m (Dynamic t (Maybe (Maybe PostId))))
-> ((Identity (Max (Maybe PostId)) -> Maybe PostId)
    -> Dynamic t (Maybe (Identity (Max (Maybe PostId))))
    -> Dynamic t (Maybe (Maybe PostId)))
-> (Identity (Max (Maybe PostId)) -> Maybe PostId)
-> m (Dynamic t (Maybe (Identity (Max (Maybe PostId)))))
-> m (Dynamic t (Maybe (Maybe PostId)))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.(Maybe (Identity (Max (Maybe PostId))) -> Maybe (Maybe PostId))
-> Dynamic t (Maybe (Identity (Max (Maybe PostId))))
-> Dynamic t (Maybe (Maybe PostId))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap((Maybe (Identity (Max (Maybe PostId))) -> Maybe (Maybe PostId))
 -> Dynamic t (Maybe (Identity (Max (Maybe PostId))))
 -> Dynamic t (Maybe (Maybe PostId)))
-> ((Identity (Max (Maybe PostId)) -> Maybe PostId)
    -> Maybe (Identity (Max (Maybe PostId))) -> Maybe (Maybe PostId))
-> (Identity (Max (Maybe PostId)) -> Maybe PostId)
-> Dynamic t (Maybe (Identity (Max (Maybe PostId))))
-> Dynamic t (Maybe (Maybe PostId))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
.(Identity (Max (Maybe PostId)) -> Maybe PostId)
-> Maybe (Identity (Max (Maybe PostId))) -> Maybe (Maybe PostId)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap) (Max (Maybe PostId) -> Maybe PostId
forall a. Max a -> a
getMax (Max (Maybe PostId) -> Maybe PostId)
-> (Identity (Max (Maybe PostId)) -> Max (Maybe PostId))
-> Identity (Max (Maybe PostId))
-> Maybe PostId
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Identity (Max (Maybe PostId)) -> Max (Maybe PostId)
forall a. Identity a -> a
runIdentity) (m (Dynamic t (Maybe (Identity (Max (Maybe PostId)))))
 -> m (Dynamic t (Maybe (Maybe PostId))))
-> m (Dynamic t (Maybe (Identity (Max (Maybe PostId)))))
-> m (Dynamic t (Maybe (Maybe PostId)))
forall a b. (a -> b) -> a -> b
$ Const SelectedCount (Max (Maybe PostId))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (Max (Maybe PostId)))
        (Vessel Qvessel (Const SelectedCount)))
-> m (Dynamic
        t
        (Maybe
           (ViewQueryResult (Const SelectedCount (Max (Maybe PostId))))))
forall t p q (m :: * -> *) (partial :: * -> *).
(Reflex t, MonadQuery t q m, Monad m,
 QueryResult q ~ ViewQueryResult q) =>
p
-> Dynamic t (ViewMorphism Identity partial p q)
-> m (Dynamic t (partial (ViewQueryResult p)))
queryViewMorphism Const SelectedCount (Max (Maybe PostId))
1 (Dynamic
   t
   (ViewMorphism
      Identity
      Maybe
      (Const SelectedCount (Max (Maybe PostId)))
      (Vessel Qvessel (Const SelectedCount)))
 -> m (Dynamic
         t
         (Maybe
            (ViewQueryResult (Const SelectedCount (Max (Maybe PostId)))))))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (Max (Maybe PostId)))
        (Vessel Qvessel (Const SelectedCount)))
-> m (Dynamic
        t
        (Maybe
           (ViewQueryResult (Const SelectedCount (Max (Maybe PostId))))))
forall a b. (a -> b) -> a -> b
$ ViewMorphism
  Identity
  Maybe
  (Const SelectedCount (Max (Maybe PostId)))
  (Vessel Qvessel (Const SelectedCount))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (Max (Maybe PostId)))
        (Vessel Qvessel (Const SelectedCount)))
forall k (t :: k) a. Reflex t => a -> Dynamic t a
constDyn (ViewMorphism
   Identity
   Maybe
   (Const SelectedCount (Max (Maybe PostId)))
   (Vessel Qvessel (Const SelectedCount))
 -> Dynamic
      t
      (ViewMorphism
         Identity
         Maybe
         (Const SelectedCount (Max (Maybe PostId)))
         (Vessel Qvessel (Const SelectedCount))))
-> ViewMorphism
     Identity
     Maybe
     (Const SelectedCount (Max (Maybe PostId)))
     (Vessel Qvessel (Const SelectedCount))
-> Dynamic
     t
     (ViewMorphism
        Identity
        Maybe
        (Const SelectedCount (Max (Maybe PostId)))
        (Vessel Qvessel (Const SelectedCount)))
forall a b. (a -> b) -> a -> b
$ Qvessel (IdentityV (Max (Maybe PostId)))
-> ViewMorphism
     Identity
     Maybe
     (IdentityV (Max (Maybe PostId)) (Const SelectedCount))
     (Vessel Qvessel (Const SelectedCount))
forall x (k :: ((x -> *) -> *) -> *) (v :: (x -> *) -> *)
       (g :: x -> *) (n :: * -> *) (m :: * -> *).
(GCompare k, ViewQueryResult (v g) ~ v (ViewQueryResult g), View v,
 Alternative n, Applicative m) =>
k v -> ViewMorphism m n (v g) (Vessel k g)
vessel Qvessel (IdentityV (Max (Maybe PostId)))
LatestPostId ViewMorphism
  Identity
  Maybe
  (IdentityV (Max (Maybe PostId)) (Const SelectedCount))
  (Vessel Qvessel (Const SelectedCount))
-> ViewMorphism
     Identity
     Maybe
     (Const SelectedCount (Max (Maybe PostId)))
     (IdentityV (Max (Maybe PostId)) (Const SelectedCount))
-> ViewMorphism
     Identity
     Maybe
     (Const SelectedCount (Max (Maybe PostId)))
     (Vessel Qvessel (Const SelectedCount))
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. ViewMorphism
  Identity
  Maybe
  (Const SelectedCount (Max (Maybe PostId)))
  (IdentityV (Max (Maybe PostId)) (Const SelectedCount))
forall (m :: * -> *) (n :: * -> *) g a.
(Applicative m, Applicative n) =>
ViewMorphism m n (Const g a) (IdentityV a (Const g))
identityV

```
Feel free to ignore everything below this line; this is just to force me to get
other types "right".

***

```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_ :: Dynamic t (m a) -> m ()
dyn_ = m (Event t a) -> m ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (m (Event t a) -> m ())
-> (Dynamic t (m a) -> m (Event t a)) -> Dynamic t (m a) -> m ()
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Dynamic t (m a) -> m (Event t a)
forall t (m :: * -> *) a.
(NotReady t m, Adjustable t m, PostBuild t m) =>
Dynamic t (m a) -> m (Event t a)
networkView

text :: Monad m => Text -> m ()
text :: Post -> m ()
text Post
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

dynText :: Monad m => Dynamic t Text -> m ()
dynText :: Dynamic t Post -> m ()
dynText Dynamic t Post
_ = () -> m ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

positive :: forall x. (Monoid x, Ord x) => x -> SelectedCount
positive :: x -> SelectedCount
positive x
x
  | x
x x -> x -> Bool
forall a. Ord a => a -> a -> Bool
> x
forall a. Monoid a => a
mempty = SelectedCount
1
  | Bool
otherwise = SelectedCount
0


dischargeMonadQuery :: forall v t m a.
  ( Commutative (v SelectedCount), Group (v SelectedCount), PerformEvent t m, GrpFunctor v, Eq (v SelectedCount)
  , Monoid (QueryResult (v SelectedCount)), PostBuild t m, MonadHold t m, MonadFix m, Widget t m
  , Query (v SelectedCount)
  )
  => (v SelectedCount -> Performable m (QueryResult (v SelectedCount)))
  -> (forall m'. (PostBuild t m', MonadHold t m', Widget t m', MonadFix m', MonadQuery t (v SelectedCount) m') => m' a)
  -> m a
dischargeMonadQuery :: (v SelectedCount -> Performable m (QueryResult (v SelectedCount)))
-> (forall (m' :: * -> *).
    (PostBuild t m', MonadHold t m', Widget t m', MonadFix m',
     MonadQuery t (v SelectedCount) m') =>
    m' a)
-> m a
dischargeMonadQuery v SelectedCount -> Performable m (QueryResult (v SelectedCount))
getQueryResult forall (m' :: * -> *).
(PostBuild t m', MonadHold t m', Widget t m', MonadFix m',
 MonadQuery t (v SelectedCount) m') =>
m' a
widget = mdo

  ( a
result
    , Incremental t (AdditivePatch (v SelectedCount))
iVS :: Incremental t (AdditivePatch (v SelectedCount))
    ) <- QueryT t (v SelectedCount) m a
-> Dynamic t (QueryResult (v SelectedCount))
-> m (a, Incremental t (AdditivePatch (v SelectedCount)))
forall (m :: * -> *) q t a.
(MonadFix m, Commutative q, Group q, Reflex t) =>
QueryT t q m a
-> Dynamic t (QueryResult q)
-> m (a, Incremental t (AdditivePatch q))
runQueryT QueryT t (v SelectedCount) m a
forall (m' :: * -> *).
(PostBuild t m', MonadHold t m', Widget t m', MonadFix m',
 MonadQuery t (v SelectedCount) m') =>
m' a
widget Dynamic t (QueryResult (v SelectedCount))
v_t
  let
    Dynamic t (v SelectedCount)
vs_t :: Dynamic t (v SelectedCount) = Incremental t (AdditivePatch (v SelectedCount))
-> Dynamic t (PatchTarget (AdditivePatch (v SelectedCount)))
forall k (t :: k) p.
(Reflex t, Patch p) =>
Incremental t p -> Dynamic t (PatchTarget p)
incrementalToDynamic Incremental t (AdditivePatch (v SelectedCount))
iVS
    Event t (v SelectedCount)
dvs :: Event t (v SelectedCount) = Behavior t (v SelectedCount)
-> Event t (v SelectedCount)
-> Event t (v SelectedCount, v SelectedCount)
forall k (t :: k) a b.
Reflex t =>
Behavior t a -> Event t b -> Event t (a, b)
attach (Dynamic t (v SelectedCount) -> Behavior t (v SelectedCount)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (v SelectedCount)
vs_t) (Dynamic t (v SelectedCount) -> Event t (v SelectedCount)
forall k (t :: k) a. Reflex t => Dynamic t a -> Event t a
updated Dynamic t (v SelectedCount)
vs_t) Event t (v SelectedCount, v SelectedCount)
-> ((v SelectedCount, v SelectedCount) -> v SelectedCount)
-> Event t (v SelectedCount)
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(v SelectedCount
vs_n, v SelectedCount
vs_n1) -> (SelectedCount -> SelectedCount)
-> v SelectedCount -> v SelectedCount
forall (f :: * -> *) b a.
(GrpFunctor f, Eq b, Group b) =>
(a -> b) -> f a -> f b
mapG SelectedCount -> SelectedCount
forall x. (Monoid x, Ord x) => x -> SelectedCount
positive (v SelectedCount -> v SelectedCount)
-> v SelectedCount -> v SelectedCount
forall a b. (a -> b) -> a -> b
$ (SelectedCount -> SelectedCount)
-> v SelectedCount -> v SelectedCount
forall (f :: * -> *) b a.
(GrpFunctor f, Eq b, Group b) =>
(a -> b) -> f a -> f b
mapG SelectedCount -> SelectedCount
forall x. (Monoid x, Ord x) => x -> SelectedCount
positive v SelectedCount
vs_n v SelectedCount -> v SelectedCount -> v SelectedCount
forall q. Group q => q -> q -> q
~~ (SelectedCount -> SelectedCount)
-> v SelectedCount -> v SelectedCount
forall (f :: * -> *) b a.
(GrpFunctor f, Eq b, Group b) =>
(a -> b) -> f a -> f b
mapG SelectedCount -> SelectedCount
forall x. (Monoid x, Ord x) => x -> SelectedCount
positive v SelectedCount
vs_n1

  Event t ()
pb <- m (Event t ())
forall t (m :: * -> *). PostBuild t m => m (Event t ())
getPostBuild
  let vs_0 :: Event t (v SelectedCount)
vs_0 = Behavior t (v SelectedCount)
-> Event t () -> Event t (v SelectedCount)
forall k (t :: k) b a.
Reflex t =>
Behavior t b -> Event t a -> Event t b
tag (Dynamic t (v SelectedCount) -> Behavior t (v SelectedCount)
forall k (t :: k) a. Reflex t => Dynamic t a -> Behavior t a
current Dynamic t (v SelectedCount)
vs_t) Event t ()
pb

  Dynamic t (QueryResult (v SelectedCount))
v_t <- (QueryResult (v SelectedCount)
 -> QueryResult (v SelectedCount) -> QueryResult (v SelectedCount))
-> QueryResult (v SelectedCount)
-> Event t (QueryResult (v SelectedCount))
-> m (Dynamic t (QueryResult (v SelectedCount)))
forall k (t :: k) (m :: * -> *) a b.
(Reflex t, MonadHold t m, MonadFix m) =>
(a -> b -> b) -> b -> Event t a -> m (Dynamic t b)
foldDyn QueryResult (v SelectedCount)
-> QueryResult (v SelectedCount) -> QueryResult (v SelectedCount)
forall a. Semigroup a => a -> a -> a
(<>) QueryResult (v SelectedCount)
forall a. Monoid a => a
mempty Event t (QueryResult (v SelectedCount))
v_n1

  v_n1 :: Event t (QueryResult (v SelectedCount))
    <- Event t (Performable m (QueryResult (v SelectedCount)))
-> m (Event t (QueryResult (v SelectedCount)))
forall t (m :: * -> *) a.
PerformEvent t m =>
Event t (Performable m a) -> m (Event t a)
performEvent (Event t (Performable m (QueryResult (v SelectedCount)))
 -> m (Event t (QueryResult (v SelectedCount))))
-> Event t (Performable m (QueryResult (v SelectedCount)))
-> m (Event t (QueryResult (v SelectedCount)))
forall a b. (a -> b) -> a -> b
$ Event t (v SelectedCount)
-> Event t (v SelectedCount) -> Event t (v SelectedCount)
forall (f :: * -> *) a.
(Semialign f, Semigroup a) =>
f a -> f a -> f a
salign Event t (v SelectedCount)
vs_0 Event t (v SelectedCount)
dvs Event t (v SelectedCount)
-> (v SelectedCount
    -> Performable m (QueryResult (v SelectedCount)))
-> Event t (Performable m (QueryResult (v SelectedCount)))
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \v SelectedCount
dvs' -> if v SelectedCount
dvs' v SelectedCount -> v SelectedCount -> Bool
forall a. Eq a => a -> a -> Bool
/= v SelectedCount
forall a. Monoid a => a
mempty then QueryResult (v SelectedCount)
-> Performable m (QueryResult (v SelectedCount))
forall (m :: * -> *) a. Monad m => a -> m a
return QueryResult (v SelectedCount)
forall a. Monoid a => a
mempty else v SelectedCount -> Performable m (QueryResult (v SelectedCount))
getQueryResult v SelectedCount
dvs'

  a -> m a
forall (m :: * -> *) a. Monad m => a -> m a
return a
result



readShowLatestPost
  :: ( MonadIO (Performable m)
     , PerformEvent t m
     , PostBuild t m
     , MonadHold t m
     , MonadFix m
     , Query (Qsimple SelectedCount)
     , QueryResult (Qsimple SelectedCount) ~ Rsimple
     , Widget t m
     )
  => m ()
readShowLatestPost :: m ()
readShowLatestPost = (Qsimple SelectedCount
 -> Performable m (QueryResult (Qsimple SelectedCount)))
-> (forall (m' :: * -> *).
    (PostBuild t m', MonadHold t m', Widget t m', MonadFix m',
     MonadQuery t (Qsimple SelectedCount) m') =>
    m' ())
-> m ()
forall (v :: * -> *) t (m :: * -> *) a.
(Commutative (v SelectedCount), Group (v SelectedCount),
 PerformEvent t m, GrpFunctor v, Eq (v SelectedCount),
 Monoid (QueryResult (v SelectedCount)), PostBuild t m,
 MonadHold t m, MonadFix m, Widget t m, Query (v SelectedCount)) =>
(v SelectedCount -> Performable m (QueryResult (v SelectedCount)))
-> (forall (m' :: * -> *).
    (PostBuild t m', MonadHold t m', Widget t m', MonadFix m',
     MonadQuery t (v SelectedCount) m') =>
    m' a)
-> m a
dischargeMonadQuery Qsimple SelectedCount
-> Performable m (QueryResult (Qsimple SelectedCount))
forall (m :: * -> *) a a. (MonadIO m, Show a, Read a) => a -> m a
promtForIt forall t (m :: * -> *).
(MonadHold t m, MonadFix m, MonadQuery t (Qsimple SelectedCount) m,
 QueryResult (Qsimple SelectedCount) ~ Rsimple, Reflex t,
 PostBuild t m, Widget t m) =>
m ()
forall (m' :: * -> *).
(PostBuild t m', MonadHold t m', Widget t m', MonadFix m',
 MonadQuery t (Qsimple SelectedCount) m') =>
m' ()
displayLatestPost
  where
    promtForIt :: a -> m a
promtForIt a
q = IO a -> m a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO a -> m a) -> IO a -> m a
forall a b. (a -> b) -> a -> b
$ do
      a -> IO ()
forall a. Show a => a -> IO ()
print a
q
      IO a
forall a. Read a => IO a
readLn

-- annoying stuff that needs to exist but doesn't.
newtype GrpMap k v = GrpMap { GrpMap k v -> Map k v
unGrpMap :: Map k v } deriving (GrpMap k v -> GrpMap k v -> Bool
(GrpMap k v -> GrpMap k v -> Bool)
-> (GrpMap k v -> GrpMap k v -> Bool) -> Eq (GrpMap k v)
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
forall k v. (Eq k, Eq v) => GrpMap k v -> GrpMap k v -> Bool
/= :: GrpMap k v -> GrpMap k v -> Bool
$c/= :: forall k v. (Eq k, Eq v) => GrpMap k v -> GrpMap k v -> Bool
== :: GrpMap k v -> GrpMap k v -> Bool
$c== :: forall k v. (Eq k, Eq v) => GrpMap k v -> GrpMap k v -> Bool
Eq, Eq (GrpMap k v)
Eq (GrpMap k v)
-> (GrpMap k v -> GrpMap k v -> Ordering)
-> (GrpMap k v -> GrpMap k v -> Bool)
-> (GrpMap k v -> GrpMap k v -> Bool)
-> (GrpMap k v -> GrpMap k v -> Bool)
-> (GrpMap k v -> GrpMap k v -> Bool)
-> (GrpMap k v -> GrpMap k v -> GrpMap k v)
-> (GrpMap k v -> GrpMap k v -> GrpMap k v)
-> Ord (GrpMap k v)
GrpMap k v -> GrpMap k v -> Bool
GrpMap k v -> GrpMap k v -> Ordering
GrpMap k v -> GrpMap k v -> GrpMap k v
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall k v. (Ord k, Ord v) => Eq (GrpMap k v)
forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Bool
forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Ordering
forall k v.
(Ord k, Ord v) =>
GrpMap k v -> GrpMap k v -> GrpMap k v
min :: GrpMap k v -> GrpMap k v -> GrpMap k v
$cmin :: forall k v.
(Ord k, Ord v) =>
GrpMap k v -> GrpMap k v -> GrpMap k v
max :: GrpMap k v -> GrpMap k v -> GrpMap k v
$cmax :: forall k v.
(Ord k, Ord v) =>
GrpMap k v -> GrpMap k v -> GrpMap k v
>= :: GrpMap k v -> GrpMap k v -> Bool
$c>= :: forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Bool
> :: GrpMap k v -> GrpMap k v -> Bool
$c> :: forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Bool
<= :: GrpMap k v -> GrpMap k v -> Bool
$c<= :: forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Bool
< :: GrpMap k v -> GrpMap k v -> Bool
$c< :: forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Bool
compare :: GrpMap k v -> GrpMap k v -> Ordering
$ccompare :: forall k v. (Ord k, Ord v) => GrpMap k v -> GrpMap k v -> Ordering
$cp1Ord :: forall k v. (Ord k, Ord v) => Eq (GrpMap k v)
Ord, PostId -> GrpMap k v -> ShowS
[GrpMap k v] -> ShowS
GrpMap k v -> String
(PostId -> GrpMap k v -> ShowS)
-> (GrpMap k v -> String)
-> ([GrpMap k v] -> ShowS)
-> Show (GrpMap k v)
forall a.
(PostId -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
forall k v. (Show k, Show v) => PostId -> GrpMap k v -> ShowS
forall k v. (Show k, Show v) => [GrpMap k v] -> ShowS
forall k v. (Show k, Show v) => GrpMap k v -> String
showList :: [GrpMap k v] -> ShowS
$cshowList :: forall k v. (Show k, Show v) => [GrpMap k v] -> ShowS
show :: GrpMap k v -> String
$cshow :: forall k v. (Show k, Show v) => GrpMap k v -> String
showsPrec :: PostId -> GrpMap k v -> ShowS
$cshowsPrec :: forall k v. (Show k, Show v) => PostId -> GrpMap k v -> ShowS
Show, ReadPrec [GrpMap k v]
ReadPrec (GrpMap k v)
PostId -> ReadS (GrpMap k v)
ReadS [GrpMap k v]
(PostId -> ReadS (GrpMap k v))
-> ReadS [GrpMap k v]
-> ReadPrec (GrpMap k v)
-> ReadPrec [GrpMap k v]
-> Read (GrpMap k v)
forall a.
(PostId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
forall k v. (Ord k, Read k, Read v) => ReadPrec [GrpMap k v]
forall k v. (Ord k, Read k, Read v) => ReadPrec (GrpMap k v)
forall k v. (Ord k, Read k, Read v) => PostId -> ReadS (GrpMap k v)
forall k v. (Ord k, Read k, Read v) => ReadS [GrpMap k v]
readListPrec :: ReadPrec [GrpMap k v]
$creadListPrec :: forall k v. (Ord k, Read k, Read v) => ReadPrec [GrpMap k v]
readPrec :: ReadPrec (GrpMap k v)
$creadPrec :: forall k v. (Ord k, Read k, Read v) => ReadPrec (GrpMap k v)
readList :: ReadS [GrpMap k v]
$creadList :: forall k v. (Ord k, Read k, Read v) => ReadS [GrpMap k v]
readsPrec :: PostId -> ReadS (GrpMap k v)
$creadsPrec :: forall k v. (Ord k, Read k, Read v) => PostId -> ReadS (GrpMap k v)
Read)
type role GrpMap nominal nominal

liftNonZero :: (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a
liftNonZero :: (a -> a -> a) -> a -> a -> Maybe a
liftNonZero a -> a -> a
f a
x a
y = if (a
xy a -> a -> Bool
forall a. Eq a => a -> a -> Bool
/= a
forall a. Monoid a => a
mempty)
  then a -> Maybe a
forall a. a -> Maybe a
Just a
x
  else Maybe a
forall a. Maybe a
Nothing
  where xy :: a
xy = a -> a -> a
f a
x a
y

instance (Monoid g, Eq g, Ord k) => Semigroup (GrpMap k g) where
  GrpMap Map k g
xs <> :: GrpMap k g -> GrpMap k g -> GrpMap k g
<> GrpMap Map k g
ys = Map k g -> GrpMap k g
forall k v. Map k v -> GrpMap k v
GrpMap (Map k g -> GrpMap k g) -> Map k g -> GrpMap k g
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing k g g
-> SimpleWhenMissing k g g
-> SimpleWhenMatched k g g g
-> Map k g
-> Map k g
-> Map k g
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge SimpleWhenMissing k g g
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id SimpleWhenMissing k g g
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id ((k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ((k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g)
-> (k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g
forall a b. (a -> b) -> a -> b
$ (g -> g -> Maybe g) -> k -> g -> g -> Maybe g
forall a b. a -> b -> a
const ((g -> g -> Maybe g) -> k -> g -> g -> Maybe g)
-> (g -> g -> Maybe g) -> k -> g -> g -> Maybe g
forall a b. (a -> b) -> a -> b
$ (g -> g -> g) -> g -> g -> Maybe g
forall a. (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a
liftNonZero g -> g -> g
forall a. Semigroup a => a -> a -> a
(<>)) Map k g
xs Map k g
ys

instance (Monoid g, Eq g, Ord k) => Monoid (GrpMap k g) where
  mempty :: GrpMap k g
mempty = Map k g -> GrpMap k g
forall k v. Map k v -> GrpMap k v
GrpMap Map k g
forall k a. Map k a
Map.empty
  mappend :: GrpMap k g -> GrpMap k g -> GrpMap k g
mappend = GrpMap k g -> GrpMap k g -> GrpMap k g
forall a. Semigroup a => a -> a -> a
(<>)

instance (Group g, Eq g, Ord k) => Group (GrpMap k g) where
  negateG :: GrpMap k g -> GrpMap k g
negateG (GrpMap Map k g
xs) = Map k g -> GrpMap k g
forall k v. Map k v -> GrpMap k v
GrpMap (Map k g -> GrpMap k g) -> Map k g -> GrpMap k g
forall a b. (a -> b) -> a -> b
$ (g -> g) -> Map k g -> Map k g
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap g -> g
forall q. Group q => q -> q
negateG Map k g
xs
  GrpMap Map k g
xs ~~ :: GrpMap k g -> GrpMap k g -> GrpMap k g
~~ GrpMap Map k g
ys = Map k g -> GrpMap k g
forall k v. Map k v -> GrpMap k v
GrpMap (Map k g -> GrpMap k g) -> Map k g -> GrpMap k g
forall a b. (a -> b) -> a -> b
$ SimpleWhenMissing k g g
-> SimpleWhenMissing k g g
-> SimpleWhenMatched k g g g
-> Map k g
-> Map k g
-> Map k g
forall k a c b.
Ord k =>
SimpleWhenMissing k a c
-> SimpleWhenMissing k b c
-> SimpleWhenMatched k a b c
-> Map k a
-> Map k b
-> Map k c
Map.merge SimpleWhenMissing k g g
forall k (cat :: k -> k -> *) (a :: k). Category cat => cat a a
id ((k -> g -> g) -> SimpleWhenMissing k g g
forall (f :: * -> *) k x y.
Applicative f =>
(k -> x -> y) -> WhenMissing f k x y
Map.mapMissing ((k -> g -> g) -> SimpleWhenMissing k g g)
-> (k -> g -> g) -> SimpleWhenMissing k g g
forall a b. (a -> b) -> a -> b
$ (g -> g) -> k -> g -> g
forall a b. a -> b -> a
const ((g -> g) -> k -> g -> g) -> (g -> g) -> k -> g -> g
forall a b. (a -> b) -> a -> b
$ g -> g
forall q. Group q => q -> q
negateG) ((k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g
forall (f :: * -> *) k x y z.
Applicative f =>
(k -> x -> y -> Maybe z) -> WhenMatched f k x y z
Map.zipWithMaybeMatched ((k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g)
-> (k -> g -> g -> Maybe g) -> SimpleWhenMatched k g g g
forall a b. (a -> b) -> a -> b
$ (g -> g -> Maybe g) -> k -> g -> g -> Maybe g
forall a b. a -> b -> a
const ((g -> g -> Maybe g) -> k -> g -> g -> Maybe g)
-> (g -> g -> Maybe g) -> k -> g -> g -> Maybe g
forall a b. (a -> b) -> a -> b
$ (g -> g -> g) -> g -> g -> Maybe g
forall a. (Monoid a, Eq a) => (a -> a -> a) -> a -> a -> Maybe a
liftNonZero g -> g -> g
forall q. Group q => q -> q -> q
(~~)) Map k g
xs Map k g
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 :: (a -> b) -> (r -> a) -> r -> b
mapG = (a -> b) -> (r -> a) -> r -> b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance GrpFunctor Proxy where mapG :: (a -> b) -> Proxy a -> Proxy b
mapG = (a -> b) -> Proxy a -> Proxy b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
instance GrpFunctor Identity where mapG :: (a -> b) -> Identity a -> Identity b
mapG = (a -> b) -> Identity a -> Identity b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap

instance Ord k => GrpFunctor (GrpMap k) where
  mapG :: (a -> b) -> GrpMap k a -> GrpMap k b
mapG a -> b
f (GrpMap Map k a
xs) = Map k b -> GrpMap k b
forall k v. Map k v -> GrpMap k v
GrpMap (Map k b -> GrpMap k b) -> Map k b -> GrpMap k b
forall a b. (a -> b) -> a -> b
$ (a -> Maybe b) -> Map k a -> Map k b
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe (\a
x ->
    let fx :: b
fx = a -> b
f a
x
    in if b
fx b -> b -> Bool
forall a. Eq a => a -> a -> Bool
/= b
forall a. Monoid a => a
mempty
    then b -> Maybe b
forall a. a -> Maybe a
Just b
fx
    else Maybe b
forall a. Maybe a
Nothing) Map k a
xs

deriveArgDict ''Qvessel
deriveJSONGADT ''Qvessel
deriveGEq ''Qvessel
deriveGCompare ''Qvessel
deriveGShow ''Qvessel

```