module IHP.IDE.SchemaDesigner.Controller.Validation where

import IHP.ControllerPrelude

isUniqueInList :: (Foldable t, Eq a) => t a -> Maybe a -> Validator a
isUniqueInList :: forall (t :: * -> *) a.
(Foldable t, Eq a) =>
t a -> Maybe a -> Validator a
isUniqueInList t a
list Maybe a
oldValue a
newValue
    | a
newValue a -> t a -> Bool
forall a. Eq a => a -> t a -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` t a
list Bool -> Bool -> Bool
&& a -> Maybe a
forall a. a -> Maybe a
Just a
newValue Maybe a -> Maybe a -> Bool
forall a. Eq a => a -> a -> Bool
/= Maybe a
oldValue = Text -> ValidatorResult
Failure Text
"Value is in forbidden list and not equal to old value"
    | Bool
otherwise = ValidatorResult
Success

isNotIllegalKeyword :: Validator Text
isNotIllegalKeyword :: Text -> ValidatorResult
isNotIllegalKeyword Text
name
    | Text -> Bool
isIllegalKeyword Text
name = Text -> ValidatorResult
Failure (Text -> ValidatorResult) -> Text -> ValidatorResult
forall a b. (a -> b) -> a -> b
$ Text -> Text
forall a. Show a => a -> Text
tshow Text
name Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is a reserved keyword and can not be used as a name"
    | Bool
otherwise = ValidatorResult
Success

validateNameInSchema :: Text -> [Text] -> Maybe Text -> Validator Text
validateNameInSchema :: Text -> [Text] -> Maybe Text -> Text -> ValidatorResult
validateNameInSchema Text
nameType [Text]
namesInUse Maybe Text
oldName =
    [Text -> ValidatorResult] -> Text -> ValidatorResult
forall value.
[value -> ValidatorResult] -> value -> ValidatorResult
validateAll [ Text -> ValidatorResult
forall value. IsEmpty value => value -> ValidatorResult
nonEmpty (Text -> ValidatorResult)
-> ((Text -> ValidatorResult) -> Text -> ValidatorResult)
-> Text
-> ValidatorResult
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> (Text -> ValidatorResult) -> Text -> ValidatorResult
forall value.
Text -> (value -> ValidatorResult) -> value -> ValidatorResult
withCustomErrorMessage (Text -> Text
ucfirst Text
nameType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" cannot be empty")
                , Text -> ValidatorResult
isNotIllegalKeyword
                , [Text] -> Maybe Text -> Text -> ValidatorResult
forall (t :: * -> *) a.
(Foldable t, Eq a) =>
t a -> Maybe a -> Validator a
isUniqueInList [Text]
namesInUse Maybe Text
oldName
                    (Text -> ValidatorResult)
-> ((Text -> ValidatorResult) -> Text -> ValidatorResult)
-> Text
-> ValidatorResult
forall {t1} {t2}. t1 -> (t1 -> t2) -> t2
|> Text -> (Text -> ValidatorResult) -> Text -> ValidatorResult
forall value.
Text -> (value -> ValidatorResult) -> value -> ValidatorResult
withCustomErrorMessage (Text -> Text
ucfirst Text
nameType Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" is already used")
                ]

isIllegalKeyword :: Text -> Bool
isIllegalKeyword :: Text -> Bool
isIllegalKeyword Text
input =
    case Text
input of
        Text
"_" -> Bool
True
        Text
_ -> Text -> Bool
isSQLKeyword Text
input Bool -> Bool -> Bool
|| (Text -> Bool
isHaskellKeyword (Text -> Text
singularize Text
input))

isSQLKeyword :: Text -> Bool
isSQLKeyword :: Text -> Bool
isSQLKeyword Text
input = case (Text -> Text
toUpper Text
input) of
    Text
"BIGINT" -> Bool
True
    Text
"BIT" -> Bool
True
    Text
"BOOLEAN" -> Bool
True
    Text
"CHAR" -> Bool
True
    Text
"CHARACTER" -> Bool
True
    Text
"COALESCE" -> Bool
True
    Text
"CONVERT" -> Bool
True
    Text
"DEC" -> Bool
True
    Text
"DECIMAL" -> Bool
True
    Text
"EXISTS" -> Bool
True
    Text
"EXTRACT" -> Bool
True
    Text
"FLOAT" -> Bool
True
    Text
"GREATEST" -> Bool
True
    Text
"INOUT" -> Bool
True
    Text
"INT" -> Bool
True
    Text
"INTEGER" -> Bool
True
    Text
"INTERVAL" -> Bool
True
    Text
"LEAST" -> Bool
True
    Text
"NATIONAL" -> Bool
True
    Text
"NCHAR" -> Bool
True
    Text
"NONE" -> Bool
True
    Text
"NULLIF" -> Bool
True
    Text
"NUMERIC" -> Bool
True
    Text
"OUT" -> Bool
True
    Text
"OVERLAY" -> Bool
True
    Text
"POSITION" -> Bool
True
    Text
"PRECISION" -> Bool
True
    Text
"REAL" -> Bool
True
    Text
"ROW" -> Bool
True
    Text
"SETOF" -> Bool
True
    Text
"SMALLINT" -> Bool
True
    Text
"SUBSTRING" -> Bool
True
    Text
"TIME" -> Bool
True
    Text
"TIMESTAMP" -> Bool
True
    Text
"TREAT" -> Bool
True
    Text
"TRIM" -> Bool
True
    Text
"VARCHAR" -> Bool
True
    Text
"ALL" -> Bool
True
    Text
"ANALYSE" -> Bool
True
    Text
"ANALYZE" -> Bool
True
    Text
"AND" -> Bool
True
    Text
"ANY" -> Bool
True
    Text
"ARRAY" -> Bool
True
    Text
"AS" -> Bool
True
    Text
"ASC" -> Bool
True
    Text
"ASYMMETRIC" -> Bool
True
    Text
"BOTH" -> Bool
True
    Text
"CASE" -> Bool
True
    Text
"CAST" -> Bool
True
    Text
"CHECK" -> Bool
True
    Text
"COLLATE" -> Bool
True
    Text
"COLUMN" -> Bool
True
    Text
"CONSTRAINT" -> Bool
True
    Text
"CREATE" -> Bool
True
    Text
"CURRENT_DATE" -> Bool
True
    Text
"CURRENT_ROLE" -> Bool
True
    Text
"CURRENT_TIME" -> Bool
True
    Text
"CURRENT_TIMESTAMP" -> Bool
True
    Text
"CURRENT_USER" -> Bool
True
    Text
"DEFAULT" -> Bool
True
    Text
"DEFERRABLE" -> Bool
True
    Text
"DESC" -> Bool
True
    Text
"DISTINCT" -> Bool
True
    Text
"DO" -> Bool
True
    Text
"ELSE" -> Bool
True
    Text
"END" -> Bool
True
    Text
"EXCEPT" -> Bool
True
    Text
"FALSE" -> Bool
True
    Text
"FOR" -> Bool
True
    Text
"FOREIGN" -> Bool
True
    Text
"FROM" -> Bool
True
    Text
"GRANT" -> Bool
True
    Text
"GROUP" -> Bool
True
    Text
"HAVING" -> Bool
True
    Text
"IN" -> Bool
True
    Text
"INITIALLY" -> Bool
True
    Text
"INTERSECT" -> Bool
True
    Text
"INTO" -> Bool
True
    Text
"LEADING" -> Bool
True
    Text
"LIMIT" -> Bool
True
    Text
"LOCALTIME" -> Bool
True
    Text
"LOCALTIMESTAMP" -> Bool
True
    Text
"NEW" -> Bool
True
    Text
"NOT" -> Bool
True
    Text
"NULL" -> Bool
True
    Text
"OFF" -> Bool
True
    Text
"OFFSET" -> Bool
True
    Text
"OLD" -> Bool
True
    Text
"ON" -> Bool
True
    Text
"ONLY" -> Bool
True
    Text
"OR" -> Bool
True
    Text
"ORDER" -> Bool
True
    Text
"PLACING" -> Bool
True
    Text
"PRIMARY" -> Bool
True
    Text
"REFERENCES" -> Bool
True
    Text
"SELECT" -> Bool
True
    Text
"SESSION_USER" -> Bool
True
    Text
"SOME" -> Bool
True
    Text
"SYMMETRIC" -> Bool
True
    Text
"TABLE" -> Bool
True
    Text
"THEN" -> Bool
True
    Text
"TO" -> Bool
True
    Text
"TRAILING" -> Bool
True
    Text
"TRUE" -> Bool
True
    Text
"UNION" -> Bool
True
    Text
"UNIQUE" -> Bool
True
    Text
"USER" -> Bool
True
    Text
"USING" -> Bool
True
    Text
"WHEN" -> Bool
True
    Text
"WHERE" -> Bool
True
    Text
"AUTHORIZATION" -> Bool
True
    Text
"BETWEEN" -> Bool
True
    Text
"BINARY" -> Bool
True
    Text
"CROSS" -> Bool
True
    Text
"FREEZE" -> Bool
True
    Text
"FULL" -> Bool
True
    Text
"ILIKE" -> Bool
True
    Text
"INNER" -> Bool
True
    Text
"IS" -> Bool
True
    Text
"ISNULL" -> Bool
True
    Text
"JOIN" -> Bool
True
    Text
"LEFT" -> Bool
True
    Text
"LIKE" -> Bool
True
    Text
"NATURAL" -> Bool
True
    Text
"NOTNULL" -> Bool
True
    Text
"OUTER" -> Bool
True
    Text
"OVERLAPS" -> Bool
True
    Text
"RIGHT" -> Bool
True
    Text
"SIMILAR" -> Bool
True
    Text
"VERBOSE" -> Bool
True
    Text
"BYTEA" -> Bool
True
    Text
_ -> Bool
False

-- "toLower" feels more natural for Haskell keywords
isHaskellKeyword :: Text -> Bool
isHaskellKeyword :: Text -> Bool
isHaskellKeyword Text
input =
    case (Text -> Text
toLower Text
input) of
        Text
"as" -> Bool
True
        Text
"case" -> Bool
True
        Text
"class" -> Bool
True
        Text
"data" -> Bool
True
        Text
"default" -> Bool
True
        Text
"deriving" -> Bool
True
        Text
"do" -> Bool
True
        Text
"else" -> Bool
True
        Text
"hiding" -> Bool
True
        Text
"if" -> Bool
True
        Text
"import" -> Bool
True
        Text
"in" -> Bool
True
        Text
"infix" -> Bool
True
        Text
"infixl" -> Bool
True
        Text
"infixr" -> Bool
True
        Text
"instance" -> Bool
True
        Text
"let" -> Bool
True
        Text
"module" -> Bool
True
        Text
"newtype" -> Bool
True
        Text
"of" -> Bool
True
        Text
"qualified" -> Bool
True
        Text
"then" -> Bool
True
        Text
"type" -> Bool
True
        Text
"where" -> Bool
True
        Text
"forall" -> Bool
True
        Text
"mdo" -> Bool
True
        Text
"family" -> Bool
True
        Text
"role" -> Bool
True
        Text
"pattern" -> Bool
True
        Text
"static" -> Bool
True
        Text
"group" -> Bool
True
        Text
"by" -> Bool
True
        Text
"using" -> Bool
True
        Text
"foreign" -> Bool
True
        Text
"export" -> Bool
True
        Text
"label" -> Bool
True
        Text
"dynamic" -> Bool
True
        Text
"safe" -> Bool
True
        Text
"interruptible" -> Bool
True
        Text
"unsafe" -> Bool
True
        Text
"stdcall" -> Bool
True
        Text
"ccall" -> Bool
True
        Text
"capi" -> Bool
True
        Text
"prim" -> Bool
True
        Text
"javascript" -> Bool
True
        Text
"rec" -> Bool
True
        Text
"proc" -> Bool
True
        Text
_ -> Bool
False