mirror of
https://github.com/hasura/graphql-engine.git
synced 2024-12-17 12:31:52 +03:00
281cb771ff
Co-authored-by: Rakesh Emmadi <12475069+rakeshkky@users.noreply.github.com> Co-authored-by: Antoine Leblanc <1618949+nicuveo@users.noreply.github.com> Co-authored-by: Vamshi Surabhi <6562944+0x777@users.noreply.github.com> Co-authored-by: Aravind K P <8335904+scriptonist@users.noreply.github.com> GitOrigin-RevId: 699c453b9692e1b822f393f23ff5e6db4e010d57
48 lines
1.5 KiB
Haskell
48 lines
1.5 KiB
Haskell
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 = mkNonEmptyText text `onNothing` fail "empty string not allowed"
|
|
|
|
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
|