move NonEmptyText out of RQL.Types.Common (#6086)

This commit is contained in:
Antoine Leblanc 2020-10-29 00:04:21 +00:00 committed by GitHub
parent 0540b279db
commit 8b577adfae
No known key found for this signature in database
GPG Key ID: 4AEE18F83AFDEB23
15 changed files with 86 additions and 57 deletions

View File

@ -296,6 +296,7 @@ library
, Data.Sequence.NonEmpty
, Data.TByteString
, Data.Text.Extended
, Data.Text.NonEmpty
, Data.Time.Clock.Units
, Data.URL.Template
, Hasura.App

View File

@ -0,0 +1,49 @@
module Data.Text.NonEmpty
( NonEmptyText
, mkNonEmptyTextUnsafe
, mkNonEmptyText
, unNonEmptyText
, nonEmptyText
) where
import Hasura.Prelude
import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Test.QuickCheck as QC
import Data.Aeson
import Data.Text.Extended
import Language.Haskell.TH.Syntax (Lift, Q, TExp)
newtype NonEmptyText = NonEmptyText { unNonEmptyText :: Text }
deriving (Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, Lift, Q.ToPrepArg, ToTxt, Generic, NFData)
instance Arbitrary NonEmptyText where
arbitrary = NonEmptyText . T.pack <$> QC.listOf1 (QC.elements alphaNumerics)
mkNonEmptyText :: Text -> Maybe NonEmptyText
mkNonEmptyText "" = Nothing
mkNonEmptyText text = Just $ NonEmptyText text
mkNonEmptyTextUnsafe :: Text -> NonEmptyText
mkNonEmptyTextUnsafe = NonEmptyText
parseNonEmptyText :: MonadFail m => Text -> m NonEmptyText
parseNonEmptyText text = case mkNonEmptyText text of
Nothing -> fail "empty string not allowed"
Just neText -> return neText
nonEmptyText :: Text -> Q (TExp NonEmptyText)
nonEmptyText = parseNonEmptyText >=> \text -> [|| text ||]
instance FromJSON NonEmptyText where
parseJSON = withText "String" parseNonEmptyText
instance FromJSONKey NonEmptyText where
fromJSONKey = FromJSONKeyTextParser parseNonEmptyText
instance Q.FromCol NonEmptyText where
fromCol bs = mkNonEmptyText <$> Q.fromCol bs
>>= maybe (Left "empty string not allowed") Right

View File

@ -65,6 +65,7 @@ import Data.Has
import Data.Int (Int64)
import Data.String
import Data.Text.Extended
import Data.Text.NonEmpty
import Data.Time.Clock
import qualified Hasura.Logging as L

View File

@ -17,6 +17,7 @@ import qualified Hasura.RQL.DML.Internal as RQL
import qualified Hasura.RQL.DML.Select.Types as RQL
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Backends.Postgres.SQL.Value
import Hasura.GraphQL.Parser (FieldParser, InputFieldsParser, Kind (..),

View File

@ -18,10 +18,11 @@ import Data.GADT.Compare
import Data.Int
import Data.Scientific (Scientific)
import Data.Set (Set)
import Data.Text.NonEmpty
import Data.Time.Clock
import Data.Vector (Vector)
import GHC.Generics ((:*:) (..), (:+:) (..), Generic (..), K1 (..),
M1 (..), U1 (..), V1)
import GHC.Generics (Generic (..), K1 (..), M1 (..), U1 (..), V1,
(:*:) (..), (:+:) (..))
import System.Cron.Types
import Hasura.Incremental.Select
@ -119,8 +120,8 @@ data Access a where
AccessedParts :: (Select a) => !(DM.DMap (Selector a) Access) -> Access a
instance Semigroup (Access a) where
AccessedAll <> _ = AccessedAll
_ <> AccessedAll = AccessedAll
AccessedAll <> _ = AccessedAll
_ <> AccessedAll = AccessedAll
AccessedParts a <> AccessedParts b = AccessedParts $ DM.unionWithKey (const (<>)) a b
instance (Cacheable a) => Cacheable (Dependency a) where
@ -137,7 +138,7 @@ instance (Cacheable a) => Cacheable (Dependency a) where
lookupAccess = \case
DependencyRoot key -> handleNoAccess $ DM.lookup key (unAccesses accesses)
DependencyChild selector key -> lookupAccess key >>= \case
AccessedAll -> Left (unchanged accesses v1 v2)
AccessedAll -> Left (unchanged accesses v1 v2)
AccessedParts parts -> handleNoAccess $ DM.lookup selector parts
where
-- if this dependency was never accessed, then its certainly unchanged
@ -163,6 +164,7 @@ instance Cacheable Int32 where unchanged _ = (==)
instance Cacheable Integer where unchanged _ = (==)
instance Cacheable Scientific where unchanged _ = (==)
instance Cacheable Text where unchanged _ = (==)
instance Cacheable NonEmptyText where unchanged _ = (==)
instance Cacheable N.URIAuth where unchanged _ = (==)
instance Cacheable G.Name where unchanged _ = (==)
instance Cacheable DiffTime where unchanged _ = (==)

View File

@ -19,8 +19,9 @@ import Hasura.Prelude
import qualified Database.PG.Query as Q
import Data.List.Extended (duplicates)
import Data.Text.Extended
import Data.Text.NonEmpty
import Hasura.EncJSON
import Hasura.RQL.Types
import Hasura.RQL.Types.QueryCollection

View File

@ -28,11 +28,6 @@ module Hasura.RQL.Types.Common
, InpValInfo(..)
, CustomColumnNames
, NonEmptyText
, mkNonEmptyTextUnsafe
, mkNonEmptyText
, unNonEmptyText
, nonEmptyText
, adminText
, rootText
@ -73,9 +68,10 @@ import Data.Aeson.TH
import Data.Bifunctor (bimap)
import Data.Scientific (toBoundedInteger)
import Data.Text.Extended
import Data.Text.NonEmpty
import Data.URL.Template
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift, Q, TExp)
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Backends.Postgres.SQL.Types
import Hasura.EncJSON
@ -91,42 +87,12 @@ type family ScalarType (b :: Backend) where
type family Column (b :: Backend) where
Column 'Postgres = PGCol
newtype NonEmptyText = NonEmptyText { unNonEmptyText :: Text }
deriving (Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, Lift, Q.ToPrepArg, ToTxt, Generic, NFData, Cacheable)
instance Arbitrary NonEmptyText where
arbitrary = NonEmptyText . T.pack <$> QC.listOf1 (QC.elements alphaNumerics)
mkNonEmptyText :: Text -> Maybe NonEmptyText
mkNonEmptyText "" = Nothing
mkNonEmptyText text = Just $ NonEmptyText text
mkNonEmptyTextUnsafe :: Text -> NonEmptyText
mkNonEmptyTextUnsafe = NonEmptyText
parseNonEmptyText :: MonadFail m => Text -> m NonEmptyText
parseNonEmptyText text = case mkNonEmptyText text of
Nothing -> fail "empty string not allowed"
Just neText -> return neText
nonEmptyText :: Text -> Q (TExp NonEmptyText)
nonEmptyText = parseNonEmptyText >=> \text -> [|| text ||]
instance FromJSON NonEmptyText where
parseJSON = withText "String" parseNonEmptyText
instance FromJSONKey NonEmptyText where
fromJSONKey = FromJSONKeyTextParser parseNonEmptyText
instance Q.FromCol NonEmptyText where
fromCol bs = mkNonEmptyText <$> Q.fromCol bs
>>= maybe (Left "empty string not allowed") Right
adminText :: NonEmptyText
adminText = NonEmptyText "admin"
adminText = mkNonEmptyTextUnsafe "admin"
rootText :: NonEmptyText
rootText = NonEmptyText "root"
rootText = mkNonEmptyTextUnsafe "root"
newtype RelName
= RelName { getRelTxt :: NonEmptyText }

View File

@ -15,6 +15,7 @@ import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Data.Text.NonEmpty
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)

