推进

chusql-interface/src/ChuSQL/Interface/Actions.hs

@@ -32,6 +32,7 @@ module ChuSQL.Interface.Actions (
     revokeRoleSql,
 ) where
 
+import Control.Monad (zipWithM)
 import ChuSQL.Core.Model (Column (..), ColumnType (..), Value (..), integerType, numericType, parseColumnType, plainColumn, typeName)
 import qualified ChuSQL.Core.Model as M
 import ChuSQL.Core.Runtime
@@ -127,7 +128,7 @@ runtimeLiteral (TypeApply (TypeConstructorId 6) [child]) (RMaybe value) = do
     Right ("MAYBE<" ++ renderTypeExpr child ++ ">(" ++ item ++ ")")
 runtimeLiteral (TypeApply (TypeConstructorId 7) fields) (RTuple values)
     | length fields == length values = do
-        items <- sequence (zipWith runtimeLiteral fields values)
+        items <- zipWithM runtimeLiteral fields values
         Right ("TUPLE<" ++ intercalate ", " (map renderTypeExpr fields) ++ ">(" ++ intercalate ", " items ++ ")")
 runtimeLiteral _ _ = Left "runtime value does not match its type expression"
 

chusql-interface/src/ChuSQL/Interface/Config.hs

@@ -200,9 +200,7 @@ loadServerConfigAt path = do
             Just value | not (T.null (T.strip value)) -> T.unpack (T.strip value)
             _ -> fallback
         -- | 取一个键的整数值
-        intOf key fallback = case Map.lookup key values >>= readMaybe . T.unpack . T.strip of
-            Just number -> number
-            Nothing -> fallback
+        intOf key fallback = fromMaybe fallback (Map.lookup key values >>= readMaybe . T.unpack . T.strip)
     pure
         defaultServerConfig
             { scHost = textOf "listen_host" (scHost defaultServerConfig)

chusql-interface/src/ChuSQL/Interface/Session.hs

@@ -17,6 +17,7 @@ module ChuSQL.Interface.Session (
     accounts,
 ) where
 
+import Data.Foldable (for_)
 import ChuSQL.Interface.Normalization
 import qualified Data.Aeson as A
 import ChuSQL.Core.Protocol (Account, QueryResult (..), TableInfo)
@@ -103,9 +104,8 @@ runStatement session sql = do
     case answer of
         Left message -> pure (Left message)
         Right result -> do
-            case qrDatabase result of
-                Just name -> writeIORef (ssCurrent session) name
-                Nothing -> pure ()
+            for_
+              (qrDatabase result) (writeIORef (ssCurrent session))
             pure (Right result)
 
 -- | 数据字典（\\dt 与 \\d 用）

chusql-interface/src/ChuSQL/Interface/TOML.hs

@@ -36,12 +36,13 @@ writeSection path section values = do
     prepared <- prepareDirectory
     case prepared of
         Left err -> pure (Left err)
-        Right () -> do
-            exists <- doesFileExist path
-            raw <- if exists then TE.decodeUtf8 <$> BS.readFile path else pure ""
-            let updated = T.unlines (rewrite section values (T.lines raw))
-            written <- tryWrite (TE.encodeUtf8 updated)
-            pure written
+        Right () -> do exists <- doesFileExist path
+                       raw <- if exists then
+                                  TE.decodeUtf8 <$> BS.readFile path
+                              else
+                                  pure ""
+                       let updated = T.unlines (rewrite section values (T.lines raw))
+                       tryWrite (TE.encodeUtf8 updated)
   where
     -- | 目录不存在就先建
     prepareDirectory = do
@@ -111,7 +112,7 @@ rewrite :: Text -> Map Text Text -> [Text] -> [Text]
 rewrite section values = addMissing . replaceInSection . dropEmpties
   where
     -- | 删掉空值的键
-    dropEmpties = filter (\line -> maybe True (not . T.null . snd) (assignment line))
+    dropEmpties = filter (maybe True (not . T.null . snd) . assignment)
     -- | 在目标分区里就地换行
     replaceInSection = go ""
     -- | 走到目标分区后逐行替换
@@ -158,7 +159,7 @@ keysOf wanted = go ""
 appendSection :: Text -> [(Text, Text)] -> [Text] -> [Text]
 appendSection section entries lines' =
     lines'
-        ++ (if null lines' || not (T.null (last lines')) then [""] else [])
+        ++ (["" | null lines' || not (T.null (last lines'))])
         ++ ("[" <> section <> "]") : [assignmentLine key value | (key, value) <- entries]
 
 -- | 全局配置文件的固定路径，跟随系统惯例