module IHP.IDE.Data.Controller where

import IHP.ControllerPrelude
import IHP.Controller.NotFound
import IHP.IDE.ToolServer.Types
import IHP.IDE.Data.View.ShowDatabase
import IHP.IDE.Data.View.ShowTableRows
import IHP.IDE.Data.View.ShowQuery
import IHP.IDE.Data.View.NewRow
import IHP.IDE.Data.View.EditRow
import IHP.IDE.Data.View.EditValue
import IHP.IDE.Data.View.ShowForeignKeyHoverCard

import qualified Database.PostgreSQL.Simple as PG
import qualified Database.PostgreSQL.Simple.FromField as PG
import qualified Database.PostgreSQL.Simple.FromRow as PG
import qualified Database.PostgreSQL.Simple.ToField as PG
import qualified Database.PostgreSQL.Simple.Types as PG
import qualified Data.Text as T
import qualified Data.ByteString.Builder

instance Controller DataController where
    action :: (?context::ControllerContext, ?modelContext::ModelContext,
 ?theAction::DataController) =>
DataController -> IO ()
action DataController
ShowDatabaseAction = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        Connection -> IO ()
PG.close Connection
connection
        case [Text] -> Maybe Text
forall a. [a] -> Maybe a
headMay [Text]
tableNames of
            Just Text
tableName -> DataController -> IO ()
forall action.
(Controller action, ?context::ControllerContext,
 ?modelContext::ModelContext) =>
action -> IO ()
jumpToAction ShowTableRowsAction { Text
tableName :: Text
$sel:tableName:ShowDatabaseAction :: Text
tableName }
            Maybe Text
Nothing -> ShowDatabaseView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ShowDatabaseView { [Text]
tableNames :: [Text]
$sel:tableNames:ShowDatabaseView :: [Text]
.. }

    action ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName } = do
        let Int
page :: Int = forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault @Int Int
1 ByteString
"page"
        let Int
pageSize :: Int = forall a.
(?context::ControllerContext, ParamReader a) =>
a -> ByteString -> a
paramOrDefault @Int Int
20 ByteString
"rows"
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        [Text]
primaryKeyFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName
        [[DynamicField]]
rows :: [[DynamicField]] <- Connection -> Text -> Int -> Int -> IO [[DynamicField]]
forall r. FromRow r => Connection -> Text -> Int -> Int -> IO [r]
fetchRowsPage Connection
connection Text
tableName Int
page Int
pageSize
        [ColumnDefinition]
tableCols <- Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName
        Int
totalRows <- Connection -> Text -> IO Int
tableLength Connection
connection Text
tableName
        Connection -> IO ()
PG.close Connection
connection
        ShowTableRowsView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ShowTableRowsView { Int
[[DynamicField]]
[Text]
[ColumnDefinition]
Text
tableName :: Text
page :: Int
pageSize :: Int
tableNames :: [Text]
primaryKeyFields :: [Text]
rows :: [[DynamicField]]
tableCols :: [ColumnDefinition]
totalRows :: Int
$sel:tableNames:ShowTableRowsView :: [Text]
$sel:tableName:ShowTableRowsView :: Text
$sel:rows:ShowTableRowsView :: [[DynamicField]]
$sel:tableCols:ShowTableRowsView :: [ColumnDefinition]
$sel:primaryKeyFields:ShowTableRowsView :: [Text]
$sel:pageSize:ShowTableRowsView :: Int
$sel:page:ShowTableRowsView :: Int
$sel:totalRows:ShowTableRowsView :: Int
.. }

    action DataController
NewQueryAction = do
        let queryText :: Text
queryText = Text
""
        let queryResult :: Maybe a
queryResult = Maybe a
forall a. Maybe a
Nothing
        ShowQueryView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ShowQueryView { Maybe (Either SqlError SqlConsoleResult)
Text
forall a. Maybe a
queryText :: Text
queryResult :: forall a. Maybe a
$sel:queryResult:ShowQueryView :: Maybe (Either SqlError SqlConsoleResult)
$sel:queryText:ShowQueryView :: Text
.. }

    action DataController
QueryAction = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        let queryText :: Text
queryText = forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Text ByteString
"query"
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Bool
forall value. IsEmpty value => value -> Bool
isEmpty Text
queryText) do
            DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo DataController
NewQueryAction

        let query :: Query
query = String -> Query
forall a. IsString a => String -> a
fromString (String -> Query) -> String -> Query
forall a b. (a -> b) -> a -> b
$ Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs Text
queryText

        Maybe (Either SqlError SqlConsoleResult)
