packages feed

postgresql-query 1.4.0 → 2.0.0

raw patch · 8 files changed

+66/−41 lines, 8 filesdep +th-liftdep +th-lift-instances

Dependencies added: th-lift, th-lift-instances

Files

CHANGELOG.md view
@@ -1,6 +1,15 @@ # CHANGELOG -## 1.4.1+## 2.0.0+### Changed+* `Entity` typeclass now use `FN` instead of `Text`. This provides an+  ability to define dot-separated table names like+  `schemaname.tablename`. This changes breaks backward compatibility,+  so major version is bumped to 2.++* TH code changed according to changes in `Entity` typeclass.++## 1.4.0 ### Changed * `eoDeriveClasse` renamed to `eoDeriveClasses` ### Added
postgresql-query.cabal view
@@ -1,5 +1,5 @@ name:                postgresql-query-version:             1.4.0+version:             2.0.0  synopsis: Sql interpolating quasiquote plus some kind of primitive ORM           using it@@ -8,7 +8,6 @@ license-file:        LICENSE author:              Aleksey Uimanov maintainer:          s9gf4ult@gmail.com--- copyright: category:            Database build-type:          Simple cabal-version:       >=1.10@@ -78,6 +77,8 @@                , semigroups                , template-haskell                , text+               , th-lift+               , th-lift-instances                , time                , transformers                , transformers-base@@ -99,9 +100,9 @@                     , OverloadedStrings                     , TemplateHaskell -  build-depends: base >=4.6 && < 5-               , QuickCheck+  build-depends: QuickCheck                , attoparsec+               , base                          >=4.6 && < 5                , postgresql-query                , quickcheck-assertions                , quickcheck-instances
src/Database/PostgreSQL/Query/Entity.hs view
@@ -5,8 +5,8 @@  import Data.Proxy import Data.Text ( Text )-import Data.Typeable-    ( Typeable )+import Data.Typeable ( Typeable )+import Database.PostgreSQL.Query.Types  -- | Auxiliary typeclass for data types which can map to rows of some -- table. This typeclass is used inside functions like 'pgSelectEntities' to@@ -15,10 +15,10 @@     -- | Id type for this entity     data EntityId a :: *     -- | Table name of this entity-    tableName :: Proxy a -> Text+    tableName :: Proxy a -> FN     -- | Field names without 'id' and 'created'. The order of field names must match     -- with order of fields in 'ToRow' and 'FromRow' instances of this type.-    fieldNames :: Proxy a -> [Text]+    fieldNames :: Proxy a -> [FN]  deriving instance Typeable EntityId 
src/Database/PostgreSQL/Query/Functions.hs view
@@ -36,7 +36,6 @@ import Data.Maybe ( listToMaybe ) import Data.Monoid import Data.Proxy ( Proxy(..) )-import Data.Text ( Text ) import Data.Typeable ( Typeable ) import Database.PostgreSQL.Query.Entity     ( Entity(..), Ent )@@ -45,7 +44,7 @@       entityFields, selectEntitiesBy, insertManyEntities,       updateTable, insertInto ) import Database.PostgreSQL.Query.SqlBuilder-    ( ToSqlBuilder(..), runSqlBuilder, mkIdent  )+    ( ToSqlBuilder(..), runSqlBuilder ) import Database.PostgreSQL.Query.TH     ( sqlExp ) import Database.PostgreSQL.Query.Types@@ -323,7 +322,7 @@ pgDeleteEntity eid =     let p = Proxy :: Proxy a     in fmap (1 ==)-       $ pgExecute [sqlExp|DELETE FROM ^{mkIdent $ tableName p}+       $ pgExecute [sqlExp|DELETE FROM ^{tableName p}                            WHERE id = #{eid}|]  @@ -357,7 +356,7 @@     in if L.null $ unMR mr        then return False        else fmap (1 ==)-            $ pgExecute [sqlExp|UPDATE ^{mkIdent $ tableName p}+            $ pgExecute [sqlExp|UPDATE ^{tableName p}                                 SET ^{mrToBuilder ", " mr}                                 WHERE id = #{eid}|] @@ -377,7 +376,7 @@               -> q               -> m Integer pgSelectCount p q = do-    [[c]] <- pgQuery [sqlExp|SELECT count(id) FROM ^{mkIdent $ tableName p} ^{q}|]+    [[c]] <- pgQuery [sqlExp|SELECT count(id) FROM ^{tableName p} ^{q}|]     return c  @@ -406,9 +405,9 @@ -}  pgRepsertRow :: (HasPostgres m, MonadLogger m, ToMarkedRow wrow, ToMarkedRow urow)-             => Text              -- ^ Table name-             -> wrow              -- ^ where condition-             -> urow              -- ^ update row+             => FN              -- ^ Table name+             -> wrow            -- ^ where condition+             -> urow            -- ^ update row              -> m () pgRepsertRow tname wrow urow = do     let wmr = toMarkedRow wrow
src/Database/PostgreSQL/Query/Internal.hs view
@@ -19,16 +19,14 @@ import Data.List.NonEmpty ( NonEmpty ) import Data.Monoid import Data.Proxy ( Proxy(..) )-import Data.Text ( Text ) import Database.PostgreSQL.Query.Entity     ( Entity(..) ) import Database.PostgreSQL.Query.SqlBuilder-    ( SqlBuilder, ToSqlBuilder(..),-      mkIdent, mkValue )+    ( SqlBuilder, ToSqlBuilder(..), mkValue ) import Database.PostgreSQL.Query.TH     ( sqlExp ) import Database.PostgreSQL.Query.Types-    ( FN(..), textFN, MarkedRow(..),+    ( FN(..), MarkedRow(..),       ToMarkedRow(..), mrToBuilder ) import Database.PostgreSQL.Simple.ToRow     ( ToRow(..) )@@ -39,7 +37,8 @@ {- $setup >>> import Database.PostgreSQL.Simple >>> import Database.PostgreSQL.Simple.ToField->>> import PGSimple.SqlBuilder+>>> import Database.PostgreSQL.Query.SqlBuilder+>>> import Data.Text ( Text ) >>> con <- connect defaultConnectInfo -} @@ -63,14 +62,14 @@ -}  updateTable :: (ToSqlBuilder q, ToMarkedRow flds)-            => Text              -- ^ table name-            -> flds              -- ^ fields to update-            -> q                 -- ^ condition+            => FN               -- ^ table name+            -> flds             -- ^ fields to update+            -> q                -- ^ condition             -> SqlBuilder updateTable tname flds q =     let mr = toMarkedRow flds         setFields = mrToBuilder ", " mr-    in [sqlExp|UPDATE ^{mkIdent tname}+    in [sqlExp|UPDATE ^{tname}                SET ^{setFields} ^{q}|]  @@ -82,8 +81,8 @@ -}  insertInto :: (ToMarkedRow b)-           => Text               -- ^ table name-           -> b                  -- ^ list of pairs (name, value) to insert into+           => FN       -- ^ table name+           -> b        -- ^ list of pairs (name, value) to insert into            -> SqlBuilder insertInto tname b =     let mr = toMarkedRow b@@ -95,7 +94,7 @@                  $ L.intersperse ", "                  $ map snd                  $ unMR mr-    in [sqlExp|INSERT INTO ^{mkIdent tname}+    in [sqlExp|INSERT INTO ^{tname}                (^{names}) VALUES (^{values})|]  @@ -130,7 +129,7 @@ entityFields xpref fpref p =     buildFields     $ xpref-    $ map (fpref . FN . (:[]))+    $ map fpref     $ fieldNames p  {- | Same as 'entityFields' but prefixes list of names with __id__@@ -174,7 +173,7 @@              -> Proxy a              -> SqlBuilder selectEntity bld p =-    [sqlExp|SELECT ^{bld p} FROM ^{mkIdent $ tableName p}|]+    [sqlExp|SELECT ^{bld p} FROM ^{tableName p}|]   {- | Generates SELECT FROM WHERE query with most used conditions@@ -221,7 +220,7 @@ entityToMR :: forall a. (Entity a, ToRow a) => a -> MarkedRow entityToMR a =     let p = Proxy :: Proxy a-        names = map textFN $ fieldNames p+        names = fieldNames p         values = map mkValue $ toRow a     in MR $ zip names values @@ -252,21 +251,24 @@  -} -insertManyEntities :: forall a. (Entity a, ToRow a) => NonEmpty a -> SqlBuilder+insertManyEntities :: forall a. (Entity a, ToRow a)+                   => NonEmpty a+                   -> SqlBuilder insertManyEntities rows =     let p = Proxy :: Proxy a         names = mconcat                 $ L.intersperse ","-                $ map mkIdent+                $ map toSqlBuilder                 $ fieldNames p         values = mconcat                  $ L.intersperse ","                  $ map rValue                  $ NL.toList rows -    in [sqlExp|INSERT INTO ^{mkIdent $ tableName p}+    in [sqlExp|INSERT INTO ^{tableName p}                (^{names}) VALUES ^{values}|]   where+    rValue :: a -> SqlBuilder     rValue row =         let values = mconcat                      $ L.intersperse ","
src/Database/PostgreSQL/Query/TH.hs view
@@ -17,14 +17,18 @@ import Prelude  import Control.Applicative+import Control.Monad import Data.Default import Data.FileEmbed ( embedFile )+import Data.String import Database.PostgreSQL.Query.Entity ( Entity(..) ) import Database.PostgreSQL.Query.TH.SqlExp+import Database.PostgreSQL.Query.Types ( FN(..) ) import Database.PostgreSQL.Simple.FromRow ( FromRow(..), field ) import Database.PostgreSQL.Simple.ToRow ( ToRow(..) ) import Database.PostgreSQL.Simple.Types ( Query(..) ) import Language.Haskell.TH+import Language.Haskell.TH.Syntax  -- | Return constructor name cName :: (Monad m) => Con -> m Name@@ -196,12 +200,15 @@                 [(mkName unidname, NotStrict, idtype)]         iddec = NewtypeInstD [] entityIdName [ConT tname]                 idcon (eoDeriveClasses opts)-        tblName = eoTableName opts tnames-        fldNames = map (eoColumnNames opts . nameBase) $ cFieldNames tcon+        tblName = fromString $ eoTableName opts tnames+        fldNames = map (fromString . eoColumnNames opts . nameBase)+                   $ cFieldNames tcon     VarE ntableName  <- [e|tableName|]     VarE nfieldNames <- [e|fieldNames|]-    let tbldec = FunD ntableName  [Clause [WildP] (NormalB $ LitE  $ stringL tblName) []]-        flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE $ map (LitE . stringL) fldNames) []]+    tblExp <- lift (tblName :: FN)+    fldExp <- mapM lift (fldNames :: [FN])+    let tbldec = FunD ntableName  [Clause [WildP] (NormalB tblExp) []]+        flddec = FunD nfieldNames [Clause [WildP] (NormalB $ ListE fldExp) []]         ret = InstanceD [] econt               [ iddec, tbldec, flddec ]         syndec = TySynD (mkName idname) [] (AppT (ConT entityIdName) (ConT tname))
src/Database/PostgreSQL/Query/TH/SqlExp.hs view
@@ -39,7 +39,8 @@  {- $setup >>> import Database.PostgreSQL.Simple->>> import PGSimple.SqlBuilder+>>> import Database.PostgreSQL.Query.SqlBuilder+>>> import Data.Text ( Text ) >>> import qualified Data.List as L >>> c <- connect defaultConnectInfo -}
src/Database/PostgreSQL/Query/Types.hs view
@@ -53,6 +53,8 @@ import Database.PostgreSQL.Simple.ToField     ( ToField ) import GHC.Generics+import Instances.TH.Lift ()+import Language.Haskell.TH.Lift ( deriveLift )  import qualified Data.List as L import qualified Control.Monad.Trans.State.Lazy as STL@@ -63,7 +65,8 @@ import qualified Data.Text.Encoding as T  {- $setup->>> import PGSimple.SqlBuilder+>>> import Database.PostgreSQL.Query.SqlBuilder+>>> import Data.Text ( Text ) >>> c <- connect defaultConnectInfo -} @@ -75,6 +78,7 @@     } deriving ( IsString, Eq, Ord, Read, Show                , Typeable, Monoid, ToField ) + instance FromField InetText where     fromField fld Nothing = returnError ConversionFailed                             fld "can not convert Null to InetText"@@ -120,6 +124,8 @@  newtype FN = FN [Text]     deriving (Ord, Eq, Show, Monoid, Typeable, Generic)++$(deriveLift ''FN)  instance ToSqlBuilder FN where     toSqlBuilder (FN tt) =