module PostgresqlSyntax.Validation where

import PostgresqlSyntax.Prelude hiding (expression)
import qualified Data.HashSet as HashSet
import qualified Data.Text as Text
import qualified PostgresqlSyntax.KeywordSet as HashSet
import qualified PostgresqlSyntax.Predicate as Predicate


{-
The operator name is a sequence of up to NAMEDATALEN-1 (63 by default) 
characters from the following list:

+ - * / < > = ~ ! @ # % ^ & | ` ?

There are a few restrictions on your choice of name:
-- and /* cannot appear anywhere in an operator name, 
since they will be taken as the start of a comment.

A multicharacter operator name cannot end in + or -, 
unless the name also contains at least one of these characters:

~ ! @ # % ^ & | ` ?

For example, @- is an allowed operator name, but *- is not. 
This restriction allows PostgreSQL to parse SQL-compliant 
commands without requiring spaces between tokens.
The use of => as an operator name is deprecated. 
It may be disallowed altogether in a future release.

The operator != is mapped to <> on input, 
so these two names are always equivalent.
-}
op :: Text -> Maybe Text
op :: Text -> Maybe Text
op Text
a =
  if Text -> Bool
Text.null Text
a
    then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Operator is empty")
    else if Text -> Text -> Bool
Text.isInfixOf Text
"--" Text
a
      then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Operator contains a prohibited \"--\" sequence: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a)
      else if Text -> Text -> Bool
Text.isInfixOf Text
"/*" Text
a
        then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Operator contains a prohibited \"/*\" sequence: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a)
        else if HashSet Text -> Text -> Bool
forall a. (Eq a, Hashable a) => HashSet a -> a -> Bool
Predicate.inSet HashSet Text
forall a. (Hashable a, Eq a, IsString a) => HashSet a
HashSet.nonOp Text
a
          then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Operator is not generic: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a)
          else if (Char -> Bool) -> Text -> Maybe Char
Text.find Char -> Bool
Predicate.prohibitionLiftingOpChar Text
a Maybe Char -> (Maybe Char -> Bool) -> Bool
forall a b. a -> (a -> b) -> b
& Maybe Char -> Bool
forall a. Maybe a -> Bool
isJust
            then Maybe Text
forall a. Maybe a
Nothing
            else if Char -> Bool
Predicate.prohibitedOpChar (Text -> Char
Text.last Text
a)
              then Text -> Maybe Text
forall a. a -> Maybe a
Just (Text
"Operator ends with a prohibited char: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
a)
              else Maybe Text
forall a. Maybe a
Nothing