selda 0.4.0.0 → 0.5.0.0

raw patch · 14 files changed

+115/−68 lines, 14 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• LICENSE +1/−1
• selda.cabal +1/−1
• src/Database/Selda.hs +13/−13
• src/Database/Selda/Backend/Internal.hs +3/−0
• src/Database/Selda/Column.hs +12/−3
• src/Database/Selda/Migrations.hs +2/−2
• src/Database/Selda/Nullable.hs +9/−9
• src/Database/Selda/Query.hs +4/−4
• src/Database/Selda/SqlType.hs +4/−3
• src/Database/Selda/Table.hs +8/−7
• src/Database/Selda/Table/Compile.hs +37/−14
• src/Database/Selda/Table/Type.hs +0/−8
• src/Database/Selda/Types.hs +12/−3

@@ -1,6 +1,15 @@ # Revision history for Selda  +## 0.5.0.0 -- 2019-09-21++* index and indexUsing now accept a Group instead of a Selector (#121)+* Custom type errors for scope mismatches.+* Provide Generic instances for ID and RowID.+* Provide To/FromJSON instances for ID and RowID (selda-json).+* Add back MonadTrans instance for SeldaT.++ ## 0.4.0.0 -- 2019-06-02  * Type-safe support for backend-specific functionality. Top level query definitions now require explicit type signature. (#80)

@@ -1,6 +1,6 @@ MIT License -Copyright (c) 2017-2018 Anton Ekblad+Copyright (c) 2017-2019 Anton Ekblad  Permission is hereby granted, free of charge, to any person obtaining a copy of this software and associated documentation files (the "Software"), to deal

@@ -1,5 +1,5 @@ name:                selda-version:             0.4.0.0+version:             0.5.0.0 synopsis:            Multi-backend, high-level EDSL for interacting with SQL databases. description:         This package provides an EDSL for writing portable, type-safe, high-level                      database code. Its feature set includes querying and modifying databases,

