{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeFamilies #-}
module Database.PSQL.Types
( TablePrefix
, PSQLPool
, PSQL
, HasPSQL
, psqlPool
, tablePrefix
, SimpleEnv
, simpleEnv
, HasOtherEnv
, otherEnv
, TableName
, getTableName
, Columns
, createTable
, constraintPrimaryKey
, getIndexName
, IndexName
, createIndex
, getOnly
, getOnlyDefault
, insert
, insertRet
, insertOrUpdate
, update
, delete
, delete_
, count
, count_
, select
, selectOnly
, select_
, selectOnly_
, selectOne
, selectOneOnly
, VersionList
, mergeDatabase
, FromRow (..)
, field
, Only (..)
, SqlError (..)
, OrderBy
, asc
, desc
, none
) where
import Control.Monad (void)
import Data.Hashable (Hashable (..))
import Data.Int (Int64)
import Data.List (intercalate)
import Data.Maybe (listToMaybe)
import Data.Pool (Pool)
import Data.String (IsString (..))
import Database.PostgreSQL.Simple (Connection, Only (..),
SqlError (..), ToRow,
execute, execute_, query,
query_)
import Database.PostgreSQL.Simple.FromRow (FromRow (..), field)
import GHC.Generics (Generic)
type From = Int64
type Size = Int64
newtype TablePrefix = TablePrefix String
deriving (Int -> TablePrefix -> ShowS
[TablePrefix] -> ShowS
TablePrefix -> String
(Int -> TablePrefix -> ShowS)
-> (TablePrefix -> String)
-> ([TablePrefix] -> ShowS)
-> Show TablePrefix
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TablePrefix] -> ShowS
$cshowList :: [TablePrefix] -> ShowS
show :: TablePrefix -> String
$cshow :: TablePrefix -> String
showsPrec :: Int -> TablePrefix -> ShowS
$cshowsPrec :: Int -> TablePrefix -> ShowS
Show)
instance IsString TablePrefix where
fromString :: String -> TablePrefix
fromString = String -> TablePrefix
TablePrefix
type PSQL a = TablePrefix -> Connection -> IO a
type PSQLPool = Pool Connection
class HasPSQL u where
psqlPool :: u -> PSQLPool
tablePrefix :: u -> TablePrefix
class HasOtherEnv u a where
otherEnv :: a -> u
data SimpleEnv u = SimpleEnv
{ SimpleEnv u -> Pool Connection
pc :: Pool Connection
, SimpleEnv u -> TablePrefix
pf :: TablePrefix
, SimpleEnv u -> u
pu :: u
}
instance HasPSQL (SimpleEnv u) where
psqlPool :: SimpleEnv u -> Pool Connection
psqlPool = SimpleEnv u -> Pool Connection
forall u. SimpleEnv u -> Pool Connection
pc
tablePrefix :: SimpleEnv u -> TablePrefix
tablePrefix = SimpleEnv u -> TablePrefix
forall u. SimpleEnv u -> TablePrefix
pf
instance HasOtherEnv u (SimpleEnv u) where
otherEnv :: SimpleEnv u -> u
otherEnv = SimpleEnv u -> u
forall u. SimpleEnv u -> u
pu
simpleEnv :: Pool Connection -> TablePrefix -> u -> SimpleEnv u
simpleEnv :: Pool Connection -> TablePrefix -> u -> SimpleEnv u
simpleEnv pool :: Pool Connection
pool prefix :: TablePrefix
prefix env0 :: u
env0 = SimpleEnv :: forall u. Pool Connection -> TablePrefix -> u -> SimpleEnv u
SimpleEnv{pc :: Pool Connection
pc=Pool Connection
pool, pf :: TablePrefix
pf = TablePrefix
prefix, pu :: u
pu = u
env0}
newtype TableName = TableName String
deriving (Int -> TableName -> ShowS
[TableName] -> ShowS
TableName -> String
(Int -> TableName -> ShowS)
-> (TableName -> String)
-> ([TableName] -> ShowS)
-> Show TableName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TableName] -> ShowS
$cshowList :: [TableName] -> ShowS
show :: TableName -> String
$cshow :: TableName -> String
showsPrec :: Int -> TableName -> ShowS
$cshowsPrec :: Int -> TableName -> ShowS
Show)
instance IsString TableName where
fromString :: String -> TableName
fromString = String -> TableName
TableName
getTableName :: TablePrefix -> TableName -> String
getTableName :: TablePrefix -> TableName -> String
getTableName (TablePrefix "") (TableName name :: String
name) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["\"", String
name, "\"" ]
getTableName (TablePrefix prefix :: String
prefix) (TableName name :: String
name) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ["\"", String
prefix, "_", String
name, "\"" ]
newtype Column = Column { Column -> String
unColumn :: String }
deriving (Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show)
instance IsString Column where
fromString :: String -> Column
fromString = String -> Column
Column
type Columns = [Column]
columnsToString :: Columns -> String
columnsToString :: [Column] -> String
columnsToString = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String)
-> ([Column] -> [String]) -> [Column] -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> String) -> [Column] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Column -> String
unColumn
constraintPrimaryKey :: TablePrefix -> TableName -> Columns -> Column
constraintPrimaryKey :: TablePrefix -> TableName -> [Column] -> Column
constraintPrimaryKey prefix :: TablePrefix
prefix tn :: TableName
tn columns :: [Column]
columns = String -> Column
Column (String -> Column) -> ([String] -> String) -> [String] -> Column
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([String] -> Column) -> [String] -> Column
forall a b. (a -> b) -> a -> b
$
[ "CONSTRAINT "
, TablePrefix -> TableName -> IndexName -> String
getIndexName TablePrefix
prefix TableName
tn "pkey"
, " PRIMARY KEY (", [Column] -> String
columnsToString [Column]
columns, ")"
]
createTable :: TableName -> Columns -> PSQL Int64
createTable :: TableName -> [Column] -> PSQL Int64
createTable tn :: TableName
tn cols :: [Column]
cols prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> IO Int64
execute_ Connection
conn Query
sql
where sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "CREATE TABLE IF NOT EXISTS ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn, " ("
, [Column] -> String
columnsToString [Column]
cols
, ")"
]
newtype IndexName = IndexName String
deriving (Int -> IndexName -> ShowS
[IndexName] -> ShowS
IndexName -> String
(Int -> IndexName -> ShowS)
-> (IndexName -> String)
-> ([IndexName] -> ShowS)
-> Show IndexName
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IndexName] -> ShowS
$cshowList :: [IndexName] -> ShowS
show :: IndexName -> String
$cshow :: IndexName -> String
showsPrec :: Int -> IndexName -> ShowS
$cshowsPrec :: Int -> IndexName -> ShowS
Show)
instance IsString IndexName where
fromString :: String -> IndexName
fromString = String -> IndexName
IndexName
getIndexName :: TablePrefix -> TableName -> IndexName -> String
getIndexName :: TablePrefix -> TableName -> IndexName -> String
getIndexName (TablePrefix "") (TableName tn :: String
tn) (IndexName name :: String
name) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "\"", String
tn, "_", String
name, "\"" ]
getIndexName (TablePrefix prefix :: String
prefix) (TableName tn :: String
tn) (IndexName name :: String
name) =
[String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ "\"", String
prefix, "_", String
tn , "_", String
name, "\"" ]
createIndex :: Bool -> TableName -> IndexName -> Columns -> PSQL Int64
createIndex :: Bool -> TableName -> IndexName -> [Column] -> PSQL Int64
createIndex uniq :: Bool
uniq tn :: TableName
tn idxN :: IndexName
idxN cols :: [Column]
cols prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> IO Int64
execute_ Connection
conn Query
sql
where sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "CREATE ", String
uniqWord, "INDEX IF NOT EXISTS ", TablePrefix -> TableName -> IndexName -> String
getIndexName TablePrefix
prefix TableName
tn IndexName
idxN
, " ON " , TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn, "(", [Column] -> String
columnsToString [Column]
cols, ")"
]
uniqWord :: String
uniqWord = if Bool
uniq then "UNIQUE " else ""
getOnly :: FromRow (Only a) => [Only a] -> Maybe a
getOnly :: [Only a] -> Maybe a
getOnly = (Only a -> a) -> Maybe (Only a) -> Maybe a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only a -> a
forall a. Only a -> a
fromOnly (Maybe (Only a) -> Maybe a)
-> ([Only a] -> Maybe (Only a)) -> [Only a] -> Maybe a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only a] -> Maybe (Only a)
forall a. [a] -> Maybe a
listToMaybe
getOnlyDefault :: FromRow (Only a) => a -> [Only a] -> a
getOnlyDefault :: a -> [Only a] -> a
getOnlyDefault a :: a
a = a -> (Only a -> a) -> Maybe (Only a) -> a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe a
a Only a -> a
forall a. Only a -> a
fromOnly (Maybe (Only a) -> a)
-> ([Only a] -> Maybe (Only a)) -> [Only a] -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Only a] -> Maybe (Only a)
forall a. [a] -> Maybe a
listToMaybe
insert :: ToRow a => TableName -> Columns -> a -> PSQL Int64
insert :: TableName -> [Column] -> a -> PSQL Int64
insert tn :: TableName
tn cols :: [Column]
cols a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> a -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql a
a
where v :: [Column]
v = Int -> [Column] -> [Column]
forall a. Int -> [a] -> [a]
take ([Column] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Column]
cols) ([Column] -> [Column]) -> [Column] -> [Column]
forall a b. (a -> b) -> a -> b
$ [Column] -> [Column]
forall a. [a] -> [a]
cycle ["?"]
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "INSERT INTO ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, " (", [Column] -> String
columnsToString [Column]
cols, ")"
, " VALUES"
, " (", [Column] -> String
columnsToString [Column]
v, ")"
]
insertRet :: (ToRow a, FromRow (Only b)) => TableName -> Columns -> Column -> a -> b -> PSQL b
insertRet :: TableName -> [Column] -> Column -> a -> b -> PSQL b
insertRet tn :: TableName
tn cols :: [Column]
cols col :: Column
col a :: a
a def :: b
def prefix :: TablePrefix
prefix conn :: Connection
conn = b -> [Only b] -> b
forall a. FromRow (Only a) => a -> [Only a] -> a
getOnlyDefault b
def ([Only b] -> b) -> IO [Only b] -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> a -> IO [Only b]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
sql a
a
where v :: [Column]
v = Int -> [Column] -> [Column]
forall a. Int -> [a] -> [a]
take ([Column] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Column]
cols) ([Column] -> [Column]) -> [Column] -> [Column]
forall a b. (a -> b) -> a -> b
$ [Column] -> [Column]
forall a. [a] -> [a]
cycle ["?"]
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "INSERT INTO ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, " (", [Column] -> String
columnsToString [Column]
cols, ")"
, " VALUES"
, " (", [Column] -> String
columnsToString [Column]
v, ")"
, " returning ", Column -> String
unColumn Column
col
]
insertOrUpdate :: ToRow a => TableName -> Columns -> Columns -> Columns -> a -> PSQL Int64
insertOrUpdate :: TableName -> [Column] -> [Column] -> [Column] -> a -> PSQL Int64
insertOrUpdate tn :: TableName
tn uniqCols :: [Column]
uniqCols valCols :: [Column]
valCols otherCols :: [Column]
otherCols a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> a -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql a
a
where cols :: [Column]
cols = [Column]
uniqCols [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [Column]
valCols [Column] -> [Column] -> [Column]
forall a. [a] -> [a] -> [a]
++ [Column]
otherCols
v :: [Column]
v = Int -> Column -> [Column]
forall a. Int -> a -> [a]
replicate ([Column] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Column]
cols) "?"
setSql :: String
setSql = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Column -> String) -> [Column] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Column -> String
appendSet [Column]
valCols
appendSet :: Column -> String
appendSet :: Column -> String
appendSet (Column col :: String
col) | '=' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
col = String
col
| Bool
otherwise = String
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = excluded." String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
col
doSql :: String
doSql = if [Column] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Column]
valCols then " DO NOTHING" else " DO UPDATE SET " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
setSql
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "INSERT INTO ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, " (", [Column] -> String
columnsToString [Column]
cols, ")"
, " VALUES"
, " (", [Column] -> String
columnsToString [Column]
v, ")"
, " ON CONFLICT (", [Column] -> String
columnsToString [Column]
uniqCols, ")"
, String
doSql
]
update :: ToRow a => TableName -> Columns -> String -> a -> PSQL Int64
update :: TableName -> [Column] -> String -> a -> PSQL Int64
update tn :: TableName
tn cols :: [Column]
cols partSql :: String
partSql a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> a -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql a
a
where setSql :: String
setSql = String -> [String] -> String
forall a. [a] -> [[a]] -> [a]
intercalate ", " ([String] -> String) -> [String] -> String
forall a b. (a -> b) -> a -> b
$ (Column -> String) -> [Column] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map Column -> String
appendSet [Column]
cols
whereSql :: String
whereSql = if String -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null String
partSql then "" else " WHERE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
partSql
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "UPDATE ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, " SET ", String
setSql
, String
whereSql
]
appendSet :: Column -> String
appendSet :: Column -> String
appendSet (Column col :: String
col) | '=' Char -> String -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` String
col = String
col
| Bool
otherwise = String
col String -> ShowS
forall a. [a] -> [a] -> [a]
++ " = ?"
delete :: ToRow a => TableName -> String -> a -> PSQL Int64
delete :: TableName -> String -> a -> PSQL Int64
delete tn :: TableName
tn partSql :: String
partSql a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> a -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
execute Connection
conn Query
sql a
a
where whereSql :: String
whereSql = " WHERE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
partSql
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "DELETE FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn, String
whereSql
]
delete_ :: TableName -> PSQL Int64
delete_ :: TableName -> PSQL Int64
delete_ tn :: TableName
tn prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> IO Int64
execute_ Connection
conn Query
sql
where sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "DELETE FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
]
count :: ToRow a => TableName -> String -> a -> PSQL Int64
count :: TableName -> String -> a -> PSQL Int64
count tn :: TableName
tn partSql :: String
partSql a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn =
Int64 -> [Only Int64] -> Int64
forall a. FromRow (Only a) => a -> [Only a] -> a
getOnlyDefault 0 ([Only Int64] -> Int64) -> IO [Only Int64] -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> a -> IO [Only Int64]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
sql a
a
where whereSql :: String
whereSql = " WHERE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
partSql
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "SELECT count(*) FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn, String
whereSql
]
count_ :: TableName -> PSQL Int64
count_ :: TableName -> PSQL Int64
count_ tn :: TableName
tn prefix :: TablePrefix
prefix conn :: Connection
conn =
Int64 -> [Only Int64] -> Int64
forall a. FromRow (Only a) => a -> [Only a] -> a
getOnlyDefault 0 ([Only Int64] -> Int64) -> IO [Only Int64] -> IO Int64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [Only Int64]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
sql
where sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "SELECT count(*) FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
]
select :: (ToRow a, FromRow b) => TableName -> Columns -> String -> a -> From -> Size -> OrderBy -> PSQL [b]
select :: TableName
-> [Column] -> String -> a -> Int64 -> Int64 -> OrderBy -> PSQL [b]
select tn :: TableName
tn cols :: [Column]
cols partSql :: String
partSql a :: a
a from :: Int64
from size :: Int64
size o :: OrderBy
o prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> a -> IO [b]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
sql a
a
where whereSql :: String
whereSql = " WHERE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
partSql
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "SELECT ", [Column] -> String
columnsToString [Column]
cols, " FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, String
whereSql
, " ", OrderBy -> String
forall a. Show a => a -> String
show OrderBy
o
, " LIMIT ", Int64 -> String
forall a. Show a => a -> String
show Int64
size
, " OFFSET ", Int64 -> String
forall a. Show a => a -> String
show Int64
from
]
selectOnly :: (ToRow a, FromRow (Only b)) => TableName -> Column -> String -> a -> From -> Size -> OrderBy -> PSQL [b]
selectOnly :: TableName
-> Column -> String -> a -> Int64 -> Int64 -> OrderBy -> PSQL [b]
selectOnly tn :: TableName
tn col :: Column
col partSql :: String
partSql a :: a
a from :: Int64
from size :: Int64
size o :: OrderBy
o prefix :: TablePrefix
prefix conn :: Connection
conn =
(Only b -> b) -> [Only b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Only b -> b
forall a. Only a -> a
fromOnly ([Only b] -> [b]) -> IO [Only b] -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableName
-> [Column]
-> String
-> a
-> Int64
-> Int64
-> OrderBy
-> PSQL [Only b]
forall a b.
(ToRow a, FromRow b) =>
TableName
-> [Column] -> String -> a -> Int64 -> Int64 -> OrderBy -> PSQL [b]
select TableName
tn [Column
col] String
partSql a
a Int64
from Int64
size OrderBy
o TablePrefix
prefix Connection
conn
select_ :: FromRow b => TableName -> Columns -> From -> Size -> OrderBy -> PSQL [b]
select_ :: TableName -> [Column] -> Int64 -> Int64 -> OrderBy -> PSQL [b]
select_ tn :: TableName
tn cols :: [Column]
cols from :: Int64
from size :: Int64
size o :: OrderBy
o prefix :: TablePrefix
prefix conn :: Connection
conn = Connection -> Query -> IO [b]
forall r. FromRow r => Connection -> Query -> IO [r]
query_ Connection
conn Query
sql
where sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "SELECT ", [Column] -> String
columnsToString [Column]
cols, " FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, " ", OrderBy -> String
forall a. Show a => a -> String
show OrderBy
o
, " LIMIT ", Int64 -> String
forall a. Show a => a -> String
show Int64
size
, " OFFSET ", Int64 -> String
forall a. Show a => a -> String
show Int64
from
]
selectOnly_ :: FromRow (Only b) => TableName -> Column -> From -> Size -> OrderBy -> PSQL [b]
selectOnly_ :: TableName -> Column -> Int64 -> Int64 -> OrderBy -> PSQL [b]
selectOnly_ tn :: TableName
tn col :: Column
col from :: Int64
from size :: Int64
size o :: OrderBy
o prefix :: TablePrefix
prefix conn :: Connection
conn =
(Only b -> b) -> [Only b] -> [b]
forall a b. (a -> b) -> [a] -> [b]
map Only b -> b
forall a. Only a -> a
fromOnly ([Only b] -> [b]) -> IO [Only b] -> IO [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableName -> [Column] -> Int64 -> Int64 -> OrderBy -> PSQL [Only b]
forall b.
FromRow b =>
TableName -> [Column] -> Int64 -> Int64 -> OrderBy -> PSQL [b]
select_ TableName
tn [Column
col] Int64
from Int64
size OrderBy
o TablePrefix
prefix Connection
conn
selectOne :: (ToRow a, FromRow b) => TableName -> Columns -> String -> a -> PSQL (Maybe b)
selectOne :: TableName -> [Column] -> String -> a -> PSQL (Maybe b)
selectOne tn :: TableName
tn cols :: [Column]
cols partSql :: String
partSql a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn = [b] -> Maybe b
forall a. [a] -> Maybe a
listToMaybe ([b] -> Maybe b) -> IO [b] -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> a -> IO [b]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
query Connection
conn Query
sql a
a
where whereSql :: String
whereSql = " WHERE " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
partSql
sql :: Query
sql = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ [String] -> String
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ "SELECT ", [Column] -> String
columnsToString [Column]
cols, " FROM ", TablePrefix -> TableName -> String
getTableName TablePrefix
prefix TableName
tn
, String
whereSql
]
selectOneOnly :: (ToRow a, FromRow (Only b)) => TableName -> Column -> String -> a -> PSQL (Maybe b)
selectOneOnly :: TableName -> Column -> String -> a -> PSQL (Maybe b)
selectOneOnly tn :: TableName
tn col :: Column
col partSql :: String
partSql a :: a
a prefix :: TablePrefix
prefix conn :: Connection
conn =
(Only b -> b) -> Maybe (Only b) -> Maybe b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Only b -> b
forall a. Only a -> a
fromOnly (Maybe (Only b) -> Maybe b) -> IO (Maybe (Only b)) -> IO (Maybe b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TableName -> [Column] -> String -> a -> PSQL (Maybe (Only b))
forall a b.
(ToRow a, FromRow b) =>
TableName -> [Column] -> String -> a -> PSQL (Maybe b)
selectOne TableName
tn [Column
col] String
partSql a
a TablePrefix
prefix Connection
conn
createVersionTable :: PSQL Int64
createVersionTable :: PSQL Int64
createVersionTable prefix :: TablePrefix
prefix conn :: Connection
conn =
TableName -> [Column] -> PSQL Int64
createTable "version"
[ "name VARCHAR(10) NOT NULL"
, "version INT DEFAULT '0'"
, "PRIMARY KEY (name)"
] TablePrefix
prefix Connection
conn
getCurrentVersion :: PSQL Int64
getCurrentVersion :: PSQL Int64
getCurrentVersion prefix :: TablePrefix
prefix conn :: Connection
conn = do
IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ PSQL Int64
createVersionTable TablePrefix
prefix Connection
conn
Maybe Int64
ts <- TableName -> Column -> String -> Only String -> PSQL (Maybe Int64)
forall a b.
(ToRow a, FromRow (Only b)) =>
TableName -> Column -> String -> a -> PSQL (Maybe b)
selectOneOnly "version" "version" "name = ?" (String -> Only String
forall a. a -> Only a
Only ("version" :: String)) TablePrefix
prefix Connection
conn
case Maybe Int64
ts of
Just v :: Int64
v -> Int64 -> IO Int64
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int64
v
Nothing ->
TableName
-> [Column] -> Column -> (String, Int) -> Int64 -> PSQL Int64
forall a b.
(ToRow a, FromRow (Only b)) =>
TableName -> [Column] -> Column -> a -> b -> PSQL b
insertRet "version" ["name", "version"] "version" ("version" :: String, 0 :: Int) 0 TablePrefix
prefix Connection
conn
updateVersion :: Int64 -> PSQL ()
updateVersion :: Int64 -> PSQL ()
updateVersion ts :: Int64
ts prefix :: TablePrefix
prefix conn :: Connection
conn =
IO Int64 -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Int64 -> IO ()) -> IO Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ TableName -> [Column] -> String -> (Int64, String) -> PSQL Int64
forall a.
ToRow a =>
TableName -> [Column] -> String -> a -> PSQL Int64
update "version" ["version"] "name = ?" (Int64
ts, "version" :: String) TablePrefix
prefix Connection
conn
type Version a = (Int64, [PSQL a])
type VersionList a = [Version a]
mergeDatabase :: VersionList a -> PSQL ()
mergeDatabase :: VersionList a -> PSQL ()
mergeDatabase versionList :: VersionList a
versionList prefix :: TablePrefix
prefix conn :: Connection
conn = do
Int64
version <- PSQL Int64
getCurrentVersion TablePrefix
prefix Connection
conn
(Version a -> IO ()) -> VersionList a -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\v :: Version a
v -> Int64 -> Version a -> PSQL ()
forall a. Int64 -> Version a -> PSQL ()
processAction Int64
version Version a
v TablePrefix
prefix Connection
conn) VersionList a
versionList
processAction :: Int64 -> Version a -> PSQL ()
processAction :: Int64 -> Version a -> PSQL ()
processAction version :: Int64
version (ts :: Int64
ts, actions :: [PSQL a]
actions) prefix :: TablePrefix
prefix conn :: Connection
conn =
if Int64
ts Int64 -> Int64 -> Bool
forall a. Ord a => a -> a -> Bool
> Int64
version then do
Int64 -> PSQL ()
updateVersion Int64
ts TablePrefix
prefix Connection
conn
(PSQL a -> IO ()) -> [PSQL a] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (\o :: PSQL a
o -> IO a -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO a -> IO ()) -> IO a -> IO ()
forall a b. (a -> b) -> a -> b
$ PSQL a
o TablePrefix
prefix Connection
conn) [PSQL a]
actions
else () -> IO ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
data OrderBy = Desc String | Asc String | None
deriving ((forall x. OrderBy -> Rep OrderBy x)
-> (forall x. Rep OrderBy x -> OrderBy) -> Generic OrderBy
forall x. Rep OrderBy x -> OrderBy
forall x. OrderBy -> Rep OrderBy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrderBy x -> OrderBy
$cfrom :: forall x. OrderBy -> Rep OrderBy x
Generic, OrderBy -> OrderBy -> Bool
(OrderBy -> OrderBy -> Bool)
-> (OrderBy -> OrderBy -> Bool) -> Eq OrderBy
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrderBy -> OrderBy -> Bool
$c/= :: OrderBy -> OrderBy -> Bool
== :: OrderBy -> OrderBy -> Bool
$c== :: OrderBy -> OrderBy -> Bool
Eq)
instance Hashable OrderBy
desc :: String -> OrderBy
desc :: String -> OrderBy
desc = String -> OrderBy
Desc
asc :: String -> OrderBy
asc :: String -> OrderBy
asc = String -> OrderBy
Asc
none :: OrderBy
none :: OrderBy
none = OrderBy
None
instance Show OrderBy where
show :: OrderBy -> String
show (Desc f :: String
f) = "ORDER BY " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " DESC"
show (Asc f :: String
f) = "ORDER BY " String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
f String -> ShowS
forall a. [a] -> [a] -> [a]
++ " ASC"
show None = ""