mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 04:24:35 +03:00
ff62d5e0bf
This also seems to squash a stubborn space leak we see with subscriptions (linking to canonical #3388 for reference). This may also fix some of the "Unexpected exception" websockets exceptions we are now surfacing (see e.g. #4344) Also: dev.sh: fix hpc reporting Initial work on this done by Vamshi.
126 lines
4.0 KiB
Haskell
126 lines
4.0 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
module Hasura.RQL.Instances where
|
|
|
|
import Hasura.Prelude
|
|
|
|
import qualified Data.Aeson as J
|
|
import qualified Data.HashMap.Strict as M
|
|
import qualified Data.HashSet as S
|
|
import qualified Data.URL.Template as UT
|
|
import qualified Language.GraphQL.Draft.Syntax as G
|
|
import qualified Language.Haskell.TH.Syntax as TH
|
|
import qualified Text.Regex.TDFA as TDFA
|
|
import qualified Text.Regex.TDFA.Pattern as TDFA
|
|
import qualified Database.PG.Query as Q
|
|
|
|
import Data.Functor.Product
|
|
import Data.GADT.Compare
|
|
import Instances.TH.Lift ()
|
|
import System.Cron.Parser
|
|
import System.Cron.Types
|
|
import Data.Text
|
|
|
|
instance NFData G.Argument
|
|
instance NFData G.Directive
|
|
instance NFData G.ExecutableDefinition
|
|
instance NFData G.Field
|
|
instance NFData G.FragmentDefinition
|
|
instance NFData G.FragmentSpread
|
|
instance NFData G.GType
|
|
instance NFData G.InlineFragment
|
|
instance NFData G.OperationDefinition
|
|
instance NFData G.OperationType
|
|
instance NFData G.Selection
|
|
instance NFData G.TypedOperationDefinition
|
|
instance NFData G.Value
|
|
instance NFData G.ValueConst
|
|
instance NFData G.VariableDefinition
|
|
instance (NFData a) => NFData (G.ObjectFieldG a)
|
|
instance NFData UT.Variable
|
|
instance NFData UT.TemplateItem
|
|
instance NFData UT.URLTemplate
|
|
|
|
deriving instance NFData G.Alias
|
|
deriving instance NFData G.EnumValue
|
|
deriving instance NFData G.ExecutableDocument
|
|
deriving instance NFData G.ListType
|
|
deriving instance NFData G.Name
|
|
deriving instance NFData G.NamedType
|
|
deriving instance NFData G.Nullability
|
|
deriving instance NFData G.StringValue
|
|
deriving instance NFData G.Variable
|
|
deriving instance NFData G.Description
|
|
deriving instance (NFData a) => NFData (G.ListValueG a)
|
|
deriving instance (NFData a) => NFData (G.ObjectValueG a)
|
|
|
|
-- instances for CronSchedule from package `cron`
|
|
instance NFData StepField
|
|
instance NFData RangeField
|
|
instance NFData SpecificField
|
|
instance NFData BaseField
|
|
instance NFData CronField
|
|
instance NFData MonthSpec
|
|
instance NFData DayOfMonthSpec
|
|
instance NFData DayOfWeekSpec
|
|
instance NFData HourSpec
|
|
instance NFData MinuteSpec
|
|
instance NFData CronSchedule
|
|
|
|
instance (TH.Lift k, TH.Lift v) => TH.Lift (M.HashMap k v) where
|
|
lift m = [| M.fromList $(TH.lift $ M.toList m) |]
|
|
#if MIN_VERSION_template_haskell(2,16,0)
|
|
liftTyped = TH.unsafeTExpCoerce . TH.lift
|
|
#endif
|
|
|
|
instance TH.Lift a => TH.Lift (S.HashSet a) where
|
|
lift s = [| S.fromList $(TH.lift $ S.toList s) |]
|
|
#if MIN_VERSION_template_haskell(2,16,0)
|
|
liftTyped = TH.unsafeTExpCoerce . TH.lift
|
|
#endif
|
|
|
|
deriving instance TH.Lift TDFA.CompOption
|
|
deriving instance TH.Lift TDFA.DoPa
|
|
deriving instance TH.Lift TDFA.ExecOption
|
|
deriving instance TH.Lift TDFA.Pattern
|
|
deriving instance TH.Lift TDFA.PatternSet
|
|
deriving instance TH.Lift TDFA.PatternSetCharacterClass
|
|
deriving instance TH.Lift TDFA.PatternSetCollatingElement
|
|
deriving instance TH.Lift TDFA.PatternSetEquivalenceClass
|
|
|
|
instance (GEq f, GEq g) => GEq (Product f g) where
|
|
Pair a1 a2 `geq` Pair b1 b2
|
|
| Just Refl <- a1 `geq` b1
|
|
, Just Refl <- a2 `geq` b2
|
|
= Just Refl
|
|
| otherwise = Nothing
|
|
|
|
instance (GCompare f, GCompare g) => GCompare (Product f g) where
|
|
Pair a1 a2 `gcompare` Pair b1 b2 = case gcompare a1 b1 of
|
|
GLT -> GLT
|
|
GEQ -> case gcompare a2 b2 of
|
|
GLT -> GLT
|
|
GEQ -> GEQ
|
|
GGT -> GGT
|
|
GGT -> GGT
|
|
|
|
instance J.FromJSON CronSchedule where
|
|
parseJSON = J.withText "CronSchedule" $ \t ->
|
|
either fail pure $ parseCronSchedule t
|
|
|
|
instance J.ToJSON CronSchedule where
|
|
toJSON = J.String . serializeCronSchedule
|
|
|
|
instance Q.ToPrepArg CronSchedule where
|
|
toPrepVal = Q.toPrepVal . serializeCronSchedule
|
|
|
|
instance Q.FromCol CronSchedule where
|
|
fromCol bs =
|
|
case Q.fromCol bs of
|
|
Left err -> Left err
|
|
Right dbCron ->
|
|
case parseCronSchedule dbCron of
|
|
Left err' -> Left $ "invalid cron schedule " <> pack err'
|
|
Right cron -> Right cron
|