queryResult :: Maybe (Either PG.SqlError SqlConsoleResult) <- Either SqlError SqlConsoleResult
-> Maybe (Either SqlError SqlConsoleResult)
forall a. a -> Maybe a
Just (Either SqlError SqlConsoleResult
 -> Maybe (Either SqlError SqlConsoleResult))
-> IO (Either SqlError SqlConsoleResult)
-> IO (Maybe (Either SqlError SqlConsoleResult))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> if Text -> Bool
isQuery Text
queryText then
                (SqlConsoleResult -> Either SqlError SqlConsoleResult
forall a b. b -> Either a b
Right (SqlConsoleResult -> Either SqlError SqlConsoleResult)
-> ([[DynamicField]] -> SqlConsoleResult)
-> [[DynamicField]]
-> Either SqlError SqlConsoleResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. [[DynamicField]] -> SqlConsoleResult
SelectQueryResult ([[DynamicField]] -> Either SqlError SqlConsoleResult)
-> IO [[DynamicField]] -> IO (Either SqlError SqlConsoleResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO [[DynamicField]]
forall r. FromRow r => Connection -> Query -> IO [r]
PG.query_ Connection
connection Query
query) IO (Either SqlError SqlConsoleResult)
-> (SqlError -> IO (Either SqlError SqlConsoleResult))
-> IO (Either SqlError SqlConsoleResult)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Either SqlError SqlConsoleResult
-> IO (Either SqlError SqlConsoleResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SqlError SqlConsoleResult
 -> IO (Either SqlError SqlConsoleResult))
-> (SqlError -> Either SqlError SqlConsoleResult)
-> SqlError
-> IO (Either SqlError SqlConsoleResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SqlError -> Either SqlError SqlConsoleResult
forall a b. a -> Either a b
Left)
            else
                (SqlConsoleResult -> Either SqlError SqlConsoleResult
forall a b. b -> Either a b
Right (SqlConsoleResult -> Either SqlError SqlConsoleResult)
-> (Int64 -> SqlConsoleResult)
-> Int64
-> Either SqlError SqlConsoleResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Int64 -> SqlConsoleResult
InsertOrUpdateResult (Int64 -> Either SqlError SqlConsoleResult)
-> IO Int64 -> IO (Either SqlError SqlConsoleResult)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Query -> IO Int64
PG.execute_ Connection
connection Query
query) IO (Either SqlError SqlConsoleResult)
-> (SqlError -> IO (Either SqlError SqlConsoleResult))
-> IO (Either SqlError SqlConsoleResult)
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`catch` (Either SqlError SqlConsoleResult
-> IO (Either SqlError SqlConsoleResult)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either SqlError SqlConsoleResult
 -> IO (Either SqlError SqlConsoleResult))
-> (SqlError -> Either SqlError SqlConsoleResult)
-> SqlError
-> IO (Either SqlError SqlConsoleResult)
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. SqlError -> Either SqlError SqlConsoleResult
forall a b. a -> Either a b
Left)

        Connection -> IO ()
PG.close Connection
connection
        ShowQueryView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ShowQueryView { Maybe (Either SqlError SqlConsoleResult)
Text
$sel:queryResult:ShowQueryView :: Maybe (Either SqlError SqlConsoleResult)
$sel:queryText:ShowQueryView :: Text
queryText :: Text
queryResult :: Maybe (Either SqlError SqlConsoleResult)
.. }

    action DeleteEntryAction { Text
primaryKey :: Text
$sel:primaryKey:ShowDatabaseAction :: DataController -> Text
primaryKey, Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        [Text]
primaryKeyFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName
        let primaryKeyValues :: [Text]
primaryKeyValues = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"---" Text
primaryKey
        let query :: Text
query = Text
"DELETE FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" AND " ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?") (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
primaryKeyFields)
        Connection -> Query -> [Text] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query) [Text]
primaryKeyValues
        Connection -> IO ()
PG.close Connection
connection
        DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: Text
tableName :: Text
.. }

    action NewRowAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection

        [[DynamicField]]
rows :: [[DynamicField]] <- Connection -> Text -> IO [[DynamicField]]
forall r. FromRow r => Connection -> Text -> IO [r]
fetchRows Connection
connection Text
tableName

        [ColumnDefinition]
tableCols <- Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName

        Connection -> IO ()
PG.close Connection
connection
        NewRowView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render NewRowView { [[DynamicField]]
[Text]
[ColumnDefinition]
Text
tableName :: Text
tableNames :: [Text]
rows :: [[DynamicField]]
tableCols :: [ColumnDefinition]
$sel:tableNames:NewRowView :: [Text]
$sel:tableName:NewRowView :: Text
$sel:rows:NewRowView :: [[DynamicField]]
$sel:tableCols:NewRowView :: [ColumnDefinition]
.. }

    action DataController
