Internal.hs

module Database.PostgreSQL.Query.Internal
       ( -- * Entity functions
         entityFields
       , entityFieldsId
       , selectEntity
       , selectEntitiesBy
       , insertEntity
       , insertManyEntities
       , entityToMR
         -- * Low level generators
       , buildFields
       , updateTable
       , insertInto
       ) where


import Prelude

import Data.List.NonEmpty ( NonEmpty )
import Data.Monoid
import Data.Proxy ( Proxy(..) )
import Database.PostgreSQL.Query.Entity
    ( Entity(..) )
import Database.PostgreSQL.Query.SqlBuilder
    ( SqlBuilder, ToSqlBuilder(..), mkValue )
import Database.PostgreSQL.Query.TH
    ( sqlExp )
import Database.PostgreSQL.Query.Types
    ( FN(..), MarkedRow(..),
      ToMarkedRow(..), mrToBuilder )
import Database.PostgreSQL.Simple.ToRow
    ( ToRow(..) )

import qualified Data.List.NonEmpty as NL
import qualified Data.List as L

{- $setup
>>> import Database.PostgreSQL.Simple
>>> import Database.PostgreSQL.Simple.ToField
>>> import Database.PostgreSQL.Query.SqlBuilder
>>> import Data.Text ( Text )
>>> con <- connect defaultConnectInfo
-}


{-| Generates comma separated list of field names

>>> runSqlBuilder con $ buildFields ["u" <> "name", "u" <> "phone", "e" <> "email"]
"\"u\".\"name\", \"u\".\"phone\", \"e\".\"email\""
-}
buildFields :: [FN] -> SqlBuilder
buildFields flds = mconcat
                    $ L.intersperse ", "
                    $ map toSqlBuilder flds

{- | generates __UPDATE__ query

>>> let name = "%vip%"
>>> runSqlBuilder con $ updateTable "ships" (MR [("size", mkValue 15)]) [sqlExp|WHERE size > 15 AND name NOT LIKE #{name}|]
"UPDATE \"ships\" SET  \"size\" = 15  WHERE size > 15 AND name NOT LIKE '%vip%'"

-}

updateTable :: (ToSqlBuilder q, ToMarkedRow flds)
            => FN               -- ^ table name
            -> flds             -- ^ fields to update
            -> q                -- ^ condition
            -> SqlBuilder
updateTable tname flds q =
    let mr = toMarkedRow flds
        setFields = mrToBuilder ", " mr
    in [sqlExp|UPDATE ^{tname}
               SET ^{setFields} ^{q}|]


{- | Generate INSERT INTO query for entity

>>> runSqlBuilder con $ insertInto "foo" $ MR [("name", mkValue "vovka"), ("hobby", mkValue "president")]
"INSERT INTO \"foo\" (\"name\", \"hobby\") VALUES ('vovka', 'president')"

-}

insertInto :: (ToMarkedRow b)
           => FN       -- ^ table name
           -> b        -- ^ list of pairs (name, value) to insert into
           -> SqlBuilder
insertInto tname b =
    let mr = toMarkedRow b
        names = mconcat
                $ L.intersperse ", "
                $ map (toSqlBuilder . fst)
                $ unMR mr
        values = mconcat
                 $ L.intersperse ", "
                 $ map snd
                 $ unMR mr
    in [sqlExp|INSERT INTO ^{tname}
               (^{names}) VALUES (^{values})|]


{- | Build entity fields

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> runSqlBuilder con $ entityFields id id (Proxy :: Proxy Foo)
"\"name\", \"size\""

>>> runSqlBuilder con $ entityFields ("id":) id (Proxy :: Proxy Foo)
"\"id\", \"name\", \"size\""

>>> runSqlBuilder con $ entityFields (\l -> ("id":l) ++ ["created"]) id (Proxy :: Proxy Foo)
"\"id\", \"name\", \"size\", \"created\""

>>> runSqlBuilder con $ entityFields id ("f"<>) (Proxy :: Proxy Foo)
"\"f\".\"name\", \"f\".\"size\""

>>> runSqlBuilder con $ entityFields ("f.id":) ("f"<>) (Proxy :: Proxy Foo)
"\"f\".\"id\", \"f\".\"name\", \"f\".\"size\""

-}

entityFields :: (Entity a)
             => ([FN] -> [FN])    -- ^ modify list of fields. Applied second
             -> (FN -> FN)        -- ^ modify each field name,
                                -- e.g. prepend each field with
                                -- prefix, like ("t"<>). Applied first
             -> Proxy a
             -> SqlBuilder
entityFields xpref fpref p =
    buildFields
    $ xpref
    $ map fpref
    $ fieldNames p

{- | Same as 'entityFields' but prefixes list of names with __id__
field. This is shorthand function for often usage.

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> runSqlBuilder con $ entityFieldsId id (Proxy :: Proxy Foo)
"\"id\", \"name\", \"size\""

>>> runSqlBuilder con $ entityFieldsId ("f"<>) (Proxy :: Proxy Foo)
"\"f\".\"id\", \"f\".\"name\", \"f\".\"size\""

-}

entityFieldsId :: (Entity a)
               => (FN -> FN)
               -> Proxy a
               -> SqlBuilder
entityFieldsId fpref p =
    let xpref = ((fpref "id"):)
    in entityFields xpref fpref p

{- | Generate SELECT query string for entity

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> runSqlBuilder con $ selectEntity (entityFieldsId id) (Proxy :: Proxy Foo)
"SELECT \"id\", \"name\", \"size\" FROM \"foo\""

>>> runSqlBuilder con $ selectEntity (entityFieldsId ("f"<>)) (Proxy :: Proxy Foo)
"SELECT \"f\".\"id\", \"f\".\"name\", \"f\".\"size\" FROM \"foo\""

>>> runSqlBuilder con $ selectEntity (entityFields id id) (Proxy :: Proxy Foo)
"SELECT \"name\", \"size\" FROM \"foo\""

-}

selectEntity :: (Entity a)
             => (Proxy a -> SqlBuilder) -- ^ build fields part from proxy
             -> Proxy a
             -> SqlBuilder
selectEntity bld p =
    [sqlExp|SELECT ^{bld p} FROM ^{tableName p}|]


{- | Generates SELECT FROM WHERE query with most used conditions

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR []
"SELECT \"name\", \"size\" FROM \"foo\""

>>> runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname")]
"SELECT \"name\", \"size\" FROM \"foo\" WHERE  \"name\" = 'fooname' "

>>> runSqlBuilder con $ selectEntitiesBy id (Proxy :: Proxy Foo) $ MR [("name", mkValue "fooname"), ("size", mkValue 10)]
"SELECT \"name\", \"size\" FROM \"foo\" WHERE  \"name\" = 'fooname' AND \"size\" = 10 "

-}

selectEntitiesBy :: (Entity a, ToMarkedRow b)
                 => ([FN] -> [FN])
                 -> Proxy a
                 -> b
                 -> SqlBuilder
selectEntitiesBy xpref p b =
    let mr = toMarkedRow b
        cond = if L.null $ unMR mr
               then mempty
               else [sqlExp| WHERE ^{mrToBuilder "AND" mr}|]
        q = selectEntity (entityFields xpref id) p
    in q <> cond



{- | Convert entity instance to marked row to perform inserts updates
and same stuff

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }
>>> runSqlBuilder con $ mrToBuilder ", " $ entityToMR $ Foo "Enterprise" 610
" \"name\" = 'Enterprise' ,  \"size\" = 610 "

-}

