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 :: 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