CreateRowAction = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        let tableName :: Text
tableName = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        [ColumnDefinition]
tableCols <- Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName
        let [Action]
values :: [PG.Action] = (ColumnDefinition -> Action) -> [ColumnDefinition] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map (\ColumnDefinition
col -> Bool -> Bool -> Text -> Action
parseValues (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Bool (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"_")) (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Bool (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-isBoolean")) (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Text (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName)))) [ColumnDefinition]
tableCols
        let query :: Text
query = Text
"INSERT INTO " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" VALUES (" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
"," ((Action -> Text) -> [Action] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Action -> Text
forall a b. a -> b -> a
const Text
"?") [Action]
values) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
")"
        Connection -> Query -> [Action] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query) [Action]
values
        Connection -> IO ()
PG.close Connection
connection
        DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: Text
tableName :: Text
.. }

    action EditRowAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName, Text
targetPrimaryKey :: Text
$sel:targetPrimaryKey:ShowDatabaseAction :: DataController -> Text
targetPrimaryKey } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        [Text]
primaryKeyFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName

        [[DynamicField]]
rows :: [[DynamicField]] <- Connection -> Text -> IO [[DynamicField]]
forall r. FromRow r => Connection -> Text -> IO [r]
fetchRows Connection
connection Text
tableName

        [ColumnDefinition]
tableCols <- Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName
        let targetPrimaryKeyValues :: [Text]
targetPrimaryKeyValues = HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"---" Text
targetPrimaryKey
        [[DynamicField]]
values <- Connection -> Text -> [Text] -> IO [[DynamicField]]
fetchRow Connection
connection (Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
tableName) [Text]
targetPrimaryKeyValues
        let (Just [DynamicField]
rowValues) = [[DynamicField]] -> Maybe [DynamicField]
forall a. [a] -> Maybe a
head [[DynamicField]]
values
        Connection -> IO ()
PG.close Connection
connection
        EditRowView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render EditRowView { [[DynamicField]]
[Text]
[ColumnDefinition]
[DynamicField]
Text
tableName :: Text
targetPrimaryKey :: Text
tableNames :: [Text]
primaryKeyFields :: [Text]
rows :: [[DynamicField]]
tableCols :: [ColumnDefinition]
rowValues :: [DynamicField]
$sel:tableNames:EditRowView :: [Text]
$sel:tableName:EditRowView :: Text
$sel:rows:EditRowView :: [[DynamicField]]
$sel:tableCols:EditRowView :: [ColumnDefinition]
$sel:rowValues:EditRowView :: [DynamicField]
$sel:primaryKeyFields:EditRowView :: [Text]
$sel:targetPrimaryKey:EditRowView :: Text
.. }

    action DataController
UpdateRowAction = do
        let tableName :: Text
tableName = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        [ColumnDefinition]
tableCols <- Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName
        [Text]
primaryKeyFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName

        let [Action]
values :: [PG.Action] = (ColumnDefinition -> Action) -> [ColumnDefinition] -> [Action]
forall a b. (a -> b) -> [a] -> [b]
map (\ColumnDefinition
col -> Bool -> Bool -> Text -> Action
parseValues (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Bool (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"_")) (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Bool (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName) ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-isBoolean")) (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Text (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName)))) [ColumnDefinition]
tableCols
        let [Text]
columns :: [Text] = (ColumnDefinition -> Text) -> [ColumnDefinition] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\ColumnDefinition
col -> Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs (ColumnDefinition
col.columnName)) [ColumnDefinition]
tableCols
        let primaryKeyValues :: [Text]
primaryKeyValues = (Text -> Text) -> [Text] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
pkey -> Text
"'" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Text (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
pkey ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"-pk")) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'") [Text]
primaryKeyFields

        let query :: Text
query = Text
"UPDATE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" SET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " ([(Text, Text)] -> [Text]
forall {a}. (Semigroup a, IsString a) => [(a, a)] -> [a]
updateValues ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
columns ((Action -> Text) -> [Action] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Text -> Action -> Text
forall a b. a -> b -> a
const Text
"?") [Action]
values))) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" AND " ([(Text, Text)] -> [Text]
forall {a}. (Semigroup a, IsString a) => [(a, a)] -> [a]
updateValues ([Text] -> [Text] -> [(Text, Text)]
forall a b. [a] -> [b] -> [(a, b)]
zip [Text]
primaryKeyFields [Text]
primaryKeyValues))
        Connection -> Query -> [Action] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query) [Action]
values
        Connection -> IO ()
PG.close Connection
connection
        DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: Text
