{-# 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


  -- re-exports
  , 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     = ""