mirror of
https://github.com/circuithub/rel8.git
synced 2024-09-11 16:05:41 +03:00
catNulls, but the type don't fit
This commit is contained in:
parent
a60f27b344
commit
397ef4da6f
@ -19,7 +19,7 @@ module Rel8
|
||||
, Table
|
||||
, each
|
||||
, where_
|
||||
-- , filterMap
|
||||
, catNulls
|
||||
, limit
|
||||
, offset
|
||||
, union
|
||||
|
@ -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
|
||||
-- :: forall a nullA b nullB m
|
||||
-- . ( Compatible nullA ( Null ( Expr m ) ) a ( Expr m )
|
||||
-- , Compatible b ( Expr m ) nullB ( Null ( Expr m ) )
|
||||
-- , Table a, Table b, Context a ~ Context b
|
||||
-- , Table nullA, Table nullB, Context nullA ~ Context nullB
|
||||
-- , MonadQuery m
|
||||
-- )
|
||||
-- => ( nullA -> nullB ) -> m a -> m b
|
||||
-- filterMap f q = do
|
||||
-- x <-
|
||||
-- q
|
||||
catNulls
|
||||
:: forall a b m
|
||||
. ( MonadQuery m
|
||||
, Context a ~ Expr m
|
||||
, Context b ~ Expr m
|
||||
, MapTable NotNull a ~ b
|
||||
, Recontextualise a NotNull
|
||||
)
|
||||
=> m a -> m b
|
||||
catNulls q = do
|
||||
x <-
|
||||
q
|
||||
|
||||
-- let
|
||||
-- y =
|
||||
-- f ( mapTable ( mapC liftNull ) x )
|
||||
let
|
||||
allNotNull :: [ Expr m Bool ]
|
||||
allNotNull =
|
||||
getConst
|
||||
( runIdentity
|
||||
<$> traverseTable
|
||||
@Id
|
||||
( traverseC ( \expr -> Const [ isNull ( retype expr ) ] ) )
|
||||
( Identity x )
|
||||
)
|
||||
|
||||
-- allNotNull :: [ Expr m Bool ]
|
||||
-- allNotNull =
|
||||
-- getConst ( traverseTable @nullB ( traverseC ( \expr -> Const [ isNull expr ] ) ) y )
|
||||
where_ ( and_ allNotNull )
|
||||
|
||||
-- where_ ( and_ allNotNull )
|
||||
|
||||
-- return ( mapTable ( mapC retype ) y )
|
||||
return ( mapTable @NotNull ( mapC retype ) x )
|
||||
|
@ -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 =
|
||||
-- filterMap nullId ( each hasNull )
|
||||
|
||||
catNullsTest :: MonadQuery m => m ( NotNull ( Expr m ) Int32 )
|
||||
catNullsTest =
|
||||
catNulls ( nullId <$> each hasNull )
|
||||
|
||||
|
||||
unionTest :: MonadQuery m => m ( Part ( Expr m ) )
|
||||
|
Loading…
Reference in New Issue
Block a user