tableName :: Text
.. }

    action EditRowValueAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName, Text
targetName :: Text
$sel:targetName:ShowDatabaseAction :: DataController -> Text
targetName, Text
id :: Text
$sel:id:ShowDatabaseAction :: DataController -> Text
id } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection

        [[DynamicField]]
rows :: [[DynamicField]] <- Connection -> Text -> IO [[DynamicField]]
forall r. FromRow r => Connection -> Text -> IO [r]
fetchRows Connection
connection Text
tableName

        let targetId :: Text
targetId = Text -> Text
forall a b. ConvertibleStrings a b => a -> b
cs Text
id
        Connection -> IO ()
PG.close Connection
connection
        EditValueView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render EditValueView { [[DynamicField]]
[Text]
Text
tableName :: Text
targetName :: Text
tableNames :: [Text]
rows :: [[DynamicField]]
targetId :: Text
$sel:tableNames:EditValueView :: [Text]
$sel:tableName:EditValueView :: Text
$sel:rows:EditValueView :: [[DynamicField]]
$sel:targetName:EditValueView :: Text
$sel:targetId:EditValueView :: Text
.. }

    action ToggleBooleanFieldAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName, Text
$sel:targetName:ShowDatabaseAction :: DataController -> Text
targetName :: Text
targetName, Text
$sel:targetPrimaryKey:ShowDatabaseAction :: DataController -> Text
targetPrimaryKey :: Text
targetPrimaryKey } = do
        let String
id :: String = Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Text ByteString
"id")
        let tableName :: Text
tableName = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        [Text]
tableNames <- Connection -> IO [Text]
fetchTableNames Connection
connection
        [ColumnDefinition]
tableCols <- Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName
        [Text]
primaryKeyFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName
        let targetPrimaryKeyValues :: [Action]
targetPrimaryKeyValues = ByteString -> Action
PG.Escape (ByteString -> Action) -> (Text -> ByteString) -> Text -> Action
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Action) -> [Text] -> [Action]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HasCallStack => Text -> Text -> [Text]
Text -> Text -> [Text]
T.splitOn Text
"---" Text
targetPrimaryKey
        let query :: Query
query = ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
"UPDATE ? SET ? = NOT ? WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" AND " ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?") (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
primaryKeyFields)
        let params :: [Action]
params = [Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier Text
tableName, Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier Text
targetName, Identifier -> Action
forall a. ToField a => a -> Action
PG.toField (Identifier -> Action) -> Identifier -> Action
forall a b. (a -> b) -> a -> b
$ Text -> Identifier
PG.Identifier Text
targetName] [Action] -> [Action] -> [Action]
forall a. Semigroup a => a -> a -> a
<> [Action]
targetPrimaryKeyValues
        Connection -> Query -> [Action] -> IO Int64
forall q. ToRow q => Connection -> Query -> q -> IO Int64
PG.execute Connection
connection Query
query [Action]
params
        Connection -> IO ()
PG.close Connection
connection
        DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: Text
tableName :: Text
.. }

    action DataController
UpdateValueAction = do
        let String
id :: String = Text -> String
forall a b. ConvertibleStrings a b => a -> b
cs (forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param @Text ByteString
"id")
        let tableName :: Text
tableName = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"tableName"
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        let targetCol :: Text
targetCol = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"targetName"
        let targetValue :: Text
targetValue = ByteString -> Text
forall valueType.
(?context::ControllerContext, ParamReader valueType) =>
ByteString -> valueType
param ByteString
"targetValue"
        let query :: Text
query = Text
"UPDATE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" SET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
targetCol Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
targetValue Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"' WHERE id = '" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
forall a b. ConvertibleStrings a b => a -> b
cs String
id Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"'"
        Connection -> Query -> IO Int64
PG.execute_ Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query)
        Connection -> IO ()
PG.close Connection
connection
        DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: Text
tableName :: Text
.. }

    action DeleteTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        let query :: Text
query = Text
"TRUNCATE TABLE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
        Connection -> Query -> IO Int64
PG.execute_ Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query)
        Connection -> IO ()
PG.close Connection
connection
        DataController -> IO ()
forall action.
(?context::ControllerContext, HasPath action) =>
action -> IO ()
redirectTo ShowTableRowsAction { Text
$sel:tableName:ShowDatabaseAction :: Text
tableName :: Text
.. }

    action AutocompleteForeignKeyColumnAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName, Text
columnName :: Text
$sel:columnName:ShowDatabaseAction :: DataController -> Text
columnName, Maybe Text
term :: Maybe Text
$sel:term:ShowDatabaseAction :: DataController -> Maybe Text
term } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        Maybe [[DynamicField]]
rows :: Maybe [[DynamicField]] <- do
            Maybe (Text, Text)