entityToMR :: forall a. (Entity a, ToRow a) => a -> MarkedRow
entityToMR a =
    let p = Proxy :: Proxy a
        names = fieldNames p
        values = map mkValue $ toRow a
    in MR $ zip names values


{- | Generates __INSERT INTO__ query for any instance of 'Entity' and 'ToRow'

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }
>>> runSqlBuilder con $ insertEntity $ Foo "Enterprise" 910
"INSERT INTO \"foo\" (\"name\", \"size\") VALUES ('Enterprise', 910)"

-}

insertEntity :: forall a. (Entity a, ToRow a) => a -> SqlBuilder
insertEntity a =
    let p = Proxy :: Proxy a
        mr = entityToMR a
    in insertInto (tableName p) mr

{- | Same as 'insertEntity' but generates query to insert many queries at same time

>>> data Foo = Foo { fName :: Text, fSize :: Int }
>>> instance Entity Foo where {newtype EntityId Foo = FooId Int ; fieldNames _ = ["name", "size"] ; tableName _ = "foo"}
>>> instance ToRow Foo where { toRow Foo{..} = [toField fName, toField fSize] }
>>> runSqlBuilder con $ insertManyEntities $ NL.fromList [Foo "meter" 1, Foo "table" 2, Foo "earth" 151930000000]
"INSERT INTO \"foo\" (\"name\",\"size\") VALUES ('meter',1),('table',2),('earth',151930000000)"

-}

insertManyEntities :: forall a. (Entity a, ToRow a)
                   => NonEmpty a
                   -> SqlBuilder
insertManyEntities rows =
    let p = Proxy :: Proxy a
        names = mconcat
                $ L.intersperse ","
                $ map toSqlBuilder
                $ fieldNames p
        values = mconcat
                 $ L.intersperse ","
                 $ map rValue
                 $ NL.toList rows

    in [sqlExp|INSERT INTO ^{tableName p}
               (^{names}) VALUES ^{values}|]
  where
    rValue :: a -> SqlBuilder
    rValue row =
        let values = mconcat
                     $ L.intersperse ","
                     $ map mkValue
                     $ toRow row
        in [sqlExp|(^{values})|]