Merge pull request #8 from obsidiansystems/aa/reserved-keywords

Check whether identifier is a reserved keyword when deciding whether to escape

CHANGELOG.md

@@ -1,5 +1,9 @@
 # Revision history for beam-automigrate
 
+## 0.1.2.0
+
+* Escape sql identifiers that are on the [postgres reserved keywords list](https://www.postgresql.org/docs/current/sql-keywords-appendix.html)
+
 ## 0.1.1.0
 
 * Escape sql identifiers only when required by the [postgres syntax rules](https://www.postgresql.org/docs/current/sql-syntax-lexical.html#SQL-SYNTAX-IDENTIFIERS)

beam-automigrate.cabal

@@ -1,5 +1,5 @@
 name:               beam-automigrate
-version:            0.1.1.0
+version:            0.1.2.0
 license-file:       LICENSE
 build-type:         Simple
 cabal-version:      >=1.10

src/Database/Beam/AutoMigrate/Util.hs

@@ -7,10 +7,12 @@ import Control.Applicative.Lift
 import Control.Monad.Except
 import Data.Char
 import Data.Functor.Constant
+import Data.Set (Set)
+import qualified Data.Set as Set
 import Data.String (fromString)
 import Data.Text (Text)
 import qualified Data.Text as T
-import Database.Beam.AutoMigrate.Types (ColumnName (..), TableName (..))
+import Database.Beam.AutoMigrate.Types (ColumnName(..), TableName(..))
 import Database.Beam.Schema (Beamable, PrimaryKey, TableEntity, TableSettings)
 import qualified Database.Beam.Schema as Beam
 import Database.Beam.Schema.Tables
@@ -118,12 +120,97 @@ sqlEscaped t = if sqlValidUnescaped t
 sqlValidUnescaped :: Text -> Bool
 sqlValidUnescaped t = case T.uncons t of
   Nothing -> True
-  Just (c, rest) -> validUnescapedHead c && validUnescapedTail rest
+  Just (c, rest) -> validUnescapedHead c && validUnescapedTail rest && not (sqlIsReservedKeyword t)
   where
     validUnescapedHead c = c `elem` ("1234567890_"::String) || isAlpha c
     validUnescapedTail = all
       (\r -> (isAlpha r && isLower r) || r `elem` ("1234567890$_"::String)) . T.unpack
 
+sqlIsReservedKeyword :: Text -> Bool
+sqlIsReservedKeyword t = T.toCaseFold t `Set.member` postgresKeywordsReserved
+
+-- | Reserved keywords according to
+-- https://www.postgresql.org/docs/current/sql-keywords-appendix.html
+postgresKeywordsReserved :: Set Text
+postgresKeywordsReserved = Set.fromList $ map T.toCaseFold
+  [ "ALL"
+  , "ANALYSE"
+  , "ANALYZE"
+  , "AND"
+  , "ANY"
+  , "ARRAY"
+  , "AS"
+  , "ASC"
+  , "ASYMMETRIC"
+  , "BOTH"
+  , "CASE"
+  , "CAST"
+  , "CHECK"
+  , "COLLATE"
+  , "COLUMN"
+  , "CONSTRAINT"
+  , "CREATE"
+  , "CURRENT_CATALOG"
+  , "CURRENT_DATE"
+  , "CURRENT_ROLE"
+  , "CURRENT_TIME"
+  , "CURRENT_TIMESTAMP"
+  , "CURRENT_USER"
+  , "DEFAULT"
+  , "DEFERRABLE"
+  , "DESC"
+  , "DISTINCT"
+  , "DO"
+  , "ELSE"
+  , "END"
+  , "EXCEPT"
+  , "FALSE"
+  , "FETCH"
+  , "FOR"
+  , "FOREIGN"
+  , "FROM"
+  , "GRANT"
+  , "GROUP"
+  , "HAVING"
+  , "IN"
+  , "INITIALLY"
+  , "INTERSECT"
+  , "INTO"
+  , "LATERAL"
+  , "LEADING"
+  , "LIMIT"
+  , "LOCALTIME"
+  , "LOCALTIMESTAMP"
+  , "NOT"
+  , "NULL"
+  , "OFFSET"
+  , "ON"
+  , "ONLY"
+  , "OR"
+  , "ORDER"
+  , "PLACING"
+  , "PRIMARY"
+  , "REFERENCES"
+  , "RETURNING"
+  , "SELECT"
+  , "SESSION_USER"
+  , "SOME"
+  , "SYMMETRIC"
+  , "TABLE"
+  , "THEN"
+  , "TO"
+  , "TRAILING"
+  , "TRUE"
+  , "UNION"
+  , "UNIQUE"
+  , "USER"
+  , "USING"
+  , "VARIADIC"
+  , "WHEN"
+  , "WHERE"
+  , "WINDOW"
+  , "WITH"
+  ]
 
 sqlSingleQuoted :: Text -> Text
 sqlSingleQuoted t = "'" <> t <> "'"