@@ -21,7 +21,7 @@ --   basics. module Database.Selda   ( -- * Running queries-    MonadSelda+    MonadSelda, Backend   , SeldaError (..), ValidationError   , SeldaT, SeldaM   , Relational, Only (..), The (..)@@ -32,7 +32,7 @@      -- * Constructing queries   , SqlType (..), SqlRow (..), SqlEnum (..)-  , Columns+  , Columns, Same   , Order (..)   , (:*:)(..)   , select, selectValues, from, distinct@@ -278,8 +278,8 @@ --   semantics are used. This means that comparing to a @NULL@ field will remove --   the row in question from the current set. --   To test for @NULL@, use 'isNull' instead of @.== literal Nothing@.-(.==), (./=) :: SqlType a => Col s a -> Col s a -> Col s Bool-(.>), (.<), (.>=), (.<=) :: SqlOrd a => Col s a -> Col s a -> Col s Bool+(.==), (./=) :: (Same s t, SqlType a) => Col s a -> Col t a -> Col s Bool+(.>), (.<), (.>=), (.<=) :: (Same s t, SqlOrd a) => Col s a -> Col t a -> Col s Bool (.==) = liftC2 $ BinOp Eq (./=) = liftC2 $ BinOp Neq (.>)  = liftC2 $ BinOp Gt@@ -301,16 +301,16 @@ --   and returns the given default value where it is. -- --   This is the Selda equivalent of 'maybe'.-matchNull :: (SqlType a, SqlType b)+matchNull :: (SqlType a, SqlType b, Same s t)           => Col s b           -> (Col s a -> Col s b)-          -> Col s (Maybe a)+          -> Col t (Maybe a)           -> Col s b matchNull nullvalue f x = ifThenElse (isNull x) nullvalue (f (cast x))  -- | If the second value is Nothing, return the first value. Otherwise return --   the second value.-ifNull :: SqlType a => Col s a -> Col s (Maybe a) -> Col s a+ifNull :: (Same s t, SqlType a) => Col s a -> Col t (Maybe a) -> Col s a ifNull nullvalue x = ifThenElse (isNull x) nullvalue (cast x)  -- | Any container type which can be mapped over.@@ -334,7 +334,7 @@ -- | Any container type for which we can check object membership. class Set set where   -- | Is the given column contained in the given set?-  isIn :: SqlType a => Col s a -> set (Col s a) -> Col s Bool+  isIn :: (Same s t, SqlType a) => Col s a -> set (Col t a) -> Col s Bool infixl 4 `isIn`  instance Set [] where@@ -344,7 +344,7 @@ instance Set (Query s) where   isIn (One x) = One . InQuery x . snd . compQueryWithFreshScope -(.&&), (.||) :: Col s Bool -> Col s Bool -> Col s Bool+(.&&), (.||) :: Same s t => Col s Bool -> Col t Bool -> Col s Bool (.&&) = liftC2 $ BinOp And (.||) = liftC2 $ BinOp Or infixr 3 .&&@@ -374,8 +374,8 @@  -- | Returns 'true' if the given field in the given row is equal to the given --   literal.-is :: SqlType c => Selector r c -> c -> Row s r -> Col s Bool-is s x r = r ! s .== literal x+is :: forall r s c. SqlType c => Selector r c -> c -> Row s r -> Col s Bool+is s x r = r ! s .== (literal x :: Col s c)  -- | SQL NULL, at any type you like. null_ :: SqlType a => Col s (Maybe a)@@ -402,7 +402,7 @@ --   For instance: -- -- > "%gon" `like` "dragon" .== true-like :: Col s Text -> Col s Text -> Col s Bool+like :: Same s t => Col s Text -> Col t Text -> Col s Bool like = liftC2 $ BinOp Like infixl 4 `like` @@ -458,5 +458,5 @@ toString = cast  -- | Perform a conditional on a column-ifThenElse :: SqlType a => Col s Bool -> Col s a -> Col s a -> Col s a+ifThenElse :: (Same s t, Same t u, SqlType a) => Col s Bool -> Col t a -> Col u a -> Col s a ifThenElse = liftC3 If

@@ -259,6 +259,9 @@   type Backend (SeldaT b m) = b   withConnection m = S get >>= m +instance MonadTrans (SeldaT b) where+  lift = S . lift+ -- | The simplest form of Selda computation; 'SeldaT' specialized to 'IO'. type SeldaM b = SeldaT b IO 

@@ -1,8 +1,9 @@ {-# LANGUAGE GADTs, TypeFamilies, TypeOperators, PolyKinds #-} {-# LANGUAGE FlexibleInstances, OverloadedStrings, ScopedTypeVariables #-}+{-# LANGUAGE DataKinds, UndecidableInstances, MultiParamTypeClasses #-} -- | Columns and associated utility functions, specialized to 'SQL'. module Database.Selda.Column-  ( Columns+  ( Columns, Same   , Row (..), Col (..), SomeCol (..), UntypedCol (..)   , Exp (..), NulOp (..), UnOp (..), BinOp (..)   , toTup, fromTup, liftC, liftC2, liftC3@@ -18,6 +19,7 @@ import Data.Proxy import Data.String import Data.Text (Text)+import GHC.TypeLits as TL  -- | Any column tuple. class Columns a where@@ -66,8 +68,15 @@        -> Col s d liftC3 f (One a) (One b) (One c) = One (f a b c) -liftC2 :: (Exp SQL a -> Exp SQL b -> Exp SQL c) -> Col s a -> Col s b -> Col s c-liftC2 f (One a) (One b) = One (f a b)+-- | Denotes that scopes @s@ and @t@ are identical.+class s ~ t => Same s t where+  liftC2 :: (Exp SQL a -> Exp SQL b -> Exp SQL c) -> Col s a -> Col t b -> Col s c+  liftC2 f (One a) (One b) = One (f a b)++instance {-# OVERLAPPING #-} Same s s+instance {-# OVERLAPPABLE #-} (s ~ t, TypeError+  ('TL.Text "An identifier from an outer scope may not be used in an inner query."))+  => Same s t  liftC :: (Exp SQL a -> Exp SQL b) -> Col s a -> Col s b liftC f (One x) = One (f x)

@@ -41,8 +41,8 @@ --   Both table schemas are validated before starting the migration, and the --   source table is validated against what's currently in the database. -----   The migration is performed as a migration, ensuring that either the entire---   migration passes, or none of it does.+--   The migration is performed as a transaction, ensuring that either the+--   entire migration passes, or none of it does. migrate :: (MonadSelda m, MonadMask m, Relational a, Relational b)         => Table a -- ^ Table to migrate from.         -> Table b -- ^ Table to migrate to.

@@ -28,16 +28,16 @@ fromNullable :: SqlType (NonNull a) => Col s a -> Col s (NonNull a) fromNullable = unsafeCoerce -(?==), (?/=) :: (a :?~ b, SqlType a) => Col s a -> Col s b -> Col s (Maybe Bool)+(?==), (?/=) :: (a :?~ b, SqlType a, Same s t) => Col s a -> Col t b -> Col s (Maybe Bool) -(?>), (?<), (?>=), (?<=) :: (a :?~ b, SqlOrd (NonNull a))-                         => Col s a -> Col s b -> Col s (Maybe Bool)+(?>), (?<), (?>=), (?<=) :: (a :?~ b, SqlOrd (NonNull a), Same s t)+                         => Col s a -> Col t b -> Col s (Maybe Bool) -(?+), (?-), (?*) :: (a :?~ b, Num (NonNull a))-                 => Col s a -> Col s b -> Col s (Maybe (NonNull a))+(?+), (?-), (?*) :: (a :?~ b, Num (NonNull a), Same s t)+                 => Col s a -> Col t b -> Col s (Maybe (NonNull a)) -(?/) :: (a :?~ b, Fractional (Col s (NonNull a)))-     => Col s a -> Col s b -> Col s (Maybe (NonNull a))+(?/) :: (a :?~ b, Fractional (Col s (NonNull a)), Same s t)+     => Col s a -> Col t b -> Col s (Maybe (NonNull a))  a ?== b = cast $ fromNullable a .== fromNullable b a ?/= b = cast $ fromNullable a ./= fromNullable b@@ -69,12 +69,12 @@  -- | Converts a nullable column into a non-nullable one, yielding the empty --   result set if the column is null.-nonNull :: SqlType a => Col s (Maybe a) -> Query s (Col s a)+nonNull :: (Same s t, SqlType a) => Col s (Maybe a) -> Query t (Col t a) nonNull x = do   restrict (not_ $ isNull x)   return (fromNullable x)  -- | Restrict a query using a nullable expression. --   Equivalent to @restrict . ifNull false@.-restrict' :: Col s (Maybe Bool) -> Query s ()+restrict' :: Same s t => Col s (Maybe Bool) -> Query t () restrict' = restrict . fromNullable

@@ -52,7 +52,7 @@     defToVal (Right x) = x  -- | Restrict the query somehow. Roughly equivalent to @WHERE@.-restrict :: Col s Bool -> Query s ()+restrict :: Same s t => Col s Bool -> Query t () restrict (One p) = Query $ do     st <- get     put $ case sources st of@@ -168,7 +168,7 @@ -- >   person <- select people -- >   name' <- groupBy (person ! name) -- >   return (name' :*: count(person ! pet_name) .> 0)-groupBy :: SqlType a => Col (Inner s) a -> Query (Inner s) (Aggr (Inner s) a)+groupBy :: (Same s t, SqlType a) => Col (Inner s) a -> Query (Inner t) (Aggr (Inner t) a) groupBy (One c) = Query $ do   st <- get   put $ st {groupCols = Some c : groupCols st}@@ -176,7 +176,7 @@  -- | Drop the first @m@ rows, then get at most @n@ of the remaining rows from the --   given subquery.-limit :: Int -> Int -> Query (Inner s) a -> Query s (OuterCols a)+limit :: Same s t => Int -> Int -> Query (Inner s) a -> Query t (OuterCols a) limit from to q = Query $ do   (lim_st, res) <- isolate q   st <- get@@ -208,7 +208,7 @@ --   is buried somewhere deep in an earlier query. --   However, the ordering must always be stable, to ensure that previous --   calls to order are not simply erased.-order :: SqlType a => Col s a -> Order -> Query s ()+order :: (Same s t, SqlType a) => Col s a -> Order -> Query t () order (One c) o = Query $ do   st <- get   case sources st of

@@ -1,5 +1,5 @@ {-# LANGUAGE GADTs, OverloadedStrings, ScopedTypeVariables, FlexibleInstances #-}-{-# LANGUAGE UndecidableInstances, DefaultSignatures #-}+{-# LANGUAGE UndecidableInstances, DefaultSignatures, DeriveGeneric #-} -- | Types representable as columns in Selda's subset of SQL. module Database.Selda.SqlType   ( SqlType (..), SqlEnum (..)@@ -18,6 +18,7 @@ import Data.Time import Data.Typeable import Data.UUID.Types (UUID, toString, fromByteString, nil)+import GHC.Generics (Generic)  -- | Format string used to represent date and time when --   representing timestamps as text.@@ -199,7 +200,7 @@ -- | A row identifier for some table. --   This is the type of auto-incrementing primary keys. newtype RowID = RowID Int-  deriving (Eq, Ord, Typeable)+  deriving (Eq, Ord, Typeable, Generic) instance Show RowID where   show (RowID n) = show n @@ -227,7 +228,7 @@ --   "Database.Selda.Unsafe" module if you for some reason need to add a type --   to a row identifier. newtype ID a = ID {untyped :: RowID}-  deriving (Eq, Ord, Typeable)+  deriving (Eq, Ord, Typeable, Generic) instance Show (ID a) where   show = show . untyped 

@@ -15,7 +15,7 @@   , untypedAutoPrimary, weakUntypedAutoPrimary   , unique   , index, indexUsing-  , tableExpr, indexedCols+  , tableExpr   , isAutoPrimary, isPrimary, isUnique   ) where import Data.Text (Text)@@ -122,9 +122,10 @@       | sel :- Attribute [a] <- attrs       , let ixs = indices sel       , case ixs of-          (_:_:_)           -> True-          [_] | a == Unique -> True-          _                 -> False+          (_:_:_)              -> True+          [_] | a == Unique    -> True+          [_] | Indexed _ <- a -> True+          _                    -> False       ]     pkAttrs = concat       [ [(ixs, Primary), (ixs, Required)]@@ -173,12 +174,12 @@ primary :: Attribute Group t a primary = Attribute [Primary, Required] --- | Create an index on this column.-index :: Attribute Selector t c+-- | Create an index on these column(s).+index :: Attribute Group t c index = Attribute [Indexed Nothing]  -- | Create an index using the given index method on this column.-indexUsing :: IndexMethod -> Attribute Selector t c+indexUsing :: IndexMethod -> Attribute Group t c indexUsing m = Attribute [Indexed (Just m)]  -- | An auto-incrementing primary key.

@@ -3,13 +3,15 @@ module Database.Selda.Table.Compile where import Database.Selda.Table import Database.Selda.Table.Validation+import           Data.IntMap (IntMap)+import qualified Data.IntMap as IntMap import Data.List (foldl') #if !MIN_VERSION_base(4, 11, 0) import Data.Monoid #endif import Data.Text (Text, intercalate, pack) import qualified Data.Text as Text-import Database.Selda.SQL hiding (param)+import Database.Selda.SQL hiding (param,cols) import Database.Selda.SQL.Print.Config import Database.Selda.SqlType (SqlTypeRep(..)) import Database.Selda.Types@@ -49,29 +51,50 @@ -- | Compile the @CREATE INDEX@ queries for all indexes on the given table. compileCreateIndexes :: PPConfig -> OnError -> Table a -> [Text] compileCreateIndexes cfg ifex tbl =-  [ compileCreateIndex cfg ifex (tableName tbl) col mmethod-  | (col, mmethod) <- indexedCols tbl+  [ compileCreateIndex cfg ifex (tableName tbl) (colNameOfIdx <$> idxs) mmethod+  | (idxs, Indexed mmethod) <- tableAttrs tbl   ]+ where+ idxMap :: IntMap ColName+ idxMap = IntMap.fromList (zip [0..] (colName <$> tableCols tbl))+ colNameOfIdx :: Int -> ColName+ colNameOfIdx colIdx =+    case IntMap.lookup colIdx idxMap of+        Nothing   -> error "Impossible: Index has non-existant column-index."+        Just name -> name --- | Get the name to use for an index on the given column in the given table.-indexNameFor :: TableName -> ColName -> Text-indexNameFor t c =-  fromColName $ addColPrefix c ("ix" <> rawTableName t <> "_")+-- | Get the name to use for an index on the given column(s) in the given table.+--+-- To ensure uniqueness+--+-- 1. Name multi-column indexes by connecting column names+--    with underscores.+-- 2. Escape underscores in column names.+--+-- Thus the index of columns @["foo","bar"]@ becomes @ixTable_foo_bar@ while+-- the index @["foo_bar"]@ receives an extra underscore to become+-- @ixTable_foo__bar@.+indexNameFor :: TableName -> [ColName] -> Text+indexNameFor t cs =+  let escUnderscore c = modColName c (Text.replace "_" "__") in+  let ixPrefix partial = "ix" <> rawTableName t <> "_" <> partial+  in ixPrefix (intercalateColNames "_" (escUnderscore <$> cs))  -- | Compile a @CREATE INDEX@ query for the given index. compileCreateIndex :: PPConfig                    -> OnError                    -> TableName-                   -> ColName+                   -> [ColName]                    -> Maybe IndexMethod                    -> Text-compileCreateIndex cfg ifex tbl col mmethod = mconcat-  [ "CREATE INDEX ", indexNameFor tbl col, " ON ", fromTableName tbl+compileCreateIndex cfg ifex tbl cols mmethod = mconcat+  [ "CREATE INDEX"+  , if ifex == Ignore then " IF NOT EXISTS " else " "+  , indexNameFor tbl cols, " ON ", fromTableName tbl   , case mmethod of-      Just method -> " " <> ppIndexMethodHook cfg method-      _           -> ""-  , " (", fromColName col, ")"-  , if ifex == Ignore then " IF NOT EXISTS" else ""+        Just method -> " " <> ppIndexMethodHook cfg method+        Nothing     -> ""+  , " (", Text.intercalate ", " (map fromColName cols), ")"   ]  -- | Compile a foreign key constraint.

@@ -23,14 +23,6 @@   , tableAttrs :: [([Int], ColAttr)]   } --- | Get all table columns with an explicit index.-indexedCols :: Table a -> [(ColName, Maybe IndexMethod)]-indexedCols t =-  [ (colName col, mmethod)-  | col <- tableCols t-  , Indexed mmethod <- colAttrs col-  ]- -- | A complete description of a database column. data ColInfo = ColInfo   { colName  :: ColName

@@ -9,15 +9,15 @@   , first, second, third, fourth, fifth   , ColName, TableName   , modColName, mkColName, mkTableName, addColSuffix, addColPrefix-  , fromColName, fromTableName, rawTableName+  , fromColName, fromTableName, rawTableName, intercalateColNames   ) where import Data.Dynamic import Data.String-import Data.Text (Text, replace, append)+import Data.Text (Text, replace, append, intercalate) import GHC.Generics (Generic)  -- | Name of a database column.-newtype ColName = ColName Text+newtype ColName = ColName { unColName :: Text }   deriving (Ord, Eq, Show, IsString)  -- | Name of a database table.@@ -39,6 +39,15 @@ -- | Convert a column name into a string, with quotes. fromColName :: ColName -> Text fromColName (ColName cn) = mconcat ["\"", escapeQuotes cn, "\""]++-- | Convert column names into a string, without quotes, intercalating the given+-- string.+--+-- @+-- intercalateColNames "_" [ColName "a", ColName "b"] == "a_b"+-- @+intercalateColNames :: Text -> [ColName] -> Text+intercalateColNames inter cs = intercalate inter (escapeQuotes . unColName <$> cs)  -- | Convert a table name into a string, with quotes. fromTableName :: TableName -> Text