mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-19 13:31:43 +03:00
4c8ea8e865
Result of executing the following commands:
```shell
# replace "as Q" imports with "as PG" (in retrospect this didn't need a regex)
git grep -lE 'as Q($|[^a-zA-Z])' -- '*.hs' | xargs sed -i -E 's/as Q($|[^a-zA-Z])/as PG\1/'
# replace " Q." with " PG."
git grep -lE ' Q\.' -- '*.hs' | xargs sed -i 's/ Q\./ PG./g'
# replace "(Q." with "(PG."
git grep -lE '\(Q\.' -- '*.hs' | xargs sed -i 's/(Q\./(PG./g'
# ditto, but for [, |, { and !
git grep -lE '\[Q\.' -- '*.hs' | xargs sed -i 's/\[Q\./\[PG./g'
git grep -l '|Q\.' -- '*.hs' | xargs sed -i 's/|Q\./|PG./g'
git grep -l '{Q\.' -- '*.hs' | xargs sed -i 's/{Q\./{PG./g'
git grep -l '!Q\.' -- '*.hs' | xargs sed -i 's/!Q\./!PG./g'
```
(Doing the `grep -l` before the `sed`, instead of `sed` on the entire codebase, reduces the number of `mtime` updates, and so reduces how many times a file gets recompiled while checking intermediate results.)
Finally, I manually removed a broken and unused `Arbitrary` instance in `Hasura.RQL.Network`. (It used an `import Test.QuickCheck.Arbitrary as Q` statement, which was erroneously caught by the first find-replace command.)
After this PR, `Q` is no longer used as an import qualifier. That was not the goal of this PR, but perhaps it's a useful fact for future efforts.
PR-URL: https://github.com/hasura/graphql-engine-mono/pull/5933
GitOrigin-RevId: 8c84c59d57789111d40f5d3322c5a885dcfbf40e
74 lines
2.4 KiB
Haskell
74 lines
2.4 KiB
Haskell
{-# LANGUAGE TemplateHaskellQuotes #-}
|
|
|
|
module Data.Text.NonEmpty
|
|
( NonEmptyText,
|
|
mkNonEmptyTextUnsafe,
|
|
mkNonEmptyText,
|
|
unNonEmptyText,
|
|
nonEmptyText,
|
|
nonEmptyTextCodec,
|
|
nonEmptyTextQQ,
|
|
)
|
|
where
|
|
|
|
import Autodocodec (HasCodec (codec), JSONCodec, bimapCodec, textCodec)
|
|
import Data.Aeson
|
|
import Data.Text qualified as T
|
|
import Data.Text.Extended
|
|
import Database.PG.Query qualified as PG
|
|
import Hasura.Prelude hiding (lift)
|
|
import Language.Haskell.TH.Quote (QuasiQuoter (..))
|
|
import Language.Haskell.TH.Syntax (Lift, Q, TExp, lift)
|
|
import Test.QuickCheck qualified as QC
|
|
|
|
newtype NonEmptyText = NonEmptyText {unNonEmptyText :: Text}
|
|
deriving (Show, Eq, Ord, Hashable, ToJSON, ToJSONKey, Lift, PG.ToPrepArg, ToTxt, Generic, NFData)
|
|
|
|
instance QC.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 = mkNonEmptyText text `onNothing` fail "empty string not allowed"
|
|
|
|
nonEmptyText :: Text -> Q (TExp NonEmptyText)
|
|
nonEmptyText = parseNonEmptyText >=> \text -> [||text||]
|
|
|
|
nonEmptyTextCodec :: JSONCodec NonEmptyText
|
|
nonEmptyTextCodec = bimapCodec dec enc textCodec
|
|
where
|
|
dec = maybeToEither "empty string not allowed" . parseNonEmptyText
|
|
enc = unNonEmptyText
|
|
|
|
-- | Construct 'NonEmptyText' literals at compile-time via quasiquotation.
|
|
nonEmptyTextQQ :: QuasiQuoter
|
|
nonEmptyTextQQ =
|
|
QuasiQuoter {quoteExp, quotePat, quoteType, quoteDec}
|
|
where
|
|
quotePat _ = error "nonEmptyTextQQ does not support quoting patterns"
|
|
quoteType _ = error "nonEmptyTextQQ does not support quoting types"
|
|
quoteDec _ = error "nonEmptyTextQQ does not support quoting declarations"
|
|
quoteExp s = case mkNonEmptyText (T.pack s) of
|
|
Just result -> lift result
|
|
Nothing -> fail "empty string not allowed"
|
|
|
|
instance FromJSON NonEmptyText where
|
|
parseJSON = withText "String" parseNonEmptyText
|
|
|
|
instance FromJSONKey NonEmptyText where
|
|
fromJSONKey = FromJSONKeyTextParser parseNonEmptyText
|
|
|
|
instance PG.FromCol NonEmptyText where
|
|
fromCol bs =
|
|
mkNonEmptyText <$> PG.fromCol bs
|
|
>>= maybe (Left "empty string not allowed") Right
|
|
|
|
instance HasCodec NonEmptyText where
|
|
codec = nonEmptyTextCodec
|