大更新：
1、完善SQL语法 2、移除node前端，只保留静态资源 3、写好安装脚本 4、做好linux适配
This commit is contained in:
LIm1tZz7 committed
1 parent
687c012841
commit
df6d348995
166 files changed
+16317
-10763
No files matched your search
@@ -0,0 +1,102 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.CLI.Format
|
||||
( OutputFormat (..)
|
||||
, parseFormat
|
||||
, formatName
|
||||
, renderResult
|
||||
, renderTable
|
||||
, renderRows
|
||||
, renderCsv
|
||||
, renderJson
|
||||
, displayValue
|
||||
) where
|
||||
|
||||
import ChuSQL.CLI.Session (QueryResult (..), queryResultJson)
|
||||
import ChuSQL.Model (Value (..))
|
||||
import qualified Data.Aeson as A
|
||||
import qualified Data.ByteString.Lazy as BL
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Text.Encoding (decodeUtf8)
|
||||
|
||||
-- 结果输出：表格、JSON、CSV 三种格式。
|
||||
|
||||
data OutputFormat = FormatTable | FormatJson | FormatCsv
|
||||
deriving (Eq, Show)
|
||||
|
||||
formatName :: OutputFormat -> Text
|
||||
formatName FormatTable = "table"
|
||||
formatName FormatJson = "json"
|
||||
formatName FormatCsv = "csv"
|
||||
|
||||
-- | 认一个格式名
|
||||
parseFormat :: Text -> Maybe OutputFormat
|
||||
parseFormat raw = case T.toLower (T.strip raw) of
|
||||
"table" -> Just FormatTable
|
||||
"json" -> Just FormatJson
|
||||
"csv" -> Just FormatCsv
|
||||
_ -> Nothing
|
||||
|
||||
renderResult :: OutputFormat -> QueryResult -> Text
|
||||
renderResult FormatTable = renderTable
|
||||
renderResult FormatJson = renderJson
|
||||
renderResult FormatCsv = renderCsv
|
||||
|
||||
-- | 紧凑 JSON，方便管道里再用
|
||||
renderJson :: QueryResult -> Text
|
||||
renderJson = decodeUtf8 . BL.toStrict . A.encode . queryResultJson
|
||||
|
||||
renderCsv :: QueryResult -> Text
|
||||
renderCsv result = T.unlines (header : map rowLine (qrRows result))
|
||||
where
|
||||
header = T.intercalate "," (map csvField (qrColumns result))
|
||||
rowLine row = T.intercalate "," (map (csvField . csvCell) row)
|
||||
|
||||
-- | CSV 里的空值就是空字段
|
||||
csvCell :: Value -> Text
|
||||
csvCell VNull = ""
|
||||
csvCell value = displayValue value
|
||||
|
||||
-- | 按 RFC 4180 给需要的字段加引号
|
||||
csvField :: Text -> Text
|
||||
csvField field
|
||||
| T.any (`elem` (",\"\n\r" :: String)) field = "\"" <> T.replace "\"" "\"\"" field <> "\""
|
||||
| otherwise = field
|
||||
|
||||
renderTable :: QueryResult -> Text
|
||||
renderTable result
|
||||
| null (qrColumns result) = "OK"
|
||||
| otherwise = renderRows (qrColumns result) (map (map displayValue) (qrRows result))
|
||||
|
||||
-- | 画一张等宽表，列太宽就截断
|
||||
renderRows :: [Text] -> [[Text]] -> Text
|
||||
renderRows columns rawRows = T.unlines (border : headerLine : border : body ++ [border, summary])
|
||||
where
|
||||
widths = [columnWidth index | index <- [0 .. length columns - 1]]
|
||||
columnWidth index =
|
||||
min maxColumnWidth (maximum (T.length (columns !! index) : [T.length (cellAt row index) | row <- rawRows]))
|
||||
maxColumnWidth = 64
|
||||
cellAt row index = if index < length row then row !! index else ""
|
||||
cellLine cells = "| " <> T.intercalate " | " (zipWith pad widths (cells ++ repeat "")) <> " |"
|
||||
headerLine = cellLine columns
|
||||
body = map cellLine rawRows
|
||||
border = "+" <> T.intercalate "+" ["-" <> T.replicate (width + 2) "-" | width <- widths] <> "+"
|
||||
summary = "(" <> T.pack (show (length rawRows)) <> " row" <> (if length rawRows == 1 then "" else "s") <> ")"
|
||||
|
||||
-- | 补到指定宽度，超出的按 ... 截断
|
||||
pad :: Int -> Text -> Text
|
||||
pad width text = clipped <> T.replicate (width - T.length clipped) " "
|
||||
where
|
||||
clipped
|
||||
| T.length text <= width = text
|
||||
| width <= 3 = T.take width text
|
||||
| otherwise = T.take (width - 3) text <> "..."
|
||||
|
||||
displayValue :: Value -> Text
|
||||
displayValue VNull = "NULL"
|
||||
displayValue (VInt n) = T.pack (show n)
|
||||
displayValue (VFloat d) = T.pack (show d)
|
||||
displayValue (VStr s) = T.pack s
|
||||
displayValue (VBool True) = "true"
|
||||
displayValue (VBool False) = "false"
|
||||
@@ -0,0 +1,123 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.CLI.Script
|
||||
( Meta (..)
|
||||
, parseMeta
|
||||
, takeStatement
|
||||
, statementComplete
|
||||
, stripTerminator
|
||||
, errorHint
|
||||
, metaHelp
|
||||
) where
|
||||
|
||||
import ChuSQL.CLI.Format (OutputFormat (..), formatName, parseFormat)
|
||||
import Data.Char (isSpace)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
|
||||
-- 交互层的纯逻辑：元命令、多行语句切分、错误提示。
|
||||
|
||||
data Meta
|
||||
= MetaQuit
|
||||
| MetaHelp
|
||||
| MetaDatabases
|
||||
| MetaTables
|
||||
| MetaDescribe Text
|
||||
| MetaRoles
|
||||
| MetaConnect Text
|
||||
| MetaSetFormat OutputFormat
|
||||
| MetaUnknown Text
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | 反斜杠开头的行是元命令，其余交给 SQL
|
||||
parseMeta :: Text -> Maybe Meta
|
||||
parseMeta raw = do
|
||||
body <- T.stripPrefix "\\" (T.strip raw)
|
||||
let (command, rest) = T.break isSpace body
|
||||
argument = T.strip rest
|
||||
pure $ case T.toLower command of
|
||||
"q" -> MetaQuit
|
||||
"quit" -> MetaQuit
|
||||
"exit" -> MetaQuit
|
||||
"?" -> MetaHelp
|
||||
"h" -> MetaHelp
|
||||
"help" -> MetaHelp
|
||||
"l" -> MetaDatabases
|
||||
"list" -> MetaDatabases
|
||||
"dt" -> MetaTables
|
||||
"tables" -> MetaTables
|
||||
"d" | T.null argument -> MetaTables
|
||||
| otherwise -> MetaDescribe argument
|
||||
"dr" -> MetaRoles
|
||||
"roles" -> MetaRoles
|
||||
"c" -> connectTo argument
|
||||
"connect" -> connectTo argument
|
||||
"use" -> connectTo argument
|
||||
"f" -> selectFormat argument
|
||||
"format" -> selectFormat argument
|
||||
other -> MetaUnknown other
|
||||
where
|
||||
connectTo argument
|
||||
| T.null argument = MetaUnknown "c"
|
||||
| otherwise = MetaConnect argument
|
||||
selectFormat argument = maybe (MetaUnknown "format") MetaSetFormat (parseFormat argument)
|
||||
|
||||
-- | 取出第一条以分号结束的语句与后面的残余；字符串与注释里的分号不算
|
||||
takeStatement :: Text -> Maybe (Text, Text)
|
||||
takeStatement = go ScanNormal [] . T.unpack
|
||||
where
|
||||
go _ _ [] = Nothing
|
||||
go ScanNormal acc (';' : rest) = Just (T.strip (T.pack (reverse acc)), T.pack rest)
|
||||
go ScanNormal acc ('-' : '-' : rest) = go ScanLineComment ('-' : '-' : acc) rest
|
||||
go ScanNormal acc ('/' : '*' : rest) = go ScanBlockComment ('*' : '/' : acc) rest
|
||||
go ScanNormal acc ('\'' : rest) = go ScanString ('\'' : acc) rest
|
||||
go ScanNormal acc (ch : rest) = go ScanNormal (ch : acc) rest
|
||||
go ScanString acc ('\'' : '\'' : rest) = go ScanString ('\'' : '\'' : acc) rest
|
||||
go ScanString acc ('\'' : rest) = go ScanNormal ('\'' : acc) rest
|
||||
go ScanString acc (ch : rest) = go ScanString (ch : acc) rest
|
||||
go ScanLineComment acc ('\n' : rest) = go ScanNormal ('\n' : acc) rest
|
||||
go ScanLineComment acc (ch : rest) = go ScanLineComment (ch : acc) rest
|
||||
go ScanBlockComment acc ('*' : '/' : rest) = go ScanNormal ('/' : '*' : acc) rest
|
||||
go ScanBlockComment acc (ch : rest) = go ScanBlockComment (ch : acc) rest
|
||||
|
||||
data ScanState = ScanNormal | ScanString | ScanLineComment | ScanBlockComment
|
||||
|
||||
-- | 攒下来的内容里有没有一条以分号结束的语句
|
||||
statementComplete :: Text -> Bool
|
||||
statementComplete = maybe False (const True) . takeStatement
|
||||
|
||||
-- | 去掉结尾的空白与分号（-e 直接执行时用）
|
||||
stripTerminator :: Text -> Text
|
||||
stripTerminator raw = T.stripEnd (T.dropWhileEnd (== ';') (T.stripEnd raw))
|
||||
|
||||
-- | 常见错误给一句怎么查
|
||||
errorHint :: Text -> Maybe Text
|
||||
errorHint message
|
||||
| "unknown table" `T.isInfixOf` lowered = Just "run \\dt to list the tables of the current database"
|
||||
| "unknown column" `T.isInfixOf` lowered = Just "run \\d <table> to see the columns of a table"
|
||||
| "unknown database" `T.isInfixOf` lowered = Just "run \\l to list the databases"
|
||||
| "syntax" `T.isInfixOf` lowered = Just "one statement at a time, and every statement ends with a semicolon"
|
||||
| "invalid user name or password" `T.isInfixOf` lowered = Just "check --user and the password"
|
||||
| "sign in first" `T.isInfixOf` lowered = Just "the session expired, restart the CLI"
|
||||
| "too many failed sign-in attempts" `T.isInfixOf` lowered = Just "wait a few minutes before trying again"
|
||||
| otherwise = Nothing
|
||||
where
|
||||
lowered = T.toLower message
|
||||
|
||||
-- | \? 的帮助文本
|
||||
metaHelp :: Text
|
||||
metaHelp =
|
||||
T.unlines
|
||||
[ "SQL statements end with a semicolon; a statement may span several lines."
|
||||
, ""
|
||||
, " \\q, \\quit leave the CLI"
|
||||
, " \\?, \\h, \\help show this help"
|
||||
, " \\l, \\list list databases"
|
||||
, " \\dt, \\d list tables"
|
||||
, " \\d <table> describe a table"
|
||||
, " \\dr, \\roles list roles with their grants and members"
|
||||
, " \\c <database> switch database"
|
||||
, " \\f, \\format <fmt> output format: " <> T.intercalate ", " (map formatName [FormatTable, FormatJson, FormatCsv])
|
||||
, ""
|
||||
, "At the chusql> prompt the arrow keys walk the SQL history."
|
||||
]
|
||||
@@ -0,0 +1,270 @@
|
||||
{-# LANGUAGE OverloadedStrings #-}
|
||||
|
||||
module ChuSQL.CLI.Session
|
||||
( QueryResult (..)
|
||||
, Session
|
||||
, newSession
|
||||
, sessionUser
|
||||
, sessionIsAdmin
|
||||
, sessionDatabase
|
||||
, isPlainIdentifier
|
||||
, authenticateSession
|
||||
, switchDatabase
|
||||
, runStatement
|
||||
, catalog
|
||||
, accountTable
|
||||
, roleViews
|
||||
, databases
|
||||
, queryResultJson
|
||||
) where
|
||||
|
||||
import ChuSQL.Model (Value (..))
|
||||
import ChuSQL.Storage.IPC (TableInfo (..))
|
||||
import ChuSQL.Syntax.AST (Statement (..))
|
||||
import ChuSQL.Syntax.Parser (parseStatement)
|
||||
import ChuSQL.Web.Accounts
|
||||
import ChuSQL.Web.API (configurePasswordPolicy, systemTableInfo)
|
||||
import ChuSQL.Web.Auth (Credential, defaultSessionPolicy, newSessionStore)
|
||||
import ChuSQL.Web.Backend (Backend (..), StatementResult (..))
|
||||
import ChuSQL.Web.Privileges (PrivilegeCommand, PrivilegeError (..), Privileges, RoleView, authorize, filterTables, listRoleViews, newPrivileges, privilegeCommand, runPrivilegeCommand)
|
||||
import Data.Aeson (object, (.=))
|
||||
import qualified Data.Aeson as A
|
||||
import Data.Char (isAlpha, isAlphaNum)
|
||||
import Data.IORef (IORef, newIORef, readIORef, writeIORef)
|
||||
import Data.Scientific (fromFloatDigits)
|
||||
import Data.Text (Text)
|
||||
import qualified Data.Text as T
|
||||
import Data.Time.Clock (getCurrentTime)
|
||||
|
||||
-- CLI 会话：直接连存储与引擎，但账号服务与 Web 管理端是同一套
|
||||
-- （同一个 root 凭据，同一张 __chusql_users）。
|
||||
|
||||
data QueryResult = QueryResult
|
||||
{ qrColumns :: [Text]
|
||||
, qrRows :: [[Value]]
|
||||
, qrRowCount :: Int
|
||||
, qrTruncated :: Bool
|
||||
, qrDatabase :: Maybe Text
|
||||
}
|
||||
deriving (Eq, Show)
|
||||
|
||||
data Session = Session
|
||||
{ ssBackend :: Backend
|
||||
, ssAccounts :: Accounts
|
||||
, ssPrivileges :: Privileges
|
||||
, ssCurrent :: IORef Text
|
||||
, ssPrincipal :: IORef (Maybe Principal)
|
||||
}
|
||||
|
||||
-- | 开一个会话：账号与角色服务、配置策略都和 Web 端一致
|
||||
newSession :: Backend -> Credential -> FilePath -> IO Session
|
||||
newSession backend credential settingsFile = do
|
||||
sessions <- newSessionStore getCurrentTime defaultSessionPolicy
|
||||
accounts <- newAccounts backend sessions credential
|
||||
privileges <- newPrivileges backend
|
||||
configurePasswordPolicy accounts settingsFile
|
||||
-- 服务启动后只有系统库：没 USE 之前不预设任何工作库
|
||||
current <- newIORef ""
|
||||
principal <- newIORef Nothing
|
||||
pure (Session backend accounts privileges current principal)
|
||||
|
||||
-- | 当前登录的账号名
|
||||
sessionUser :: Session -> IO (Maybe Text)
|
||||
sessionUser session = fmap principalName <$> readIORef (ssPrincipal session)
|
||||
|
||||
-- | 是不是配置里的 root
|
||||
sessionIsAdmin :: Session -> IO Bool
|
||||
sessionIsAdmin session = maybe False principalIsRoot <$> readIORef (ssPrincipal session)
|
||||
|
||||
-- | 当前库
|
||||
sessionDatabase :: Session -> IO Text
|
||||
sessionDatabase = readIORef . ssCurrent
|
||||
|
||||
-- | 与解析器一致的裸标识符判断
|
||||
isPlainIdentifier :: Text -> Bool
|
||||
isPlainIdentifier name =
|
||||
not (T.null name)
|
||||
&& T.length name <= 64
|
||||
&& (isAlpha (T.head name) || T.head name == '_')
|
||||
&& T.all (\ch -> isAlphaNum ch || ch == '_') name
|
||||
|
||||
-- | 登录：root 比配置里的凭据，普通账号查 __chusql_users
|
||||
authenticateSession :: Session -> Text -> Text -> IO (Either Text ())
|
||||
authenticateSession session user password = do
|
||||
result <- authenticate (ssAccounts session) user password
|
||||
case result of
|
||||
Left err -> pure (Left (accountMessage err))
|
||||
Right token -> do
|
||||
who <- currentPrincipal (ssAccounts session) token
|
||||
case who of
|
||||
Left err -> pure (Left (accountMessage err))
|
||||
Right principal -> do
|
||||
writeIORef (ssPrincipal session) (Just principal)
|
||||
pure (Right ())
|
||||
|
||||
-- | 换库；系统库只有 root 能进
|
||||
switchDatabase :: Session -> Text -> IO (Either Text ())
|
||||
switchDatabase session rawName
|
||||
| not (isPlainIdentifier name) = pure (Left ("not a plain database name: " <> name))
|
||||
| name == "system" = do
|
||||
admin <- sessionIsAdmin session
|
||||
if admin then go else pure (Left "the system database is only available to the administrator")
|
||||
| otherwise = go
|
||||
where
|
||||
name = T.toLower (T.strip rawName)
|
||||
go = do
|
||||
backend <- currentBackend session
|
||||
result <- beStatement backend ("USE " ++ T.unpack name)
|
||||
case result of
|
||||
Left err -> pure (Left (T.pack err))
|
||||
Right _ -> writeIORef (ssCurrent session) name >> pure (Right ())
|
||||
|
||||
-- | 跑一条语句：USE、账号语句与角色语句在这里分流，其余交给引擎
|
||||
-- （普通身份先过一遍权限判定，管理员与未登录直接放行）
|
||||
runStatement :: Session -> Text -> IO (Either Text QueryResult)
|
||||
runStatement session sql = case parseStatement (T.unpack sql) of
|
||||
Right (UseDatabase name) -> do
|
||||
switched <- switchDatabase session (T.pack name)
|
||||
case switched of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> do
|
||||
current <- readIORef (ssCurrent session)
|
||||
pure (Right (emptyResult (Just current)))
|
||||
Right statement
|
||||
| Just command <- accountCommand statement -> runAccount session command
|
||||
| Just command <- privilegeCommand statement -> runPrivilege session command
|
||||
| otherwise -> do
|
||||
allowed <- authorized session statement
|
||||
case allowed of
|
||||
Left err -> pure (Left err)
|
||||
Right () -> runPlain session sql
|
||||
Left _ -> runPlain session sql
|
||||
|
||||
-- | 普通身份跑语句前的权限判定；管理员与未登录放行
|
||||
authorized :: Session -> Statement -> IO (Either Text ())
|
||||
authorized session statement = do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case who of
|
||||
Just principal | not (principalIsRoot principal) -> do
|
||||
database <- readIORef (ssCurrent session)
|
||||
result <- authorize (ssPrivileges session) principal database statement
|
||||
pure (either (Left . privilegeMessage) (const (Right ())) result)
|
||||
_ -> pure (Right ())
|
||||
|
||||
-- | 落到引擎/存储层的一条语句
|
||||
runPlain :: Session -> Text -> IO (Either Text QueryResult)
|
||||
runPlain session sql = do
|
||||
backend <- currentBackend session
|
||||
result <- beStatement backend (T.unpack sql)
|
||||
pure (either (Left . T.pack) (Right . resultOf) result)
|
||||
|
||||
-- | 数据字典（\dt 与 \d 用）；普通身份只看得到自己有 SELECT 的表
|
||||
catalog :: Session -> IO (Either Text [TableInfo])
|
||||
catalog session = do
|
||||
current <- readIORef (ssCurrent session)
|
||||
if T.null current
|
||||
then pure (Left "no database selected")
|
||||
else do
|
||||
backend <- currentBackend session
|
||||
result <- beCatalog backend
|
||||
case result of
|
||||
Left e -> pure (Left (T.pack e))
|
||||
Right infos -> do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case who of
|
||||
Just principal | not (principalIsRoot principal) -> do
|
||||
allowed <- filterTables (ssPrivileges session) principal current (map (T.pack . tiTable) infos)
|
||||
pure (either (Left . privilegeMessage) (\names -> Right (filter (\info -> T.pack (tiTable info) `elem` names) infos)) allowed)
|
||||
_ -> pure (Right infos)
|
||||
|
||||
-- | 库清单（\l 用）
|
||||
databases :: Session -> IO (Either Text [Text])
|
||||
databases session = do
|
||||
result <- beDatabases (ssBackend session)
|
||||
pure (either (Left . T.pack) (Right . map T.pack) result)
|
||||
|
||||
-- | 系统库里的账号表：列定义与 Web 端共用一份，行数从同一套账号服务来
|
||||
accountTable :: Session -> IO (Maybe TableInfo)
|
||||
accountTable session = do
|
||||
admin <- sessionIsAdmin session
|
||||
if not admin
|
||||
then pure Nothing
|
||||
else do
|
||||
result <- listAccounts (ssAccounts session)
|
||||
pure (either (const Nothing) (\accounts -> Just systemTableInfo{tiRows = length accounts}) result)
|
||||
|
||||
-- | 角色总览（\dr 用）；与 Web 的 /api/roles 一样只给管理员
|
||||
roleViews :: Session -> IO (Either Text [RoleView])
|
||||
roleViews session = do
|
||||
admin <- sessionIsAdmin session
|
||||
if not admin
|
||||
then pure (Left "administrator required")
|
||||
else do
|
||||
result <- listRoleViews (ssPrivileges session)
|
||||
pure (either (Left . privilegeMessage) Right result)
|
||||
|
||||
-- | 当前库对应的后端
|
||||
currentBackend :: Session -> IO Backend
|
||||
currentBackend session = do
|
||||
name <- readIORef (ssCurrent session)
|
||||
pure (beWithDatabase (ssBackend session) (T.unpack name))
|
||||
|
||||
-- | 账号语句走账号服务，普通账号一律拒绝
|
||||
runAccount :: Session -> AccountCommand -> IO (Either Text QueryResult)
|
||||
runAccount session command = do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case who of
|
||||
Nothing -> pure (Left "sign in first")
|
||||
Just principal -> do
|
||||
result <- runAccountCommand (ssAccounts session) principal command
|
||||
pure (either (Left . accountMessage) (const (Right (emptyResult Nothing))) result)
|
||||
|
||||
-- | 角色语句走权限服务，普通账号一律拒绝；当前库决定授权对象的落库口径
|
||||
runPrivilege :: Session -> PrivilegeCommand -> IO (Either Text QueryResult)
|
||||
runPrivilege session command = do
|
||||
who <- readIORef (ssPrincipal session)
|
||||
case who of
|
||||
Nothing -> pure (Left "sign in first")
|
||||
Just principal -> do
|
||||
database <- readIORef (ssCurrent session)
|
||||
result <- runPrivilegeCommand (ssPrivileges session) principal database command
|
||||
pure (either (Left . privilegeMessage) (const (Right (emptyResult Nothing))) result)
|
||||
|
||||
accountMessage :: AccountError -> Text
|
||||
accountMessage (AccountError _ message) = message
|
||||
|
||||
privilegeMessage :: PrivilegeError -> Text
|
||||
privilegeMessage (PrivilegeError _ message) = message
|
||||
|
||||
emptyResult :: Maybe Text -> QueryResult
|
||||
emptyResult database = QueryResult [] [] 0 False database
|
||||
|
||||
resultOf :: StatementResult -> QueryResult
|
||||
resultOf result =
|
||||
QueryResult
|
||||
{ qrColumns = map T.pack (srColumns result)
|
||||
, qrRows = [map (cellOf row) (srColumns result) | row <- srRows result]
|
||||
, qrRowCount = length (srRows result)
|
||||
, qrTruncated = False
|
||||
, qrDatabase = Nothing
|
||||
}
|
||||
where
|
||||
cellOf row name = maybe VNull id (lookup name row)
|
||||
|
||||
-- | 结果还原成 JSON（JSON 输出用）
|
||||
queryResultJson :: QueryResult -> A.Value
|
||||
queryResultJson result =
|
||||
object
|
||||
[ "columns" .= qrColumns result
|
||||
, "rows" .= map (map valueToJson) (qrRows result)
|
||||
, "rowCount" .= qrRowCount result
|
||||
, "truncated" .= qrTruncated result
|
||||
, "database" .= qrDatabase result
|
||||
]
|
||||
|
||||
valueToJson :: Value -> A.Value
|
||||
valueToJson VNull = A.Null
|
||||
valueToJson (VInt n) = A.Number (fromIntegral n)
|
||||
valueToJson (VFloat d) = A.Number (fromFloatDigits d)
|
||||
valueToJson (VStr s) = A.String (T.pack s)
|
||||
valueToJson (VBool b) = A.Bool b
|
||||
Reference in new issue
Block a user