foreignKeyInfo <- Connection -> Text -> Text -> IO (Maybe (Text, Text))
fetchForeignKeyInfo Connection
connection Text
tableName Text
columnName

            case Maybe (Text, Text)
foreignKeyInfo of
                Just (Text
foreignTable, Text
foreignColumn) -> [[DynamicField]] -> Maybe [[DynamicField]]
forall a. a -> Maybe a
Just ([[DynamicField]] -> Maybe [[DynamicField]])
-> IO [[DynamicField]] -> IO (Maybe [[DynamicField]])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> Text -> Int -> Int -> IO [[DynamicField]]
forall r. FromRow r => Connection -> Text -> Int -> Int -> IO [r]
fetchRowsPage Connection
connection Text
foreignTable Int
1 Int
50
                Maybe (Text, Text)
Nothing -> Maybe [[DynamicField]] -> IO (Maybe [[DynamicField]])
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe [[DynamicField]]
forall a. Maybe a
Nothing

        Connection -> IO ()
PG.close Connection
connection

        case Maybe [[DynamicField]]
rows of
            Just [[DynamicField]]
rows -> [[DynamicField]] -> IO ()
forall json.
(?context::ControllerContext, ToJSON json) =>
json -> IO ()
renderJson [[DynamicField]]
rows
            Maybe [[DynamicField]]
Nothing -> IO ()
(?context::ControllerContext) => IO ()
renderNotFound

    action ShowForeignKeyHoverCardAction { Text
$sel:tableName:ShowDatabaseAction :: DataController -> Text
tableName :: Text
tableName, Text
$sel:id:ShowDatabaseAction :: DataController -> Text
id :: Text
id, Text
$sel:columnName:ShowDatabaseAction :: DataController -> Text
columnName :: Text
columnName } = do
        Connection
connection <- IO Connection
(?context::ControllerContext) => IO Connection
connectToAppDb
        Maybe ([DynamicField], Text)
hovercardData <- do
            [Only (UUID
foreignId :: UUID)] <- Connection
-> Query -> (Identifier, Identifier, Text) -> IO [Only UUID]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
"SELECT ? FROM ? WHERE id = ?" (Text -> Identifier
PG.Identifier Text
columnName, Text -> Identifier
PG.Identifier Text
tableName, Text
id)

            Maybe (Text, Text)
foreignKeyInfo <- Connection -> Text -> Text -> IO (Maybe (Text, Text))
fetchForeignKeyInfo Connection
connection Text
tableName Text
columnName

            case Maybe (Text, Text)
