mirror of
https://github.com/codedownio/sandwich.git
synced 2024-10-27 04:59:50 +03:00
Lots of conditionals for windows support
This commit is contained in:
parent
b850dee78f
commit
04db27989b
@ -1,5 +1,6 @@
|
||||
{-# LANGUAGE TypeOperators #-}
|
||||
{-# LANGUAGE DataKinds #-}
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Main where
|
||||
|
||||
|
@ -4,7 +4,7 @@ cabal-version: 1.12
|
||||
--
|
||||
-- see: https://github.com/sol/hpack
|
||||
--
|
||||
-- hash: 1750b981aa8aedcd566f479c9aeab1e7c6e333a341cfa12d40b3170ad8ebe3cb
|
||||
-- hash: 8974a5333af3c2b92169042d67a8398f766cb9f5fbe40088ffba8de1686b427b
|
||||
|
||||
name: sandwich
|
||||
version: 0.1.0.11
|
||||
@ -56,17 +56,6 @@ library
|
||||
Test.Sandwich.Formatters.Print.PrintPretty
|
||||
Test.Sandwich.Formatters.Print.Types
|
||||
Test.Sandwich.Formatters.Print.Util
|
||||
Test.Sandwich.Formatters.TerminalUI.AttrMap
|
||||
Test.Sandwich.Formatters.TerminalUI.CrossPlatform
|
||||
Test.Sandwich.Formatters.TerminalUI.Draw
|
||||
Test.Sandwich.Formatters.TerminalUI.Draw.ColorProgressBar
|
||||
Test.Sandwich.Formatters.TerminalUI.Draw.ToBrickWidget
|
||||
Test.Sandwich.Formatters.TerminalUI.Draw.TopBox
|
||||
Test.Sandwich.Formatters.TerminalUI.Draw.Util
|
||||
Test.Sandwich.Formatters.TerminalUI.Filter
|
||||
Test.Sandwich.Formatters.TerminalUI.Keys
|
||||
Test.Sandwich.Formatters.TerminalUI.OpenInEditor
|
||||
Test.Sandwich.Formatters.TerminalUI.Types
|
||||
Test.Sandwich.Golden.Update
|
||||
Test.Sandwich.Internal.Formatters
|
||||
Test.Sandwich.Internal.Running
|
||||
@ -80,6 +69,7 @@ library
|
||||
Test.Sandwich.ParallelN
|
||||
Test.Sandwich.RunTree
|
||||
Test.Sandwich.Shutdown
|
||||
Test.Sandwich.Signals
|
||||
Test.Sandwich.TestTimer
|
||||
Test.Sandwich.TH.HasMainFunction
|
||||
Test.Sandwich.TH.ModuleMap
|
||||
|
@ -83,7 +83,6 @@ import Options.Applicative
|
||||
import qualified Options.Applicative as OA
|
||||
import System.Environment
|
||||
import System.FilePath
|
||||
import System.Posix.Signals
|
||||
import Test.Sandwich.ArgParsing
|
||||
import Test.Sandwich.Contexts
|
||||
import Test.Sandwich.Expectations
|
||||
@ -100,6 +99,7 @@ import Test.Sandwich.Options
|
||||
import Test.Sandwich.ParallelN
|
||||
import Test.Sandwich.RunTree
|
||||
import Test.Sandwich.Shutdown
|
||||
import Test.Sandwich.Signals
|
||||
import Test.Sandwich.TH
|
||||
import Test.Sandwich.TestTimer
|
||||
import Test.Sandwich.Types.ArgParsing
|
||||
@ -190,12 +190,12 @@ runSandwich' maybeCommandLineOptions options spec' = do
|
||||
|
||||
exitReasonRef <- newIORef NormalExit
|
||||
|
||||
let shutdown = do
|
||||
putStrLn "Shutting down..."
|
||||
let shutdown info = do
|
||||
putStrLn [i|Shutting down due to #{info}...|]
|
||||
writeIORef exitReasonRef InterruptExit
|
||||
forM_ rts cancelNode
|
||||
|
||||
_ <- installHandler sigINT (Catch shutdown) Nothing
|
||||
_ <- installHandler sigINT shutdown
|
||||
|
||||
-- Wait for the tree to finish
|
||||
mapM_ waitForTree rts
|
||||
|
@ -113,7 +113,9 @@ formatter :: Parser FormatterType
|
||||
formatter =
|
||||
flag' Print (long "print" <> help "Print to stdout")
|
||||
<|> flag' PrintFailures (long "print-failures" <> help "Print failures only to stdout")
|
||||
#ifndef mingw32_HOST_OS
|
||||
<|> flag' TUI (long "tui" <> help "Open terminal UI app")
|
||||
#endif
|
||||
<|> flag' Silent (long "silent" <> help "Run silently (print the run root only)")
|
||||
<|> flag Auto Auto (long "auto" <> help "Automatically decide which formatter to use")
|
||||
|
||||
@ -263,18 +265,27 @@ addOptionsFromArgs baseOptions (CommandLineOptions {..}) = do
|
||||
isMainFormatter :: SomeFormatter -> Bool
|
||||
isMainFormatter (SomeFormatter x) = case cast x of
|
||||
Just (_ :: PrintFormatter) -> True
|
||||
#ifdef mingw32_HOST_OS
|
||||
Nothing -> False
|
||||
#else
|
||||
Nothing -> case cast x of
|
||||
Just (_ :: TerminalUIFormatter) -> True
|
||||
Nothing -> False
|
||||
#endif
|
||||
|
||||
setVisibilityThreshold Nothing x = x
|
||||
setVisibilityThreshold (Just v) x@(SomeFormatter f) = case cast f of
|
||||
Just pf@(PrintFormatter {}) -> SomeFormatter (pf { printFormatterVisibilityThreshold = v })
|
||||
Nothing -> case cast f of
|
||||
#ifdef mingw32_HOST_OS
|
||||
Just (frf :: FailureReportFormatter) -> SomeFormatter (frf { failureReportVisibilityThreshold = v })
|
||||
Nothing -> x
|
||||
#else
|
||||
Just tuif@(TerminalUIFormatter {}) -> SomeFormatter (tuif { terminalUIVisibilityThreshold = v })
|
||||
Nothing -> case cast f of
|
||||
Just (frf :: FailureReportFormatter) -> SomeFormatter (frf { failureReportVisibilityThreshold = v })
|
||||
Nothing -> x
|
||||
#endif
|
||||
|
||||
isMarkdownSummaryFormatter :: SomeFormatter -> Bool
|
||||
isMarkdownSummaryFormatter (SomeFormatter x) = case cast x of
|
||||
|
@ -1,3 +1,5 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
-- | Pretty printing failure reasons
|
||||
|
||||
|
||||
@ -22,8 +24,10 @@ import Text.Show.Pretty as P
|
||||
printFailureReason :: FailureReason -> ReaderT (PrintFormatter, Int, Handle) IO ()
|
||||
printFailureReason (Reason _ s) = do
|
||||
printShowBoxPrettyWithTitleString "Reason: " s
|
||||
#ifndef mingw32_HOST_OS
|
||||
printFailureReason (RawImage _ fallback _image) = do
|
||||
forM_ (L.lines fallback) pin
|
||||
#endif
|
||||
printFailureReason (ChildrenFailed _ n) = do
|
||||
picn midWhite ([i|#{n} #{if n == 1 then ("child" :: String) else "children"} failed|] :: String)
|
||||
printFailureReason (ExpectedButGot _ seb1 seb2) = do
|
||||
|
43
sandwich/src/Test/Sandwich/Signals.hs
Normal file
43
sandwich/src/Test/Sandwich/Signals.hs
Normal file
@ -0,0 +1,43 @@
|
||||
{-# LANGUAGE CPP #-}
|
||||
|
||||
module Test.Sandwich.Signals (
|
||||
installHandler
|
||||
, sigINT
|
||||
, sigTERM
|
||||
) where
|
||||
|
||||
import Foreign.C.Types
|
||||
|
||||
#ifdef mingw32_HOST_OS
|
||||
import Control.Exception.Base (assert)
|
||||
import Foreign
|
||||
#else
|
||||
import Control.Monad
|
||||
import qualified System.Posix.Signals as Posix
|
||||
#endif
|
||||
|
||||
|
||||
type Signal = CInt
|
||||
|
||||
type Handler = Signal -> IO ()
|
||||
|
||||
sigINT :: Signal
|
||||
sigINT = 2
|
||||
|
||||
sigTERM :: Signal
|
||||
sigTERM = 15
|
||||
|
||||
installHandler :: Signal -> Handler -> IO ()
|
||||
#ifdef mingw32_HOST_OS
|
||||
foreign import ccall "wrapper"
|
||||
genHandler:: Handler -> IO (FunPtr Handler)
|
||||
|
||||
foreign import ccall safe "signal.h signal"
|
||||
install:: Signal -> FunPtr Handler -> IO Signal
|
||||
|
||||
installHandler signal handler = do
|
||||
result <- install signal =<< genHandler handler
|
||||
return $ assert (result == 0) ()
|
||||
#else
|
||||
installHandler signal handler = void $ Posix.installHandler signal (Posix.CatchInfo (handler . Posix.siginfoSignal)) Nothing
|
||||
#endif
|
@ -11,23 +11,27 @@ import GHC.Int
|
||||
|
||||
data FormatterType =
|
||||
Print
|
||||
| PrintFailures
|
||||
| Auto
|
||||
| Silent
|
||||
#ifndef mingw32_HOST_OS
|
||||
| TUI
|
||||
#endif
|
||||
| PrintFailures
|
||||
| Auto
|
||||
| Silent
|
||||
|
||||
instance Show FormatterType where
|
||||
show Print = "print"
|
||||
show PrintFailures = "print-failures"
|
||||
#ifndef mingw32_HOST_OS
|
||||
show TUI = "tui"
|
||||
#endif
|
||||
show Auto = "auto"
|
||||
show Silent = "silent"
|
||||
|
||||
instance Read FormatterType where
|
||||
readsPrec _ "print" = [(Print, "")]
|
||||
#ifndef mingw32_HOST_OS
|
||||
readsPrec _ "tui" = [(TUI, "")]
|
||||
#endif
|
||||
readsPrec _ "auto" = [(Auto, "")]
|
||||
readsPrec _ "silent" = [(Silent, "")]
|
||||
readsPrec _ _ = []
|
||||
|
@ -31,13 +31,17 @@ import Data.Maybe
|
||||
import Data.String.Interpolate
|
||||
import GHC.Stack
|
||||
import GHC.TypeLits
|
||||
import Graphics.Vty.Image (Image)
|
||||
import Safe
|
||||
|
||||
#ifndef mingw32_HOST_OS
|
||||
import Graphics.Vty.Image (Image)
|
||||
#endif
|
||||
|
||||
#if !MIN_VERSION_base(4,13,0)
|
||||
import Control.Monad.Fail
|
||||
#endif
|
||||
|
||||
|
||||
-- * ExampleM monad
|
||||
|
||||
newtype ExampleT context m a = ExampleT { unExampleT :: ReaderT context (LoggingT m) a }
|
||||
@ -98,9 +102,12 @@ data FailureReason = Reason { failureCallStack :: Maybe CallStack
|
||||
, failureAsyncException :: SomeAsyncExceptionWithEq }
|
||||
| ChildrenFailed { failureCallStack :: Maybe CallStack
|
||||
, failureNumChildren :: Int }
|
||||
#ifndef mingw32_HOST_OS
|
||||
| RawImage { failureCallStack :: Maybe CallStack
|
||||
, failureFallback :: String
|
||||
, failureRawImage :: Image }
|
||||
#endif
|
||||
|
||||
deriving (Show, Typeable, Eq)
|
||||
|
||||
instance Exception FailureReason
|
||||
|
Loading…
Reference in New Issue
Block a user