Validation.hs

module IHP.IDE.SchemaDesigner.Controller.Validation where

import IHP.ControllerPrelude
import Text.Countable (singularize)

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

isNotIllegalKeyword :: Validator Text
isNotIllegalKeyword name
    | isIllegalKeyword name = Failure $ tshow name <> " is a reserved keyword and can not be used as a name"
    | otherwise = Success

validateNameInSchema :: Text -> [Text] -> Maybe Text -> Validator Text
validateNameInSchema nameType namesInUse oldName =
    validateAll [ nonEmpty |> withCustomErrorMessage (ucfirst nameType <> " cannot be empty")
                , isNotIllegalKeyword
                , isUniqueInList namesInUse oldName
                    |> withCustomErrorMessage (ucfirst nameType <> " is already used")
                ]

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

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

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