foreignKeyInfo of
                Just (Text
foreignTable, Text
foreignColumn) -> do
                    [[DynamicField]
record] <- Connection
-> Query -> (Identifier, Identifier, UUID) -> IO [[DynamicField]]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
"SELECT * FROM ? WHERE ? = ? LIMIT 1" (Text -> Identifier
PG.Identifier Text
foreignTable, Text -> Identifier
PG.Identifier Text
foreignColumn, UUID
foreignId)
                    Maybe ([DynamicField], Text) -> IO (Maybe ([DynamicField], Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe ([DynamicField], Text) -> IO (Maybe ([DynamicField], Text)))
-> Maybe ([DynamicField], Text)
-> IO (Maybe ([DynamicField], Text))
forall a b. (a -> b) -> a -> b
$ ([DynamicField], Text) -> Maybe ([DynamicField], Text)
forall a. a -> Maybe a
Just ([DynamicField]
record, Text
foreignTable)
                Maybe (Text, Text)
Nothing -> Maybe ([DynamicField], Text) -> IO (Maybe ([DynamicField], Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Maybe ([DynamicField], Text)
forall a. Maybe a
Nothing
        Connection -> IO ()
PG.close Connection
connection

        case Maybe ([DynamicField], Text)
hovercardData of
            Just ([DynamicField]
record, Text
foreignTableName) -> ShowForeignKeyHoverCardView -> IO ()
forall view.
(View view, ?context::ControllerContext) =>
view -> IO ()
render ShowForeignKeyHoverCardView { [DynamicField]
record :: [DynamicField]
$sel:record:ShowForeignKeyHoverCardView :: [DynamicField]
record, Text
foreignTableName :: Text
$sel:foreignTableName:ShowForeignKeyHoverCardView :: Text
foreignTableName }
            Maybe ([DynamicField], Text)
Nothing -> IO ()
(?context::ControllerContext) => IO ()
renderNotFound

connectToAppDb :: (?context :: ControllerContext) => IO PG.Connection
connectToAppDb :: (?context::ControllerContext) => IO Connection
connectToAppDb = ByteString -> IO Connection
PG.connectPostgreSQL ?context::ControllerContext
ControllerContext
?context.frameworkConfig.databaseUrl

fetchTableNames :: PG.Connection -> IO [Text]
fetchTableNames :: Connection -> IO [Text]
fetchTableNames Connection
connection = do
    [[Text]]
values :: [[Text]] <- Connection -> Query -> IO [[Text]]
forall r. FromRow r => Connection -> Query -> IO [r]
PG.query_ Connection
connection Query
"SELECT tablename FROM pg_catalog.pg_tables where schemaname = 'public'"
    [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([[Text]] -> [Text]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [[Text]]
values)

fetchTableCols :: PG.Connection -> Text -> IO [ColumnDefinition]
fetchTableCols :: Connection -> Text -> IO [ColumnDefinition]
fetchTableCols Connection
connection Text
tableName = do
    Connection -> Query -> Only Text -> IO [ColumnDefinition]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
"SELECT column_name,data_type,column_default,CASE WHEN is_nullable='YES' THEN true ELSE false END FROM information_schema.columns where table_name = ? ORDER BY ordinal_position" (Text -> Only Text
forall a. a -> Only a
PG.Only Text
tableName)

fetchRow :: PG.Connection -> Text -> [Text] -> IO [[DynamicField]]
fetchRow :: Connection -> Text -> [Text] -> IO [[DynamicField]]
fetchRow Connection
connection Text
tableName [Text]
primaryKeyValues = do
    [Text]
pkFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName
    let query :: Text
query = Text
"SELECT * FROM " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" WHERE " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
" AND " ((Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" = ?") (Text -> Text) -> [Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Text]
pkFields)
    Connection -> Query -> [Text] -> IO [[DynamicField]]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query) [Text]
primaryKeyValues

instance PG.FromField DynamicField where
    fromField :: FieldParser DynamicField
fromField Field
field Maybe ByteString
fieldValue = DynamicField -> Conversion DynamicField
forall a. a -> Conversion a
forall (f :: * -> *) a. Applicative f => a -> f a
pure DynamicField { Maybe ByteString
ByteString
fieldValue :: Maybe ByteString
fieldName :: ByteString
$sel:fieldValue:DynamicField :: Maybe ByteString
$sel:fieldName:DynamicField :: ByteString
.. }
        where
            fieldName :: ByteString
fieldName = ByteString -> Maybe ByteString -> ByteString
forall a. a -> Maybe a -> a
fromMaybe ByteString
"" (Field -> Maybe ByteString
PG.name Field
field)

instance PG.FromRow ColumnDefinition where
    fromRow :: RowParser ColumnDefinition
fromRow = Text -> Text -> Maybe Text -> Bool -> ColumnDefinition
ColumnDefinition (Text -> Text -> Maybe Text -> Bool -> ColumnDefinition)
-> RowParser Text
-> RowParser (Text -> Maybe Text -> Bool -> ColumnDefinition)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> RowParser Text
forall a. FromField a => RowParser a
PG.field RowParser (Text -> Maybe Text -> Bool -> ColumnDefinition)
-> RowParser Text
-> RowParser (Maybe Text -> Bool -> ColumnDefinition)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Text
forall a. FromField a => RowParser a
PG.field RowParser (Maybe Text -> Bool -> ColumnDefinition)
-> RowParser (Maybe Text) -> RowParser (Bool -> ColumnDefinition)
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser (Maybe Text)
forall a. FromField a => RowParser a
PG.field RowParser (Bool -> ColumnDefinition)
-> RowParser Bool -> RowParser ColumnDefinition
forall a b. RowParser (a -> b) -> RowParser a -> RowParser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> RowParser Bool
forall a. FromField a => RowParser a
PG.field

tablePrimaryKeyFields :: PG.Connection -> Text -> IO [Text]
tablePrimaryKeyFields :: Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName = do
    [Only Text]
fields <- Connection -> Query -> Only Text -> IO [Only Text]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
"SELECT a.attname FROM pg_index i JOIN pg_attribute a ON a.attrelid = i.indrelid AND a.attnum = ANY(i.indkey) WHERE i.indrelid = ?::regclass AND i.indisprimary" (Text -> Only Text
forall a. a -> Only a
PG.Only Text
tableName) :: IO [PG.Only Text]
    [Text] -> IO [Text]
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ([Text] -> IO [Text]) -> [Text] -> IO [Text]
forall a b. (a -> b) -> a -> b
$ Only Text -> Text
forall a. Only a -> a
PG.fromOnly (Only Text -> Text) -> [Only Text] -> [Text]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Only Text]
fields

fetchRows :: FromRow r => PG.Connection -> Text -> IO [r]
fetchRows :: forall r. FromRow r => Connection -> Text -> IO [r]
fetchRows Connection
connection Text
tableName = do
    [Text]
pkFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName

    let query :: Text
query = Text
"SELECT * FROM "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if [Text] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null [Text]
pkFields
                    then Text
""
                    else Text
" ORDER BY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
pkFields
                )

    Connection -> Query -> IO [r]
forall r. FromRow r => Connection -> Query -> IO [r]
PG.query_ Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query)

