graphql-engine/server/src-lib/Hasura/RQL/Instances.hs
Antoine Leblanc d8c56a40f6 server: split boolean operators between core and backend-specific
GitOrigin-RevId: f1291946a1122220e82371676d88867fd7b2b7c4
2021-03-25 17:51:08 +00:00

131 lines
4.3 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 Database.PG.Query as Q
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 Control.DeepSeq (NFData (..))
import Data.Functor.Product
import Data.GADT.Compare
import Data.Text
import System.Cron.Parser
import System.Cron.Types
instance NFData G.FragmentDefinition
instance NFData G.GType
instance NFData G.OperationType
instance NFData G.VariableDefinition
instance NFData G.SchemaDefinition
instance NFData G.RootOperationTypeDefinition
instance NFData G.TypeSystemDefinition
instance NFData G.SchemaDocument
instance NFData UT.Variable
instance NFData UT.TemplateItem
instance NFData UT.URLTemplate
instance NFData G.Name where
rnf = rnf . G.unName
instance NFData a => NFData (G.Directive a)
instance NFData a => NFData (G.ExecutableDefinition a)
instance (NFData (a b), NFData b) => NFData (G.Field a b)
instance NFData a => NFData (G.FragmentSpread a)
instance (NFData (a b), NFData b) => NFData (G.InlineFragment a b)
instance (NFData (a b), NFData b) => NFData (G.OperationDefinition a b)
instance (NFData (a b), NFData b) => NFData (G.Selection a b)
instance (NFData (a b), NFData b) => NFData (G.TypedOperationDefinition a b)
instance NFData G.InputValueDefinition
instance NFData a => NFData (G.InputObjectTypeDefinition a)
instance (NFData a) => NFData (G.ObjectTypeDefinition a)
instance NFData G.UnionTypeDefinition
instance NFData G.EnumTypeDefinition
instance NFData G.EnumValueDefinition
instance (NFData a) => NFData (G.FieldDefinition a)
instance NFData G.ScalarTypeDefinition
instance (NFData a, NFData b) => NFData (G.InterfaceTypeDefinition a b)
instance (NFData a, NFData b) => NFData (G.TypeDefinition a b)
instance NFData a => NFData (G.Value a)
deriving instance NFData G.Description
deriving instance NFData G.EnumValue
deriving instance NFData G.Nullability
deriving instance NFData a => NFData (G.ExecutableDocument 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 (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 ->
onLeft (parseCronSchedule t) fail
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
instance J.ToJSONKey Void