View File

@ -35,12 +35,13 @@ import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Data.Text.NonEmpty
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Backends.Postgres.SQL.Types
import Hasura.Incremental (Cacheable)
import Hasura.RQL.DDL.Headers
import Hasura.RQL.Types.Common (InputWebhook, NonEmptyText (..))
import Hasura.RQL.Types.Common (InputWebhook)
-- This change helps us create functions for the event triggers

View File

@ -24,11 +24,11 @@ import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Text.Extended
import Data.Text.NonEmpty
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Instances ()
import Hasura.RQL.Types.Common (NonEmptyText)

View File

@ -27,6 +27,7 @@ import Data.Aeson.TH
import Data.Scientific
import Data.Set (Set)
import Data.Text.Extended
import Data.Text.NonEmpty
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Backends.Postgres.SQL.Types

View File

@ -9,6 +9,7 @@ import qualified Data.Aeson.TH as J
import qualified Data.Environment as Env
import qualified Data.Text as T
import Data.Text.Extended
import Data.Text.NonEmpty
import qualified Database.PG.Query as Q
import qualified Network.URI.Extended as N

View File

@ -8,6 +8,7 @@ import Data.Aeson
import Data.Aeson.Casing
import Data.Aeson.TH
import Data.Aeson.Types
import Data.Text.NonEmpty
import Hasura.Backends.Postgres.SQL.Types
import Hasura.RQL.Types.Common

View File

@ -37,6 +37,7 @@ import qualified Language.Haskell.TH.Syntax as TH
import Control.Lens (_2, view)
import Control.Monad.Unique
import Data.Text.NonEmpty
import Data.Time.Clock (UTCTime)
import System.Directory (doesFileExist)

View File

@ -26,18 +26,7 @@ module Hasura.Session
, BackendOnlyFieldAccess(..)
) where
import Hasura.Incremental (Cacheable)
import Hasura.Prelude
import Hasura.RQL.Types.Common (NonEmptyText, adminText, mkNonEmptyText,
unNonEmptyText)
import Hasura.RQL.Types.Error
import Hasura.Server.Utils
import Data.Aeson
import Data.Aeson.Types (Parser, toJSONKeyText)
import Data.Text.Extended
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import qualified Data.CaseInsensitive as CI
import qualified Data.HashMap.Strict as Map
@ -46,6 +35,19 @@ import qualified Data.Text as T
import qualified Database.PG.Query as Q
import qualified Network.HTTP.Types as HTTP
import Data.Aeson
import Data.Aeson.Types (Parser, toJSONKeyText)
import Data.Text.Extended
import Data.Text.NonEmpty
import Instances.TH.Lift ()
import Language.Haskell.TH.Syntax (Lift)
import Hasura.Incremental (Cacheable)
import Hasura.RQL.Types.Common (adminText)
import Hasura.RQL.Types.Error
import Hasura.Server.Utils
newtype RoleName
= RoleName {getRoleTxt :: NonEmptyText}
deriving ( Show, Eq, Ord, Hashable, FromJSONKey, ToJSONKey, FromJSON