module PostgresqlSyntax.CharSet where

import qualified Data.Text as Text
import qualified PostgresqlSyntax.KeywordSet as KeywordSet
import PostgresqlSyntax.Prelude

{-# NOINLINE symbolicBinOp #-}
symbolicBinOp :: HashSet Char
symbolicBinOp :: HashSet Char
symbolicBinOp = HashSet Text
KeywordSet.symbolicBinOp HashSet Text -> (HashSet Text -> [Text]) -> [Text]
forall a b. a -> (a -> b) -> b
& HashSet Text -> [Text]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [Text] -> ([Text] -> Text) -> Text
forall a b. a -> (a -> b) -> b
& [Text] -> Text
forall a. Monoid a => [a] -> a
mconcat Text -> (Text -> String) -> String
forall a b. a -> (a -> b) -> b
& Text -> String
Text.unpack String -> (String -> HashSet Char) -> HashSet Char
forall a b. a -> (a -> b) -> b
& String -> HashSet Char
forall l. IsList l => [Item l] -> l
fromList

{-# NOINLINE hexDigit #-}
hexDigit :: HashSet Char
hexDigit :: HashSet Char
hexDigit = [Item (HashSet Char)] -> HashSet Char
forall l. IsList l => [Item l] -> l
fromList [Item (HashSet Char)]
"0123456789abcdefABCDEF"

{-# NOINLINE op #-}
op :: HashSet Char
op :: HashSet Char
op = [Item (HashSet Char)] -> HashSet Char
forall l. IsList l => [Item l] -> l
fromList [Item (HashSet Char)]
"+-*/<>=~!@#%^&|`?"

{-# NOINLINE prohibitionLiftingOp #-}
prohibitionLiftingOp :: HashSet Char
prohibitionLiftingOp :: HashSet Char
prohibitionLiftingOp = [Item (HashSet Char)] -> HashSet Char
forall l. IsList l => [Item l] -> l
fromList [Item (HashSet Char)]
"~!@#%^&|`?"