format code

This commit is contained in:
2026-03-29 13:38:58 +08:00
parent 55719f3444
commit fc4cac00d5

View File

@@ -4,7 +4,6 @@
{-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneKindSignatures #-} {-# LANGUAGE StandaloneKindSignatures #-}
{-# LANGUAGE ViewPatterns #-}
import ChaoDoc import ChaoDoc
import Control.Concurrent (forkIO, threadDelay) import Control.Concurrent (forkIO, threadDelay)
@@ -23,6 +22,7 @@ import Data.Time.Format (defaultTimeLocale, formatTime)
import Data.Time.LocalTime (getZonedTime) import Data.Time.LocalTime (getZonedTime)
import Hakyll import Hakyll
import Hakyll.Core.Runtime (RunMode (RunModeNormal)) import Hakyll.Core.Runtime (RunMode (RunModeNormal))
import Network.Wai.Application.Static (staticApp)
import qualified Network.Wai.Handler.Warp as Warp import qualified Network.Wai.Handler.Warp as Warp
import qualified Paths_hakysidian as Paths import qualified Paths_hakysidian as Paths
import System.Directory import System.Directory
@@ -31,19 +31,18 @@ import System.Directory
doesFileExist, doesFileExist,
getCurrentDirectory, getCurrentDirectory,
getModificationTime, getModificationTime,
listDirectory listDirectory,
) )
import System.Environment (getArgs, getExecutablePath, lookupEnv) import System.Environment (getArgs, getExecutablePath, lookupEnv)
import System.Exit (ExitCode (..), die, exitSuccess, exitWith) import System.Exit (ExitCode (..), die, exitSuccess, exitWith)
import System.FilePath import System.FilePath
import Network.Wai.Application.Static (staticApp)
import System.IO import System.IO
( BufferMode (NoBuffering), ( BufferMode (NoBuffering),
hFlush, hFlush,
hGetBuffering, hGetBuffering,
hIsTerminalDevice, hIsTerminalDevice,
hSetBuffering, hSetBuffering,
stdout stdout,
) )
import System.Process (CreateProcess (cwd), proc, readCreateProcessWithExitCode) import System.Process (CreateProcess (cwd), proc, readCreateProcessWithExitCode)
import Text.Pandoc (HTMLMathMethod (MathML), WriterOptions (..), compileTemplate) import Text.Pandoc (HTMLMathMethod (MathML), WriterOptions (..), compileTemplate)
@@ -232,8 +231,8 @@ validateProject projectRoot = do
unless (null missing) $ unless (null missing) $
die $ die $
unlines $ unlines $
"hakysidian is missing required project inputs:" : "hakysidian is missing required project inputs:"
map (" - " ++) missing : map (" - " ++) missing
initialDashboardState :: DashboardState initialDashboardState :: DashboardState
initialDashboardState = initialDashboardState =
@@ -294,14 +293,16 @@ withWatchTui action = do
then do then do
originalBuffering <- hGetBuffering stdout originalBuffering <- hGetBuffering stdout
bracket_ bracket_
(do ( do
hSetBuffering stdout NoBuffering hSetBuffering stdout NoBuffering
putStr "\ESC[?1049h\ESC[2J\ESC[H\ESC[?25l" putStr "\ESC[?1049h\ESC[2J\ESC[H\ESC[?25l"
hFlush stdout) hFlush stdout
(do )
( do
putStr "\ESC[0m\ESC[?25h\ESC[?1049l" putStr "\ESC[0m\ESC[?25h\ESC[?1049l"
hFlush stdout hFlush stdout
hSetBuffering stdout originalBuffering) hSetBuffering stdout originalBuffering
)
action action
else action else action
@@ -351,7 +352,7 @@ renderWatchDashboard renderStateRef projectRoot config watchSettings serverStatu
dashboardTitleRow :: Int -> String -> String -> String dashboardTitleRow :: Int -> String -> String -> String
dashboardTitleRow width leftText rightText = dashboardTitleRow width leftText rightText =
dashboardFramedRow width (leftText ++ spacer ++ clippedRight) dashboardRow width (leftText ++ spacer ++ clippedRight)
where where
usableWidth = max 1 (width - 4) usableWidth = max 1 (width - 4)
rightWidth = min (usableWidth `div` 3) (length rightText) rightWidth = min (usableWidth `div` 3) (length rightText)
@@ -366,10 +367,7 @@ dashboardTitleRow width leftText rightText =
| otherwise = replicate (max 1 (usableWidth - length clippedLeft - length clippedRight)) ' ' | otherwise = replicate (max 1 (usableWidth - length clippedLeft - length clippedRight)) ' '
dashboardRow :: Int -> String -> String dashboardRow :: Int -> String -> String
dashboardRow width = dashboardFramedRow width dashboardRow width content =
dashboardFramedRow :: Int -> String -> String
dashboardFramedRow width content =
"| " ++ padRight usableWidth (ellipsize usableWidth content) ++ " |" "| " ++ padRight usableWidth (ellipsize usableWidth content) ++ " |"
where where
usableWidth = max 1 (width - 4) usableWidth = max 1 (width - 4)
@@ -405,8 +403,8 @@ getTerminalSize = do
case sttySize of case sttySize of
Just terminalSize -> pure terminalSize Just terminalSize -> pure terminalSize
Nothing -> do Nothing -> do
rows <- maybe 24 id . (>>= readMaybe) <$> lookupEnv "LINES" rows <- fromMaybe 24 . (>>= readMaybe) <$> lookupEnv "LINES"
cols <- maybe 80 id . (>>= readMaybe) <$> lookupEnv "COLUMNS" cols <- fromMaybe 80 . (>>= readMaybe) <$> lookupEnv "COLUMNS"
pure (TerminalSize rows cols) pure (TerminalSize rows cols)
queryTerminalSize :: IO (Maybe TerminalSize) queryTerminalSize :: IO (Maybe TerminalSize)
@@ -415,7 +413,8 @@ queryTerminalSize = do
try $ try $
readCreateProcessWithExitCode readCreateProcessWithExitCode
(proc "sh" ["-c", "stty size </dev/tty"]) (proc "sh" ["-c", "stty size </dev/tty"])
"" :: IO (Either SomeException (ExitCode, String, String)) "" ::
IO (Either SomeException (ExitCode, String, String))
pure $ do pure $ do
(exitCode, stdoutText, _) <- either (const Nothing) Just result (exitCode, stdoutText, _) <- either (const Nothing) Just result
case exitCode of case exitCode of
@@ -580,10 +579,11 @@ startPreviewServer config watchSettings serverStatusRef
forkIO $ forkIO $
do do
result <- result <-
(try $ ( try $
Warp.runSettings settings $ Warp.runSettings settings $
staticApp $ staticApp $
previewSettings config (destinationDirectory config)) :: previewSettings config (destinationDirectory config)
) ::
IO (Either SomeException ()) IO (Either SomeException ())
case result of case result of
Left err -> writeIORef serverStatusRef (ServerFailed (show err)) Left err -> writeIORef serverStatusRef (ServerFailed (show err))
@@ -593,7 +593,8 @@ startPreviewServer config watchSettings serverStatusRef
settings = settings =
Warp.setBeforeMainLoop (writeIORef serverStatusRef ServerRunning) $ Warp.setBeforeMainLoop (writeIORef serverStatusRef ServerRunning) $
Warp.setPort (watchPort watchSettings) $ Warp.setPort (watchPort watchSettings) $
Warp.setHost (fromString (watchHost watchSettings)) $ Warp.setHost
(fromString (watchHost watchSettings))
Warp.defaultSettings Warp.defaultSettings
snapshotInputs :: FilePath -> IO FileSnapshot snapshotInputs :: FilePath -> IO FileSnapshot
@@ -625,8 +626,8 @@ trackedFilesIn root = do
if exists if exists
then do then do
entries <- listDirectory root entries <- listDirectory root
fmap concat $ fmap concat
traverse <$> traverse
( \name -> do ( \name -> do
let path = root </> name let path = root </> name
isDir <- doesDirectoryExist path isDir <- doesDirectoryExist path