mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-18 13:02:11 +03:00
c5face545c
This PR: - removes a dependency on Postgres' `ToSQL` in other backends - removes some usage of `unsafePerformIO` in `FronJSON` / `Arbitrary` - fixes a `Set` into a `HashSet` - moves some orphan instances where they belong: - alongside others in `Hasura.Incremental` for `Cacheable` - in `Hasura.Base.Instances` for `Hashable` - introduces a local wrapper around ByteString to avoid unsound UTF8 instances Some of the weird empty lines come from the fact that this PR is an offshoot of #1947. https://github.com/hasura/graphql-engine-mono/pull/1949 GitOrigin-RevId: ef9d34452946f8466878d8fdda857b0b43816de7
125 lines
3.6 KiB
Haskell
125 lines
3.6 KiB
Haskell
{-# LANGUAGE CPP #-}
|
|
{-# OPTIONS_GHC -fno-warn-orphans #-}
|
|
|
|
{- | This module defines all missing instances of third party libraries.
|
|
-}
|
|
|
|
module Hasura.Base.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.Haskell.TH.Syntax as TH
|
|
import qualified System.Cron.Parser as C
|
|
import qualified System.Cron.Types as C
|
|
import qualified Text.Regex.TDFA as TDFA
|
|
import qualified Text.Regex.TDFA.Pattern as TDFA
|
|
|
|
import Data.Functor.Product
|
|
import Data.GADT.Compare
|
|
import Data.Hashable
|
|
import Data.Text
|
|
import Data.Time.Calendar
|
|
import Data.Time.Clock
|
|
import Data.Time.LocalTime
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Hashable
|
|
|
|
instance Hashable UTCTime where
|
|
hashWithSalt i = hashWithSalt i . show
|
|
|
|
instance Hashable Day where
|
|
hashWithSalt i = hashWithSalt i . show
|
|
|
|
instance Hashable TimeOfDay where
|
|
hashWithSalt i = hashWithSalt i . show
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Deepseq
|
|
|
|
instance NFData UT.Variable
|
|
instance NFData UT.TemplateItem
|
|
instance NFData UT.URLTemplate
|
|
|
|
instance NFData C.StepField
|
|
instance NFData C.RangeField
|
|
instance NFData C.SpecificField
|
|
instance NFData C.BaseField
|
|
instance NFData C.CronField
|
|
instance NFData C.MonthSpec
|
|
instance NFData C.DayOfMonthSpec
|
|
instance NFData C.DayOfWeekSpec
|
|
instance NFData C.HourSpec
|
|
instance NFData C.MinuteSpec
|
|
instance NFData C.CronSchedule
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Template Haskell
|
|
|
|
instance (TH.Lift k, TH.Lift v) => TH.Lift (M.HashMap k v) where
|
|
lift m = [| M.fromList $(TH.lift $ M.toList m) |]
|
|
liftTyped = TH.unsafeTExpCoerce . TH.lift
|
|
|
|
instance TH.Lift a => TH.Lift (S.HashSet a) where
|
|
lift s = [| S.fromList $(TH.lift $ S.toList s) |]
|
|
liftTyped = TH.unsafeTExpCoerce . TH.lift
|
|
|
|
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
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- GADT
|
|
|
|
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
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- JSON
|
|
|
|
instance J.FromJSON C.CronSchedule where
|
|
parseJSON = J.withText "CronSchedule" $ \t ->
|
|
onLeft (C.parseCronSchedule t) fail
|
|
|
|
instance J.ToJSON C.CronSchedule where
|
|
toJSON = J.String . C.serializeCronSchedule
|
|
|
|
instance J.ToJSONKey Void
|
|
|
|
|
|
--------------------------------------------------------------------------------
|
|
-- Postgres
|
|
|
|
instance Q.ToPrepArg C.CronSchedule where
|
|
toPrepVal = Q.toPrepVal . C.serializeCronSchedule
|
|
|
|
instance Q.FromCol C.CronSchedule where
|
|
fromCol bs =
|
|
case Q.fromCol bs of
|
|
Left err -> Left err
|
|
Right dbCron ->
|
|
case C.parseCronSchedule dbCron of
|
|
Left err' -> Left $ "invalid cron schedule " <> pack err'
|
|
Right cron -> Right cron
|