fetchRowsPage :: FromRow r => PG.Connection -> Text -> Int -> Int -> IO [r]
fetchRowsPage :: forall r. FromRow r => Connection -> Text -> Int -> Int -> IO [r]
fetchRowsPage Connection
connection Text
tableName Int
page Int
rows = do
    [Text]
pkFields <- Connection -> Text -> IO [Text]
tablePrimaryKeyFields Connection
connection Text
tableName
    let slice :: Text
slice = Text
" OFFSET " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
show (Int
page Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
rows Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
rows) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ROWS FETCH FIRST " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> Text
forall a. Show a => a -> Text
show Int
rows Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
" ROWS ONLY"
    let query :: Text
query = Text
"SELECT * FROM "
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableName
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (if [Text] -> Bool
forall mono. MonoFoldable mono => mono -> Bool
null [Text]
pkFields
                    then Text
""
                    else Text
" ORDER BY " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
intercalate Text
", " [Text]
pkFields
                )
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
slice

    Connection -> Query -> IO [r]
forall r. FromRow r => Connection -> Query -> IO [r]
PG.query_ Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> (Text -> ByteString) -> Text -> Query
forall b c a. (b -> c) -> (a -> b) -> a -> c
forall {k} (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs (Text -> Query) -> Text -> Query
forall a b. (a -> b) -> a -> b
$! Text
query)

tableLength :: PG.Connection -> Text -> IO Int
tableLength :: Connection -> Text -> IO Int
tableLength Connection
connection Text
tableName = do
    [Only Int
count] <- Connection -> Query -> [Identifier] -> IO [Only Int]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection Query
"SELECT COUNT(*) FROM ?" [Text -> Identifier
PG.Identifier Text
tableName]
    Int -> IO Int
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
count


-- parseValues sqlMode isBoolField input
parseValues :: Bool -> Bool -> Text -> PG.Action
parseValues :: Bool -> Bool -> Text -> Action
parseValues Bool
_ Bool
True Text
"on" = Bool -> Action
forall a. ToField a => a -> Action
PG.toField Bool
True
parseValues Bool
_ Bool
True Text
"off" = Bool -> Action
forall a. ToField a => a -> Action
PG.toField Bool
False
parseValues Bool
False Bool
_ Text
text = Text -> Action
forall a. ToField a => a -> Action
PG.toField Text
text
parseValues Bool
_ Bool
_ Text
text = Builder -> Action
PG.Plain (ByteString -> Builder
Data.ByteString.Builder.byteString (Text -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs Text
text))

updateValues :: [(a, a)] -> [a]
updateValues [(a, a)]
list = ((a, a) -> a) -> [(a, a)] -> [a]
forall a b. (a -> b) -> [a] -> [b]
map (\(a, a)
elem -> (a, a) -> a
forall a b. (a, b) -> a
fst (a, a)
elem a -> a -> a
forall a. Semigroup a => a -> a -> a
<> a
" = " a -> a -> a
forall a. Semigroup a => a -> a -> a
<> (a, a) -> a
forall a b. (a, b) -> b
snd (a, a)
elem) [(a, a)]
list

isQuery :: Text -> Bool
isQuery Text
sql = Text -> Text -> Bool
T.isInfixOf Text
"SELECT" Text
u
    where u :: Text
u = Text -> Text
T.toUpper Text
sql



fetchForeignKeyInfo :: PG.Connection -> Text -> Text -> IO (Maybe (Text, Text))
fetchForeignKeyInfo :: Connection -> Text -> Text -> IO (Maybe (Text, Text))
fetchForeignKeyInfo Connection
connection Text
tableName Text
columnName = do
    let sql :: String
sql = [plain|
        SELECT
            ccu.table_name AS foreign_table_name,
            ccu.column_name AS foreign_column_name
        FROM
            information_schema.table_constraints AS tc
            JOIN information_schema.key_column_usage AS kcu
              ON tc.constraint_name = kcu.constraint_name
              AND tc.table_schema = kcu.table_schema
            JOIN information_schema.constraint_column_usage AS ccu
              ON ccu.constraint_name = tc.constraint_name
              AND ccu.table_schema = tc.table_schema
        WHERE
            tc.constraint_type = 'FOREIGN KEY'
            AND tc.table_name = ?
            AND kcu.column_name = ?
    |]
    let args :: (Text, Text)
