{-# LANGUAGE ViewPatterns #-}
{-# LANGUAGE LambdaCase #-}
-- |
-- Stability: stable
module Test.Hspec.Api.Format.V1 (
  Format
, FormatConfig(..)
, Event(..)
, Progress
, Path
, Location(..)
, Seconds(..)
, Item(..)
, Result(..)
, FailureReason(..)
, monadic

-- * Register a formatter
, registerFormatter
, useFormatter
, liftFormatter

-- * Re-exports
, SpecWith
, Config
, modifyConfig
) where

import qualified Test.Hspec.Core.Format as Latest
import qualified Test.Hspec.Api.Format.V2 as V2
import           Test.Hspec.Api.Format.V2 hiding (
    registerFormatter
  , useFormatter
  , liftFormatter
  , FormatConfig(..)
  , Item(..)
  , FailureReason(..)
  , Result(..)
  , Event(..)
  , Format
  , monadic
  )

import           Control.Monad.IO.Class
import           Test.Hspec.Api.Format.V1.Internal

-- |
-- Make a formatter available for use with @--format@.
registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
registerFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
registerFormatter = (String, FormatConfig -> IO Format) -> Config -> Config
V2.registerFormatter ((String, FormatConfig -> IO Format) -> Config -> Config)
-> ((String, FormatConfig -> IO Format)
    -> (String, FormatConfig -> IO Format))
-> (String, FormatConfig -> IO Format)
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
liftFormatterToV2

-- |
-- Make a formatter available for use with @--format@ and use it by default.
useFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
useFormatter :: (String, FormatConfig -> IO Format) -> Config -> Config
useFormatter = (String, FormatConfig -> IO Format) -> Config -> Config
V2.useFormatter ((String, FormatConfig -> IO Format) -> Config -> Config)
-> ((String, FormatConfig -> IO Format)
    -> (String, FormatConfig -> IO Format))
-> (String, FormatConfig -> IO Format)
-> Config
-> Config
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
liftFormatterToV2

-- | Make a formatter compatible with types from "Test.Hspec.Core.Format".
liftFormatter :: (String, FormatConfig -> IO Format) -> (String, Latest.FormatConfig -> IO Latest.Format)
liftFormatter :: (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
liftFormatter = (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
V2.liftFormatter ((String, FormatConfig -> IO Format)
 -> (String, FormatConfig -> IO Format))
-> ((String, FormatConfig -> IO Format)
    -> (String, FormatConfig -> IO Format))
-> (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
liftFormatterToV2

liftFormatterToV2 :: (String, FormatConfig -> IO Format) -> (String, V2.FormatConfig -> IO V2.Format)
liftFormatterToV2 :: (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
liftFormatterToV2 = ((FormatConfig -> IO Format) -> FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
-> (String, FormatConfig -> IO Format)
forall a b. (a -> b) -> (String, a) -> (String, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (FormatConfig -> IO Format) -> FormatConfig -> IO Format
lift
  where
    lift :: (FormatConfig -> IO Format) -> V2.FormatConfig -> IO V2.Format
    lift :: (FormatConfig -> IO Format) -> FormatConfig -> IO Format
lift FormatConfig -> IO Format
format = (Format -> Format) -> IO Format -> IO Format
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Format -> Format
liftFormat (IO Format -> IO Format)
-> (FormatConfig -> IO Format) -> FormatConfig -> IO Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatConfig -> IO Format
format (FormatConfig -> IO Format)
-> (FormatConfig -> FormatConfig) -> FormatConfig -> IO Format
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FormatConfig -> FormatConfig
unliftFormatConfig

data FormatConfig = FormatConfig {
  FormatConfig -> Bool
formatConfigUseColor :: Bool
, FormatConfig -> Bool
formatConfigReportProgress :: Bool
, FormatConfig -> Bool
formatConfigOutputUnicode :: Bool
, FormatConfig -> Bool
formatConfigUseDiff :: Bool
, FormatConfig -> Maybe Int
formatConfigDiffContext :: Maybe Int
, FormatConfig -> Maybe (String -> String -> IO ())
formatConfigExternalDiff :: Maybe (String -> String -> IO ())
, FormatConfig -> Bool
formatConfigPrettyPrint :: Bool -- ^ Deprecated: use `formatConfigPrettyPrintFunction` instead
, FormatConfig -> Maybe (String -> String -> (String, String))
formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String))
, FormatConfig -> Bool
formatConfigPrintTimes :: Bool
, FormatConfig -> Bool
formatConfigHtmlOutput :: Bool
, FormatConfig -> Bool
formatConfigPrintCpuTime :: Bool
, FormatConfig -> Integer
formatConfigUsedSeed :: Integer
, FormatConfig -> Int
formatConfigExpectedTotalCount :: Int
}

unliftFormatConfig :: V2.FormatConfig -> FormatConfig
unliftFormatConfig :: FormatConfig -> FormatConfig
unliftFormatConfig FormatConfig
config = FormatConfig {
  formatConfigUseColor :: Bool
formatConfigUseColor = FormatConfig -> Bool
V2.formatConfigUseColor FormatConfig
config
, formatConfigReportProgress :: Bool
formatConfigReportProgress = FormatConfig -> Bool
V2.formatConfigReportProgress FormatConfig
config
, formatConfigOutputUnicode :: Bool
formatConfigOutputUnicode = FormatConfig -> Bool
V2.formatConfigOutputUnicode FormatConfig
config
, formatConfigUseDiff :: Bool
formatConfigUseDiff = FormatConfig -> Bool
V2.formatConfigUseDiff FormatConfig
config
, formatConfigDiffContext :: Maybe Int
formatConfigDiffContext = FormatConfig -> Maybe Int
V2.formatConfigDiffContext FormatConfig
config
, formatConfigExternalDiff :: Maybe (String -> String -> IO ())
formatConfigExternalDiff = FormatConfig -> Maybe (String -> String -> IO ())
V2.formatConfigExternalDiff FormatConfig
config
, formatConfigPrettyPrint :: Bool
formatConfigPrettyPrint = Bool
-> ((String -> String -> (String, String)) -> Bool)
-> Maybe (String -> String -> (String, String))
-> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False (Bool -> (String -> String -> (String, String)) -> Bool
forall a b. a -> b -> a
const Bool
True) (Maybe (String -> String -> (String, String)) -> Bool)
-> Maybe (String -> String -> (String, String)) -> Bool
forall a b. (a -> b) -> a -> b
$ FormatConfig -> Maybe (String -> String -> (String, String))
V2.formatConfigPrettyPrintFunction FormatConfig
config
, formatConfigPrettyPrintFunction :: Maybe (String -> String -> (String, String))
formatConfigPrettyPrintFunction = FormatConfig -> Maybe (String -> String -> (String, String))
V2.formatConfigPrettyPrintFunction FormatConfig
config
, formatConfigPrintTimes :: Bool
formatConfigPrintTimes = FormatConfig -> Bool
V2.formatConfigPrintTimes FormatConfig
config
, formatConfigHtmlOutput :: Bool
formatConfigHtmlOutput = FormatConfig -> Bool
V2.formatConfigHtmlOutput FormatConfig
config
, formatConfigPrintCpuTime :: Bool
formatConfigPrintCpuTime = FormatConfig -> Bool
V2.formatConfigPrintCpuTime FormatConfig
config
, formatConfigUsedSeed :: Integer
formatConfigUsedSeed = FormatConfig -> Integer
V2.formatConfigUsedSeed FormatConfig
config
, formatConfigExpectedTotalCount :: Int
formatConfigExpectedTotalCount = FormatConfig -> Int
V2.formatConfigExpectedTotalCount FormatConfig
config
}

type Format = Event -> IO ()

liftFormat :: Format -> V2.Format
liftFormat :: Format -> Format
liftFormat Format
format Event
event = Format
format (Event -> Event
unliftEvent Event
event)

unliftFormat :: V2.Format -> Format
unliftFormat :: Format -> Format
unliftFormat Format
format Event
event = Format
format (Event -> Event
liftEvent Event
event)

data Event =
    Started
  | GroupStarted Path
  | GroupDone Path
  | Progress Path Progress
  | ItemStarted Path
  | ItemDone Path Item
  | Done [(Path, Item)]
  deriving Int -> Event -> ShowS
[Event] -> ShowS
Event -> String
(Int -> Event -> ShowS)
-> (Event -> String) -> ([Event] -> ShowS) -> Show Event
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Event -> ShowS
showsPrec :: Int -> Event -> ShowS
$cshow :: Event -> String
show :: Event -> String
$cshowList :: [Event] -> ShowS
showList :: [Event] -> ShowS
Show

liftEvent :: Event -> V2.Event
liftEvent :: Event -> Event
liftEvent = \ case
  Event
Started -> Event
V2.Started
  GroupStarted Path
path -> Path -> Event
V2.GroupStarted Path
path
  GroupDone Path
path -> Path -> Event
V2.GroupDone Path
path
  Progress Path
path Progress
progress -> Path -> Progress -> Event
V2.Progress Path
path Progress
progress
  ItemStarted Path
path -> Path -> Event
V2.ItemStarted Path
path
  ItemDone Path
path Item
item -> Path -> Item -> Event
V2.ItemDone Path
path (Item -> Item
liftItem Item
item)
  Done [(Path, Item)]
result -> [(Path, Item)] -> Event
V2.Done (((Path, Item) -> (Path, Item)) -> [(Path, Item)] -> [(Path, Item)]
forall a b. (a -> b) -> [a] -> [b]
map ((Item -> Item) -> (Path, Item) -> (Path, Item)
forall a b. (a -> b) -> (Path, a) -> (Path, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Item -> Item
liftItem) [(Path, Item)]
result)

unliftEvent :: V2.Event -> Event
unliftEvent :: Event -> Event
unliftEvent = \ case
  Event
V2.Started -> Event
Started
  V2.GroupStarted Path
path -> Path -> Event
GroupStarted Path
path
  V2.GroupDone Path
path -> Path -> Event
GroupDone Path
path
  V2.Progress Path
path Progress
progress -> Path -> Progress -> Event
Progress Path
path Progress
progress
  V2.ItemStarted Path
path -> Path -> Event
ItemStarted Path
path
  V2.ItemDone Path
path Item
item -> Path -> Item -> Event
ItemDone Path
path (Item -> Item
unliftItem Item
item)
  V2.Done [(Path, Item)]
result -> [(Path, Item)] -> Event
Done (((Path, Item) -> (Path, Item)) -> [(Path, Item)] -> [(Path, Item)]
forall a b. (a -> b) -> [a] -> [b]
map ((Item -> Item) -> (Path, Item) -> (Path, Item)
forall a b. (a -> b) -> (Path, a) -> (Path, b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Item -> Item
unliftItem) [(Path, Item)]
result)

monadic :: MonadIO m => (m () -> IO ()) -> (Event -> m ()) -> IO Format
monadic :: forall (m :: * -> *).
MonadIO m =>
(m () -> IO ()) -> (Event -> m ()) -> IO Format
monadic m () -> IO ()
run Event -> m ()
format = Format -> Format
unliftFormat (Format -> Format) -> IO Format -> IO Format
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (m () -> IO ()) -> (Event -> m ()) -> IO Format
forall (m :: * -> *).
MonadIO m =>
(m () -> IO ()) -> (Event -> m ()) -> IO Format
V2.monadic m () -> IO ()
run (Event -> m ()
format (Event -> m ()) -> (Event -> Event) -> Event -> m ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Event -> Event
unliftEvent)