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