args = (Text
tableName, Text
columnName)
    [(Text, Text)]
result <- Connection -> Query -> (Text, Text) -> IO [(Text, Text)]
forall q r.
(ToRow q, FromRow r) =>
Connection -> Query -> q -> IO [r]
PG.query Connection
connection (ByteString -> Query
PG.Query (ByteString -> Query) -> ByteString -> Query
forall a b. (a -> b) -> a -> b
$ String -> ByteString
forall a b. ConvertibleStrings a b => a -> b
cs String
sql) (Text, Text)
args
    case [(Text, Text)]
result of
        [(Text
foreignTableName, Text
foreignColumnName)] -> Maybe (Text, Text) -> IO (Maybe (Text, Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, Text) -> IO (Maybe (Text, Text)))
-> Maybe (Text, Text) -> IO (Maybe (Text, Text))
forall a b. (a -> b) -> a -> b
$ (Text, Text) -> Maybe (Text, Text)
forall a. a -> Maybe a
Just (Text
foreignTableName, Text
foreignColumnName)
        [(Text, Text)]
otherwise -> Maybe (Text, Text) -> IO (Maybe (Text, Text))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe (Text, Text) -> IO (Maybe (Text, Text)))
-> Maybe (Text, Text) -> IO (Maybe (Text, Text))
forall a b. (a -> b) -> a -> b
$ Maybe (Text, Text)
forall a. Maybe a
Nothing

instance {-# OVERLAPS #-} ToJSON [DynamicField] where
    toJSON :: [DynamicField] -> Value
toJSON [DynamicField]
fields = [Pair] -> Value
object ((DynamicField -> Pair) -> [DynamicField] -> [Pair]
forall a b. (a -> b) -> [a] -> [b]
map (\DynamicField { ByteString
$sel:fieldName:DynamicField :: DynamicField -> ByteString
fieldName :: ByteString
fieldName, Maybe ByteString
$sel:fieldValue:DynamicField :: DynamicField -> Maybe ByteString
fieldValue :: Maybe ByteString
fieldValue } -> (ByteString -> Key
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
fieldName) Key -> Value -> Pair
forall v. ToJSON v => Key -> v -> Pair
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe ByteString -> Value
forall {a}. ConvertibleStrings a Text => Maybe a -> Value
fieldValueToJSON Maybe ByteString
fieldValue)) [DynamicField]
fields)
        where
            fieldValueToJSON :: Maybe a -> Value
fieldValueToJSON (Just a
bs) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON ((a -> Text
forall a b. ConvertibleStrings a b => a -> b
cs a
bs) :: Text)
            fieldValueToJSON Maybe a
Nothing = Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
Null
    toEncoding :: [DynamicField] -> Encoding
toEncoding [DynamicField]
fields = Series -> Encoding
pairs (Series -> Encoding) -> Series -> Encoding
forall a b. (a -> b) -> a -> b
$ (Series -> Series -> Series) -> Series -> [Series] -> Series
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Series -> Series -> Series
forall a. Semigroup a => a -> a -> a
(<>) Series
forall a. Monoid a => a
mempty ([Series]
encodedFields)
        where
            encodedFields :: [Series]
encodedFields = ((DynamicField -> Series) -> [DynamicField] -> [Series]
forall a b. (a -> b) -> [a] -> [b]
map (\DynamicField { ByteString
$sel:fieldName:DynamicField :: DynamicField -> ByteString
fieldName :: ByteString
fieldName, Maybe ByteString
$sel:fieldValue:DynamicField :: DynamicField -> Maybe ByteString
fieldValue :: Maybe ByteString
fieldValue } -> (ByteString -> Key
forall a b. ConvertibleStrings a b => a -> b
cs ByteString
fieldName) Key -> Value -> Series
forall v. ToJSON v => Key -> v -> Series
forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
.= (Maybe ByteString -> Value
forall {a}. ConvertibleStrings a Text => Maybe a -> Value
fieldValueToJSON Maybe ByteString
fieldValue)) [DynamicField]
fields)
            fieldValueToJSON :: Maybe a -> Value
fieldValueToJSON (Just a
bs) = Text -> Value
forall a. ToJSON a => a -> Value
toJSON ((a -> Text
forall a b. ConvertibleStrings a b => a -> b
cs a
bs) :: Text)
            fieldValueToJSON Maybe a
Nothing = Value -> Value
forall a. ToJSON a => a -> Value
toJSON Value
Null