hpqtypes-extras 1.3.1.1 → 1.4.0.0

raw patch · 5 files changed

+52/−4 lines, 5 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +3/−0
• hpqtypes-extras.cabal +2/−1
• src/Database/PostgreSQL/PQTypes/Checks.hs +5/−2
• src/Database/PostgreSQL/PQTypes/Model/ColumnType.hs +3/−0
• src/Database/PostgreSQL/PQTypes/Model/Index.hs +39/−1

@@ -1,3 +1,6 @@+# hpqtypes-extras-1.4.0.0 (2017-11-24)+* Introduced tsvector postgres type and indexing methods GIN and BTree+ # hpqtypes-extras-1.3.1.1 (2017-07-21) * Now depends on 'log-base' instead of 'log'. 

@@ -1,5 +1,5 @@ name:                hpqtypes-extras-version:             1.3.1.1+version:             1.4.0.0 synopsis:            Extra utilities for hpqtypes library description:         The following extras for hpqtypes library:                      .@@ -80,6 +80,7 @@                     , TupleSections                     , TypeFamilies                     , UndecidableInstances+                    , ViewPatterns  test-suite  hpqtypes-extras-tests   type:               exitcode-stdio-1.0

@@ -821,10 +821,12 @@ sqlGetIndexes table = toSQLCommand . sqlSelect "pg_catalog.pg_class c" $ do   sqlResult "c.relname::text" -- index name   sqlResult $ "ARRAY(" <> selectCoordinates <> ")" -- array of index coordinates+  sqlResult "am.amname::text" -- the method used (btree, gin etc)   sqlResult "i.indisunique" -- is it unique?   -- if partial, get constraint def   sqlResult "pg_catalog.pg_get_expr(i.indpred, i.indrelid, true)"   sqlJoinOn "pg_catalog.pg_index i" "c.oid = i.indexrelid"+  sqlJoinOn "pg_catalog.pg_am am" "c.relam = am.oid"   sqlLeftJoinOn "pg_catalog.pg_constraint r"     "r.conrelid = i.indrelid AND r.conindid = i.indexrelid"   sqlWhereEqSql "i.indrelid" $ sqlGetTableID table@@ -842,10 +844,11 @@       , "SELECT name FROM coordinates WHERE k > 0"       ] -fetchTableIndex :: (String, Array1 String, Bool, Maybe String)+fetchTableIndex :: (String, Array1 String, String, Bool, Maybe String)                 -> (TableIndex, RawSQL ())-fetchTableIndex (name, Array1 columns, unique, mconstraint) = (TableIndex {+fetchTableIndex (name, Array1 columns, method, unique, mconstraint) = (TableIndex {   idxColumns = map unsafeSQL columns+, idxMethod = read method , idxUnique = unique , idxWhere = unsafeSQL `liftM` mconstraint }, unsafeSQL name)

@@ -23,6 +23,7 @@   | SmallIntT   | TextT   | TimestampWithZoneT+  | TSVectorT   | XmlT   | ArrayT !ColumnType   | CustomT !(RawSQL ())@@ -48,6 +49,7 @@         "smallint" -> SmallIntT         "text" -> TextT         "timestamp with time zone" -> TimestampWithZoneT+        "tsvector" -> TSVectorT         "xml" -> XmlT         tname           | "[]" `T.isSuffixOf` tname -> ArrayT . parseType $ T.take (T.length tname - 2) tname@@ -66,6 +68,7 @@ columnTypeToSQL JsonbT             = "JSONB" columnTypeToSQL SmallIntT          = "SMALLINT" columnTypeToSQL TextT              = "TEXT"+columnTypeToSQL TSVectorT          = "TSVECTOR" columnTypeToSQL TimestampWithZoneT = "TIMESTAMPTZ" columnTypeToSQL XmlT               = "XML" columnTypeToSQL (ArrayT t)         = columnTypeToSQL t <> "[]"

@@ -1,8 +1,11 @@ module Database.PostgreSQL.PQTypes.Model.Index (     TableIndex(..)+  , IndexMethod(..)   , tblIndex   , indexOnColumn   , indexOnColumns+  , indexOnColumnWithMethod+  , indexOnColumnsWithMethod   , uniqueIndexOnColumn   , uniqueIndexOnColumnWithCondition   , uniqueIndexOnColumns@@ -24,13 +27,29 @@  data TableIndex = TableIndex {   idxColumns :: [RawSQL ()]+, idxMethod  :: IndexMethod , idxUnique  :: Bool , idxWhere   :: Maybe (RawSQL ()) } deriving (Eq, Ord, Show) +data IndexMethod =+    BTree+  | GIN+  deriving (Eq, Ord)++instance Show IndexMethod where+    show BTree = "btree"+    show GIN   = "gin"++instance Read IndexMethod where+    readsPrec _ (map toLower -> "btree") = [(BTree,"")]+    readsPrec _ (map toLower -> "gin")   = [(GIN,"")]+    readsPrec _ _       = []+ tblIndex :: TableIndex tblIndex = TableIndex {   idxColumns = []+, idxMethod = BTree , idxUnique = False , idxWhere = Nothing }@@ -38,12 +57,28 @@ indexOnColumn :: RawSQL () -> TableIndex indexOnColumn column = tblIndex { idxColumns = [column] } +-- | Create an index on the given column with the specified method.  No checks+-- are made that the method is appropriate for the type of the column.+indexOnColumnWithMethod :: RawSQL () -> IndexMethod -> TableIndex+indexOnColumnWithMethod column method =+    tblIndex { idxColumns = [column]+             , idxMethod = method }+ indexOnColumns :: [RawSQL ()] -> TableIndex indexOnColumns columns = tblIndex { idxColumns = columns } +-- | Create an index on the given columns with the specified method.  No checks+-- are made that the method is appropriate for the type of the column;+-- cf. [the PostgreSQL manual](https://www.postgresql.org/docs/current/static/indexes-multicolumn.html).+indexOnColumnsWithMethod :: [RawSQL ()] -> IndexMethod -> TableIndex+indexOnColumnsWithMethod columns method =+    tblIndex { idxColumns = columns+             , idxMethod = method }+ uniqueIndexOnColumn :: RawSQL () -> TableIndex uniqueIndexOnColumn column = TableIndex {   idxColumns = [column]+, idxMethod = BTree , idxUnique = True , idxWhere = Nothing }@@ -51,6 +86,7 @@ uniqueIndexOnColumns :: [RawSQL ()] -> TableIndex uniqueIndexOnColumns columns = TableIndex {   idxColumns = columns+, idxMethod = BTree , idxUnique = True , idxWhere = Nothing }@@ -58,6 +94,7 @@ uniqueIndexOnColumnWithCondition :: RawSQL () -> RawSQL () -> TableIndex uniqueIndexOnColumnWithCondition column whereC = TableIndex {   idxColumns = [column]+, idxMethod = BTree , idxUnique = True , idxWhere = Just whereC }@@ -89,7 +126,8 @@ sqlCreateIndex tname idx@TableIndex{..} = mconcat [     "CREATE "   , if idxUnique then "UNIQUE " else ""-  , "INDEX" <+> indexName tname idx <+> "ON" <+> tname <+> "("+  , "INDEX" <+> indexName tname idx <+> "ON" <+> tname <+> ""+  , "USING" <+> (rawSQL (T.pack . show $ idxMethod) ()) <+> "("   , mintercalate ", " idxColumns   , ")"   , maybe "" (" WHERE" <+>) idxWhere