这是indexloc提供的服务,不要输入任何密码
Skip to content
Closed
Show file tree
Hide file tree
Changes from all commits
Commits
File filter

Filter by extension

Filter by extension

Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
3 changes: 1 addition & 2 deletions server/src-lib/Hasura/GraphQL/Execute.hs
Original file line number Diff line number Diff line change
Expand Up @@ -354,8 +354,7 @@ getSubsOpM pgExecCtx initialReusability fld actionExecuter =
_ -> do
(astUnresolved, finalReusability) <- runReusabilityTWith initialReusability $
GR.queryFldToPGAST fld actionExecuter
let varTypes = finalReusability ^? _Reusable
EL.buildLiveQueryPlan pgExecCtx (VQ._fAlias fld) astUnresolved varTypes
EL.buildLiveQueryPlan pgExecCtx (VQ._fAlias fld) astUnresolved finalReusability

getSubsOp
:: ( MonadError QErr m
Expand Down
9 changes: 7 additions & 2 deletions server/src-lib/Hasura/GraphQL/Execute/LiveQuery/Plan.hs
Original file line number Diff line number Diff line change
Expand Up @@ -46,6 +46,7 @@ import Data.UUID (UUID)
import qualified Hasura.GraphQL.Resolve as GR
import qualified Hasura.GraphQL.Transport.HTTP.Protocol as GH
import qualified Hasura.GraphQL.Validate as GV
import Hasura.GraphQL.Validate.Types (QueryReusability(..))
import qualified Hasura.SQL.DML as S

import Hasura.Db
Expand Down Expand Up @@ -254,7 +255,7 @@ buildLiveQueryPlan
=> PGExecCtx
-> G.Alias
-> GR.QueryRootFldUnresolved
-> Maybe GV.ReusableVariableTypes
-> QueryReusability
-> m (LiveQueryPlan, Maybe ReusableLiveQueryPlan)
buildLiveQueryPlan pgExecCtx fieldAlias astUnresolved varTypes = do
userInfo <- asks getter
Expand All @@ -273,7 +274,11 @@ buildLiveQueryPlan pgExecCtx fieldAlias astUnresolved varTypes = do
validatedSyntheticVars <- validateVariables pgExecCtx (toList syntheticVariableValues)
let cohortVariables = CohortVariables (_uiSession userInfo) validatedQueryVars validatedSyntheticVars
plan = LiveQueryPlan parameterizedPlan cohortVariables
reusablePlan = ReusableLiveQueryPlan parameterizedPlan validatedSyntheticVars <$> varTypes
reusablePlan =
case varTypes of
Reusable types ->
Just $ ReusableLiveQueryPlan parameterizedPlan validatedSyntheticVars types
NotReusable -> Nothing
pure (plan, reusablePlan)

reuseLiveQueryPlan
Expand Down
7 changes: 4 additions & 3 deletions server/src-lib/Hasura/GraphQL/Execute/Query.hs
Original file line number Diff line number Diff line change
Expand Up @@ -15,7 +15,6 @@ import qualified Data.TByteString as TBS
import qualified Database.PG.Query as Q
import qualified Language.GraphQL.Draft.Syntax as G

import Control.Lens ((^?))
import Data.Has

import qualified Hasura.GraphQL.Resolve as R
Expand Down Expand Up @@ -208,8 +207,10 @@ convertQuerySelSet initialReusability fields actionRunner = do
R.traverseQueryRootFldAST prepareWithPlan unresolvedAst
pure . RFPPostgres $ PGPlan (R.toPGQuery q) vars prepped
pure (V._fAlias fld, fldPlan)
let varTypes = finalReusability ^? _Reusable
reusablePlan = ReusableQueryPlan <$> varTypes <*> pure fldPlans
let reusablePlan =
case finalReusability of
Reusable varTypes -> Just $ ReusableQueryPlan varTypes fldPlans
NotReusable -> Nothing
(tx, sql) <- mkCurPlanTx usrVars fldPlans
pure (tx, reusablePlan, sql)

Expand Down
1 change: 1 addition & 0 deletions server/src-lib/Hasura/GraphQL/Resolve.hs
Original file line number Diff line number Diff line change
Expand Up @@ -38,6 +38,7 @@ import qualified Hasura.GraphQL.Resolve.Introspect as RIntro
import qualified Hasura.GraphQL.Resolve.Mutation as RM
import qualified Hasura.GraphQL.Resolve.Select as RS
import qualified Hasura.GraphQL.Validate as V
import Hasura.GraphQL.Validate.Types (MonadReusability, markNotReusable)
import qualified Hasura.RQL.DML.Select as DS
import qualified Hasura.SQL.DML as S

Expand Down
3 changes: 0 additions & 3 deletions server/src-lib/Hasura/GraphQL/Resolve/Types.hs
Original file line number Diff line number Diff line change
@@ -1,7 +1,5 @@
module Hasura.GraphQL.Resolve.Types
( module Hasura.GraphQL.Resolve.Types
-- * Re-exports
, MonadReusability(..)
) where

import Control.Lens.TH
Expand All @@ -12,7 +10,6 @@ import qualified Data.Sequence as Seq
import qualified Data.Text as T
import qualified Language.GraphQL.Draft.Syntax as G

import Hasura.GraphQL.Validate.Types
import Hasura.RQL.DDL.Headers (HeaderConf)
import Hasura.RQL.Types.Action
import Hasura.RQL.Types.BoolExp
Expand Down
63 changes: 17 additions & 46 deletions server/src-lib/Hasura/GraphQL/Validate/Types.hs
Original file line number Diff line number Diff line change
Expand Up @@ -71,10 +71,10 @@ module Hasura.GraphQL.Validate.Types
, ReusableVariableValues

, QueryReusability(..)
, _Reusable
, _NotReusable
, MonadReusability(..)
, MonadReusability
, ReusabilityT
, markNotReusable
, recordVariableUse
, runReusabilityT
, runReusabilityTWith
, evalReusabilityT
Expand All @@ -95,8 +95,6 @@ import qualified Language.GraphQL.Draft.Syntax as G
import qualified Language.GraphQL.Draft.TH as G
import qualified Language.Haskell.TH.Syntax as TH

import Control.Lens (makePrisms)

import qualified Hasura.RQL.Types.Column as RQL

import Hasura.GraphQL.Utils
Expand Down Expand Up @@ -247,9 +245,6 @@ instance EquatableGType ObjTyInfo where
(G.NamedType, Set.HashSet G.NamedType, Map.HashMap G.Name (G.Name, G.GType, ParamMap))
getEqProps a = (,,) (_otiName a) (_otiImplIFaces a) (Map.map getEqProps (_otiFields a))

instance Monoid ObjTyInfo where
mempty = ObjTyInfo Nothing (G.NamedType "") Set.empty Map.empty

instance Semigroup ObjTyInfo where
objA <> objB =
objA { _otiFields = Map.union (_otiFields objA) (_otiFields objB)
Expand Down Expand Up @@ -303,14 +298,6 @@ instance EquatableGType IFaceTyInfo where
(G.NamedType, Map.HashMap G.Name (G.Name, G.GType, ParamMap))
getEqProps a = (,) (_ifName a) (Map.map getEqProps (_ifFields a))

instance Monoid IFaceTyInfo where
mempty = IFaceTyInfo Nothing (G.NamedType "") Map.empty

instance Semigroup IFaceTyInfo where
objA <> objB =
objA { _ifFields = Map.union (_ifFields objA) (_ifFields objB)
}

fromIFaceDef :: G.InterfaceTypeDefinition -> TypeLoc -> IFaceTyInfo
fromIFaceDef (G.InterfaceTypeDefinition descM n _ flds) loc =
mkIFaceTyInfo descM (G.NamedType n) fldMap loc
Expand All @@ -331,14 +318,6 @@ instance EquatableGType UnionTyInfo where
(G.NamedType, Set.HashSet G.NamedType)
getEqProps a = (,) (_utiName a) (_utiMemberTypes a)

instance Monoid UnionTyInfo where
mempty = UnionTyInfo Nothing (G.NamedType "") Set.empty

instance Semigroup UnionTyInfo where
objA <> objB =
objA { _utiMemberTypes = Set.union (_utiMemberTypes objA) (_utiMemberTypes objB)
}

fromUnionTyDef :: G.UnionTypeDefinition -> UnionTyInfo
fromUnionTyDef (G.UnionTypeDefinition descM n _ mt) = UnionTyInfo descM (G.NamedType n) $ Set.fromList mt

Expand Down Expand Up @@ -810,36 +789,28 @@ data QueryReusability
= Reusable !ReusableVariableTypes
| NotReusable
deriving (Show, Eq)
$(makePrisms ''QueryReusability)

instance Semigroup QueryReusability where
Reusable a <> Reusable b = Reusable (a <> b)
_ <> _ = NotReusable
instance Monoid QueryReusability where
mempty = Reusable mempty
Comment on lines -815 to -819
Copy link
Contributor

@lexi-lambda lexi-lambda Apr 30, 2020

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

You say this “isn’t actually a monoid,” but that’s just not true; this is a monoid. It satisfies all the monoid laws. It wouldn’t be a monoid if we defined mempty = NotReusable, but we don’t. As-written, it’s a perfectly cromulent monoid.

(You’re right that the other instances aren’t monoids, and we should get rid of those. But this one seems fine to me.)

Copy link
Contributor Author

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Yes, having taken a second look, you are right. So it makes sense to treat QueryReusability as a monoid.


class (Monad m) => MonadReusability m where
recordVariableUse :: G.Variable -> RQL.PGColumnType -> m ()
markNotReusable :: m ()
type MonadReusability m = MonadState QueryReusability m

instance (MonadReusability m) => MonadReusability (ReaderT r m) where
recordVariableUse a b = lift $ recordVariableUse a b
markNotReusable = lift markNotReusable
type ReusabilityT m a = StateT QueryReusability m a
Comment on lines -822 to +795
Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

I normally recommend against doing this. Why? Two reasons:

  1. You can’t use MonadState for something else when this transformer is somewhere in the stack.

  2. It’s a weaker abstraction. Code that is polymorphic in the monad but written against MonadReusability can only call recordVariableUse and markNotReusable, which accumulate information monoidally. But using MonadState, they can do arbitrary other things, including dropping the state altogether.

Perhaps the above two points seem like small potatoes, and maybe they are. But I don’t think they’re inconsequential enough to justify switching away from the abstraction just to be a little bit simpler!

One improvement that would be nice would be to switch from StateT to WriterT as the underlying transformer, since ReusabilityT is fundamentally about accumulating information monoidally, and it doesn’t need the full power of StateT. Alas, even the strict variant of WriterT leaks space, so I avoid using it for anything that isn’t tiny.

Fortunately, recent versions of transformers include Control.Monad.Trans.Writer.CPS, which is a non-leaky implementation of WriterT (it uses StateT under the hood), but mtl doesn’t include support for that in the currently-released version. It does support it on master (because I added support for it—probably at around the same time I wrote ReusabilityT, in fact!), but it doesn’t seem to have made its way into a release yet. I should probably bother the maintainers about that.

Copy link
Contributor Author

@abooij abooij Apr 30, 2020

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

Thanks for this background, Alexis. I completely agree with the points you raise. I am not as well-versed in the space leakage of the various monad transformers, so what you wrote is very informative.

The reason I opened this PR nonetheless is that I think in this case the abstraction of MonadReusability has a cost. There is an argument to be made against abstraction when this is in conflict with interpretability, as it was for me. But I'm sure we can resolve this conflict in the refactored version by making sure there is good documentation, and by minimizing dependency on this stateful computation. (At first sight this seems to be much better in the refactored version, which is why above I proposed to ignore this PR in lieu of that work.)

Copy link
Contributor

Choose a reason for hiding this comment

The reason will be displayed to describe this comment to others. Learn more.

FWIW I agree with you 100% that the “mtl-style” approach to effect composition is way, way too complicated, and we want something better. That is in fact precisely why I have written eff: I think monad transformers are the single largest obstacle to new Haskell programmers who want to get productive with the language, and I think algebraic effects are a better design.

Unfortunately, existing approaches to algebraic effects in Haskell aren’t very efficient, so eff is also a project in making them fast. And eff is fast… but it is fast because it depends on some modifications to GHC. I have an open GHC proposal to get those modifications merged, but until then we’re stuck with what we have.

So yes, less tangentially, I’m happy to include some more documentation wherever it would help. Please feel free to add some extra documentation wherever it would be helpful! (Or, for that matter, request for someone else to add some documentation if you don’t feel like you understand it enough to do it yourself.)


newtype ReusabilityT m a = ReusabilityT { unReusabilityT :: StateT QueryReusability m a }
deriving (Functor, Applicative, Monad, MonadError e, MonadReader r, MonadIO)
markNotReusable :: MonadReusability m => m ()
markNotReusable = put NotReusable

instance (Monad m) => MonadReusability (ReusabilityT m) where
recordVariableUse varName varType = ReusabilityT $
modify' (<> Reusable (ReusableVariableTypes $ Map.singleton varName varType))
markNotReusable = ReusabilityT $ put NotReusable
recordVariableUse :: MonadReusability m => G.Variable -> RQL.PGColumnType -> m ()
recordVariableUse varName varType = modify' combine
where
combine :: QueryReusability -> QueryReusability
combine (Reusable (ReusableVariableTypes ts)) =
Reusable (ReusableVariableTypes (Map.insert varName varType ts))
combine NotReusable = NotReusable

runReusabilityT :: ReusabilityT m a -> m (a, QueryReusability)
runReusabilityT = runReusabilityTWith mempty
runReusabilityT = runReusabilityTWith (Reusable mempty)

-- | Like 'runReusabilityT', but starting from an existing 'QueryReusability' state.
runReusabilityTWith :: QueryReusability -> ReusabilityT m a -> m (a, QueryReusability)
runReusabilityTWith initialReusability = flip runStateT initialReusability . unReusabilityT
runReusabilityTWith initialReusability = flip runStateT initialReusability

evalReusabilityT :: (Monad m) => ReusabilityT m a -> m a
evalReusabilityT = flip evalStateT mempty . unReusabilityT
evalReusabilityT = flip evalStateT (Reusable mempty)