graphql-engine/server/src-lib/Hasura/Base/Instances.hs
Brandon Simmons b167120f96 server: add explicit export lists in OSS server and enforce with warning
We'll see if this improves compile times at all, but I think it's worth
doing as at least the most minimal form of module documentation.

This was accomplished by first compiling everything with
-ddump-minimal-imports, and then a bunch of scripting (with help from
ormolu)

**EDIT** it doesn't seem to improve CI compile times but the noise floor is high as it looks like we're not caching library dependencies anymore

PR-URL: https://github.com/hasura/graphql-engine-mono/pull/2730
GitOrigin-RevId: 667eb8de1e0f1af70420cbec90402922b8b84cb4
2021-11-04 16:09:38 +00:00

134 lines
3.4 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 Data.Aeson qualified as J
import Data.Functor.Product
import Data.GADT.Compare
import Data.HashMap.Strict qualified as M
import Data.HashSet qualified as S
import Data.Hashable
import Data.Text
import Data.Time.Calendar
import Data.Time.Clock
import Data.Time.LocalTime
import Data.URL.Template qualified as UT
import Database.PG.Query qualified as Q
import Hasura.Prelude
import Language.Haskell.TH.Syntax qualified as TH
import System.Cron.Parser qualified as C
import System.Cron.Types qualified as C
import Text.Regex.TDFA qualified as TDFA
import Text.Regex.TDFA.Pattern qualified as TDFA
--------------------------------------------------------------------------------
-- 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