catNulls, but the type don't fit

src/Rel8.hs

@@ -19,7 +19,7 @@ module Rel8
   , Table
   , each
   , where_
-  -- , filterMap
+  , catNulls
   , limit
   , offset
   , union

src/Rel8/MonadQuery.hs

@@ -16,7 +16,7 @@
 
 module Rel8.MonadQuery where
 
-import Control.Applicative ( liftA2 )
+import Control.Applicative ( Const(..), liftA2 )
 import Data.Functor.Identity
 import Numeric.Natural
 import Rel8.Column
@@ -293,27 +293,30 @@ where_ x =
     ( (), Opaleye.restrict ( toPrimExpr x ) left, t )
 
 
--- filterMap
+catNulls
---   :: forall a nullA b nullB m
+  :: forall a b m
---    . ( Compatible nullA ( Null ( Expr m ) ) a ( Expr m )
+   . ( MonadQuery m
---      , Compatible b ( Expr m ) nullB ( Null ( Expr m ) )
+     , Context a ~ Expr m
---      , Table a, Table b, Context a ~ Context b
+     , Context b ~ Expr m
---      , Table nullA, Table nullB, Context nullA ~ Context nullB
+     , MapTable NotNull a ~ b
---      , MonadQuery m
+     , Recontextualise a NotNull
---      )
+     )
---   => ( nullA -> nullB ) -> m a -> m b
+  => m a -> m b
--- filterMap f q = do
+catNulls q = do
---   x <-
+  x <-
---     q
+    q
 
---   let
+  let
---     y =
+    allNotNull :: [ Expr m Bool ]
---       f ( mapTable ( mapC liftNull ) x )
+    allNotNull =
+      getConst
+        ( runIdentity
+            <$> traverseTable
+                  @Id
+                  ( traverseC ( \expr -> Const [ isNull ( retype expr ) ] ) )
+                  ( Identity x )
+        )
 
---     allNotNull :: [ Expr m Bool ]
+  where_ ( and_ allNotNull )
---     allNotNull =
---       getConst ( traverseTable @nullB ( traverseC ( \expr -> Const [ isNull expr ] ) ) y )
 
---   where_ ( and_ allNotNull )
+  return ( mapTable @NotNull ( mapC retype ) x )
-
---   return ( mapTable ( mapC retype ) y )

src/Rel8/Tests.hs

@@ -13,6 +13,7 @@ import Data.Monoid
 import Database.PostgreSQL.Simple ( Connection )
 import GHC.Generics
 import Rel8
+import Rel8.Column
 
 
 data Part f =
@@ -262,9 +263,10 @@ select_maybeTable :: Connection -> IO [ Maybe ( HasNull Identity ) ]
 select_maybeTable c =
   select c maybeTableQ
 
--- filterMapTest :: MonadQuery m => m _
+
--- filterMapTest =
+catNullsTest :: MonadQuery m => m ( NotNull ( Expr m ) Int32 )
---   filterMap nullId ( each hasNull )
+catNullsTest =
+  catNulls ( nullId <$> each hasNull )
 
 
 unionTest :: MonadQuery m => m ( Part ( Expr m ) )