mirror of
https://github.com/codedownio/sandwich.git
synced 2024-09-11 11:56:32 +03:00
Fixing more warnings
This commit is contained in:
parent
7d279edd78
commit
2079473acc
@ -1,14 +1,25 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
module Test.Sandwich.Formatters.Print.CallStacks where
|
||||
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import GHC.Stack
|
||||
import System.IO (Handle)
|
||||
import Test.Sandwich.Formatters.Print.Color
|
||||
import Test.Sandwich.Formatters.Print.Printing
|
||||
import Test.Sandwich.Formatters.Print.Types
|
||||
|
||||
|
||||
printCallStack :: (
|
||||
MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
|
||||
) => CallStack -> m ()
|
||||
printCallStack cs = forM_ (getCallStack cs) printCallStackLine
|
||||
|
||||
printCallStackLine :: (
|
||||
MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
|
||||
) => (String, SrcLoc) -> m ()
|
||||
printCallStackLine (f, (SrcLoc {..})) = do
|
||||
pic logFunctionColor f
|
||||
|
||||
|
@ -1,4 +1,5 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
module Test.Sandwich.Formatters.Print.Logs where
|
||||
|
||||
@ -30,6 +31,9 @@ printLogs runTreeLogs = do
|
||||
when (logEntryLevel entry >= logLevel) $ printLogEntry entry
|
||||
|
||||
|
||||
printLogEntry :: (
|
||||
MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
|
||||
) => LogEntry -> m ()
|
||||
printLogEntry (LogEntry {..}) = do
|
||||
pic logTimestampColor (show logEntryTime)
|
||||
|
||||
|
@ -7,6 +7,7 @@ module Test.Sandwich.Formatters.Print.PrintPretty (
|
||||
import Control.Monad
|
||||
import Control.Monad.IO.Class
|
||||
import Control.Monad.Reader
|
||||
import Data.Colour
|
||||
import qualified Data.List as L
|
||||
import System.IO
|
||||
import Test.Sandwich.Formatters.Print.Color
|
||||
@ -39,10 +40,10 @@ printPretty indentFirst (Rec name tuples) = do
|
||||
(if indentFirst then pic else pc) recordNameColor name
|
||||
pcn braceColor " {"
|
||||
withBumpIndent $
|
||||
forM_ tuples $ \(name, val) -> do
|
||||
pic fieldNameColor name
|
||||
forM_ tuples $ \(name', val) -> do
|
||||
pic fieldNameColor name'
|
||||
p " = "
|
||||
withBumpIndent' (L.length name + L.length (" = " :: String)) $ do
|
||||
withBumpIndent' (L.length name' + L.length (" = " :: String)) $ do
|
||||
printPretty False val
|
||||
p "\n"
|
||||
pic braceColor "}"
|
||||
@ -67,6 +68,9 @@ printPretty (getPrintFn -> f) (Neg s) = do
|
||||
printPretty False s
|
||||
|
||||
|
||||
printListWrappedIn :: (
|
||||
MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
|
||||
) => (String, String) -> Bool -> [Value] -> m ()
|
||||
printListWrappedIn (begin, end) (getPrintFn -> f) values | all isSingleLine values = do
|
||||
f listBracketColor begin
|
||||
sequence_ (L.intercalate [p ", "] [[printPretty False v] | v <- values])
|
||||
@ -80,5 +84,8 @@ printListWrappedIn (begin, end) (getPrintFn -> f) values = do
|
||||
p "\n"
|
||||
pic listBracketColor end
|
||||
|
||||
getPrintFn :: (
|
||||
MonadReader (PrintFormatter, Int, Handle) m, MonadIO m
|
||||
) => Bool -> Colour Float -> String -> m ()
|
||||
getPrintFn True = pic
|
||||
getPrintFn False = pc
|
||||
|
@ -24,11 +24,13 @@ isSingleLine (Quote s) = '\n' `L.notElem` s
|
||||
|
||||
isSingleLine _ = True
|
||||
|
||||
withBumpIndent :: MonadReader (PrintFormatter, Int, c) m => m b -> m b
|
||||
withBumpIndent action = do
|
||||
(PrintFormatter {..}, _, _) <- ask
|
||||
withBumpIndent' printFormatterIndentSize action
|
||||
|
||||
withBumpIndent' :: (MonadReader (a, Int, c) m) => Int -> m b -> m b
|
||||
withBumpIndent' n = local (\(pf, indent, h) -> (pf, indent + n, h))
|
||||
|
||||
|
||||
fst3 :: (a, b, c) -> a
|
||||
fst3 (x, _, _) = x
|
||||
|
@ -8,5 +8,6 @@ import Control.Monad
|
||||
import System.Process
|
||||
|
||||
-- | TODO: report exceptions here
|
||||
openFileExplorerFolderPortable :: String -> IO ()
|
||||
openFileExplorerFolderPortable folder = do
|
||||
void $ readCreateProcessWithExitCode (proc "xdg-open" [folder]) ""
|
||||
|
@ -1,3 +1,4 @@
|
||||
{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
|
||||
|
||||
module Test.Sandwich.Formatters.TerminalUI.Keys where
|
||||
|
||||
|
@ -29,7 +29,7 @@ updateGolden (fromMaybe defaultDirGoldenTest -> dir) = do
|
||||
putStrLnColor enableColor green "Done!"
|
||||
|
||||
where
|
||||
go enableColor dir = listDirectory dir >>= mapM_ (processEntry enableColor)
|
||||
go enableColor dir' = listDirectory dir' >>= mapM_ (processEntry enableColor)
|
||||
|
||||
processEntry enableColor (((dir ++ "/") ++) -> entryInDir) = do
|
||||
isDir <- doesDirectoryExist entryInDir
|
||||
@ -55,9 +55,11 @@ green = SetColor Foreground Dull Green
|
||||
red = SetColor Foreground Dull Red
|
||||
magenta = SetColor Foreground Dull Magenta
|
||||
|
||||
putStrColor :: EnableColor -> SGR -> String -> IO ()
|
||||
putStrColor EnableColor color s = bracket_ (setSGR [color]) (setSGR [Reset]) (putStr s)
|
||||
putStrColor DisableColor _ s = putStr s
|
||||
|
||||
putStrLnColor :: EnableColor -> SGR -> String -> IO ()
|
||||
putStrLnColor EnableColor color s = bracket_ (setSGR [color]) (setSGR [Reset]) (putStrLn s)
|
||||
putStrLnColor DisableColor _ s = putStrLn s
|
||||
|
||||
|
@ -19,6 +19,7 @@ data ShouldWarnOnParseError = WarnOnParseError | NoWarnOnParseError
|
||||
|
||||
-- | Use haskell-src-exts to determine if a give Haskell file has an exported main function
|
||||
-- Parse with all extensions enabled, which will hopefully parse anything
|
||||
fileHasMainFunction :: FilePath -> ShouldWarnOnParseError -> Q Bool
|
||||
fileHasMainFunction path shouldWarnOnParseError = runIO (parseFileWithExts [x | x@(EnableExtension _) <- knownExtensions] path) >>= \case
|
||||
x@(ParseFailed {}) -> do
|
||||
when (shouldWarnOnParseError == WarnOnParseError) $
|
||||
|
Loading…
Reference in New Issue
Block a user