    {-# LANGUAGE RankNTypes, ExistentialQuantification, DeriveDataTypeable,
        MultiParamTypeClasses, GeneralizedNewtypeDeriving, CPP #-}
    module Test.Tasty.Golden.Internal where

    import Control.DeepSeq
    import Control.Exception
    import Control.Monad (when)
    import Data.Typeable (Typeable)
    import Data.Proxy
    import Data.Int
    import Data.Char (toLower)
    import System.IO.Error (isDoesNotExistError)
    import Options.Applicative (metavar)
    import Test.Tasty.Providers
    import Test.Tasty.Options
    #if !MIN_VERSION_base(4,11,0)
    import Data.Monoid ((<>))
    #endif

    -- | See 'goldenTest' for explanation of the fields
    data Golden =
      forall a .
        Golden
          (IO a)
          (IO a)
          (a -> a -> IO (Maybe String))
          (a -> IO ())
          (IO ())
      deriving Typeable

    -- | This option, when set to 'True', specifies that we should run in the
    -- «accept tests» mode
    newtype AcceptTests = AcceptTests Bool
      deriving (AcceptTests -> AcceptTests -> Bool
    (AcceptTests -> AcceptTests -> Bool)
    -> (AcceptTests -> AcceptTests -> Bool) -> Eq AcceptTests
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: AcceptTests -> AcceptTests -> Bool
    == :: AcceptTests -> AcceptTests -> Bool
    $c/= :: AcceptTests -> AcceptTests -> Bool
    /= :: AcceptTests -> AcceptTests -> Bool
    Eq, Eq AcceptTests
    Eq AcceptTests =>
    (AcceptTests -> AcceptTests -> Ordering)
    -> (AcceptTests -> AcceptTests -> Bool)
    -> (AcceptTests -> AcceptTests -> Bool)
    -> (AcceptTests -> AcceptTests -> Bool)
    -> (AcceptTests -> AcceptTests -> Bool)
    -> (AcceptTests -> AcceptTests -> AcceptTests)
    -> (AcceptTests -> AcceptTests -> AcceptTests)
    -> Ord AcceptTests
    AcceptTests -> AcceptTests -> Bool
    AcceptTests -> AcceptTests -> Ordering
    AcceptTests -> AcceptTests -> AcceptTests
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: AcceptTests -> AcceptTests -> Ordering
    compare :: AcceptTests -> AcceptTests -> Ordering
    $c< :: AcceptTests -> AcceptTests -> Bool
    < :: AcceptTests -> AcceptTests -> Bool
    $c<= :: AcceptTests -> AcceptTests -> Bool
    <= :: AcceptTests -> AcceptTests -> Bool
    $c> :: AcceptTests -> AcceptTests -> Bool
    > :: AcceptTests -> AcceptTests -> Bool
    $c>= :: AcceptTests -> AcceptTests -> Bool
    >= :: AcceptTests -> AcceptTests -> Bool
    $cmax :: AcceptTests -> AcceptTests -> AcceptTests
    max :: AcceptTests -> AcceptTests -> AcceptTests
    $cmin :: AcceptTests -> AcceptTests -> AcceptTests
    min :: AcceptTests -> AcceptTests -> AcceptTests
    Ord, Typeable)
    instance IsOption AcceptTests where
      defaultValue :: AcceptTests
    defaultValue = Bool -> AcceptTests
    AcceptTests Bool
    False
      parseValue :: String -> Maybe AcceptTests
    parseValue = (Bool -> AcceptTests) -> Maybe Bool -> Maybe AcceptTests
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> AcceptTests
    AcceptTests (Maybe Bool -> Maybe AcceptTests)
    -> (String -> Maybe Bool) -> String -> Maybe AcceptTests
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Bool
    safeReadBool
      optionName :: Tagged AcceptTests String
    optionName = String -> Tagged AcceptTests String
    forall a. a -> Tagged AcceptTests a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "accept"
      optionHelp :: Tagged AcceptTests String
    optionHelp = String -> Tagged AcceptTests String
    forall a. a -> Tagged AcceptTests a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "Accept current results of golden tests"
      optionCLParser :: Parser AcceptTests
    optionCLParser = Maybe Char -> AcceptTests -> Parser AcceptTests
    forall v. IsOption v => Maybe Char -> v -> Parser v
    flagCLParser Maybe Char
    forall a. Maybe a
    Nothing (Bool -> AcceptTests
    AcceptTests Bool
    True)

    -- | This option, when set to 'True', specifies to error when a file does
    -- not exist, instead of creating a new file.
    newtype NoCreateFile = NoCreateFile Bool
      deriving (NoCreateFile -> NoCreateFile -> Bool
    (NoCreateFile -> NoCreateFile -> Bool)
    -> (NoCreateFile -> NoCreateFile -> Bool) -> Eq NoCreateFile
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: NoCreateFile -> NoCreateFile -> Bool
    == :: NoCreateFile -> NoCreateFile -> Bool
    $c/= :: NoCreateFile -> NoCreateFile -> Bool
    /= :: NoCreateFile -> NoCreateFile -> Bool
    Eq, Eq NoCreateFile
    Eq NoCreateFile =>
    (NoCreateFile -> NoCreateFile -> Ordering)
    -> (NoCreateFile -> NoCreateFile -> Bool)
    -> (NoCreateFile -> NoCreateFile -> Bool)
    -> (NoCreateFile -> NoCreateFile -> Bool)
    -> (NoCreateFile -> NoCreateFile -> Bool)
    -> (NoCreateFile -> NoCreateFile -> NoCreateFile)
    -> (NoCreateFile -> NoCreateFile -> NoCreateFile)
    -> Ord NoCreateFile
    NoCreateFile -> NoCreateFile -> Bool
    NoCreateFile -> NoCreateFile -> Ordering
    NoCreateFile -> NoCreateFile -> NoCreateFile
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: NoCreateFile -> NoCreateFile -> Ordering
    compare :: NoCreateFile -> NoCreateFile -> Ordering
    $c< :: NoCreateFile -> NoCreateFile -> Bool
    < :: NoCreateFile -> NoCreateFile -> Bool
    $c<= :: NoCreateFile -> NoCreateFile -> Bool
    <= :: NoCreateFile -> NoCreateFile -> Bool
    $c> :: NoCreateFile -> NoCreateFile -> Bool
    > :: NoCreateFile -> NoCreateFile -> Bool
    $c>= :: NoCreateFile -> NoCreateFile -> Bool
    >= :: NoCreateFile -> NoCreateFile -> Bool
    $cmax :: NoCreateFile -> NoCreateFile -> NoCreateFile
    max :: NoCreateFile -> NoCreateFile -> NoCreateFile
    $cmin :: NoCreateFile -> NoCreateFile -> NoCreateFile
    min :: NoCreateFile -> NoCreateFile -> NoCreateFile
    Ord, Typeable)
    instance IsOption NoCreateFile where
      defaultValue :: NoCreateFile
    defaultValue = Bool -> NoCreateFile
    NoCreateFile Bool
    False
      parseValue :: String -> Maybe NoCreateFile
    parseValue = (Bool -> NoCreateFile) -> Maybe Bool -> Maybe NoCreateFile
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Bool -> NoCreateFile
    NoCreateFile (Maybe Bool -> Maybe NoCreateFile)
    -> (String -> Maybe Bool) -> String -> Maybe NoCreateFile
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Bool
    safeReadBool
      optionName :: Tagged NoCreateFile String
    optionName = String -> Tagged NoCreateFile String
    forall a. a -> Tagged NoCreateFile a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "no-create"
      optionHelp :: Tagged NoCreateFile String
    optionHelp = String -> Tagged NoCreateFile String
    forall a. a -> Tagged NoCreateFile a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "Error when golden file does not exist"
      optionCLParser :: Parser NoCreateFile
    optionCLParser = Maybe Char -> NoCreateFile -> Parser NoCreateFile
    forall v. IsOption v => Maybe Char -> v -> Parser v
    flagCLParser Maybe Char
    forall a. Maybe a
    Nothing (Bool -> NoCreateFile
    NoCreateFile Bool
    True)

    -- | The size, in bytes, such that the (incorrect) test output is not
    -- displayed when it exceeds this size. Numeric underscores are accepted
    -- for readability.
    --
    -- The default value is 1000 (i.e. 1Kb).
    --
    -- @since 2.3.3
    newtype SizeCutoff = SizeCutoff { SizeCutoff -> Int64
    getSizeCutoff :: Int64 }
      deriving (SizeCutoff -> SizeCutoff -> Bool
    (SizeCutoff -> SizeCutoff -> Bool)
    -> (SizeCutoff -> SizeCutoff -> Bool) -> Eq SizeCutoff
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: SizeCutoff -> SizeCutoff -> Bool
    == :: SizeCutoff -> SizeCutoff -> Bool
    $c/= :: SizeCutoff -> SizeCutoff -> Bool
    /= :: SizeCutoff -> SizeCutoff -> Bool
    Eq, Eq SizeCutoff
    Eq SizeCutoff =>
    (SizeCutoff -> SizeCutoff -> Ordering)
    -> (SizeCutoff -> SizeCutoff -> Bool)
    -> (SizeCutoff -> SizeCutoff -> Bool)
    -> (SizeCutoff -> SizeCutoff -> Bool)
    -> (SizeCutoff -> SizeCutoff -> Bool)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> Ord SizeCutoff
    SizeCutoff -> SizeCutoff -> Bool
    SizeCutoff -> SizeCutoff -> Ordering
    SizeCutoff -> SizeCutoff -> SizeCutoff
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: SizeCutoff -> SizeCutoff -> Ordering
    compare :: SizeCutoff -> SizeCutoff -> Ordering
    $c< :: SizeCutoff -> SizeCutoff -> Bool
    < :: SizeCutoff -> SizeCutoff -> Bool
    $c<= :: SizeCutoff -> SizeCutoff -> Bool
    <= :: SizeCutoff -> SizeCutoff -> Bool
    $c> :: SizeCutoff -> SizeCutoff -> Bool
    > :: SizeCutoff -> SizeCutoff -> Bool
    $c>= :: SizeCutoff -> SizeCutoff -> Bool
    >= :: SizeCutoff -> SizeCutoff -> Bool
    $cmax :: SizeCutoff -> SizeCutoff -> SizeCutoff
    max :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $cmin :: SizeCutoff -> SizeCutoff -> SizeCutoff
    min :: SizeCutoff -> SizeCutoff -> SizeCutoff
    Ord, Typeable, Integer -> SizeCutoff
    SizeCutoff -> SizeCutoff
    SizeCutoff -> SizeCutoff -> SizeCutoff
    (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff)
    -> (Integer -> SizeCutoff)
    -> Num SizeCutoff
    forall a.
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (a -> a)
    -> (Integer -> a)
    -> Num a
    $c+ :: SizeCutoff -> SizeCutoff -> SizeCutoff
    + :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $c- :: SizeCutoff -> SizeCutoff -> SizeCutoff
    - :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $c* :: SizeCutoff -> SizeCutoff -> SizeCutoff
    * :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $cnegate :: SizeCutoff -> SizeCutoff
    negate :: SizeCutoff -> SizeCutoff
    $cabs :: SizeCutoff -> SizeCutoff
    abs :: SizeCutoff -> SizeCutoff
    $csignum :: SizeCutoff -> SizeCutoff
    signum :: SizeCutoff -> SizeCutoff
    $cfromInteger :: Integer -> SizeCutoff
    fromInteger :: Integer -> SizeCutoff
    Num, Num SizeCutoff
    Ord SizeCutoff
    (Num SizeCutoff, Ord SizeCutoff) =>
    (SizeCutoff -> Rational) -> Real SizeCutoff
    SizeCutoff -> Rational
    forall a. (Num a, Ord a) => (a -> Rational) -> Real a
    $ctoRational :: SizeCutoff -> Rational
    toRational :: SizeCutoff -> Rational
    Real, Int -> SizeCutoff
    SizeCutoff -> Int
    SizeCutoff -> [SizeCutoff]
    SizeCutoff -> SizeCutoff
    SizeCutoff -> SizeCutoff -> [SizeCutoff]
    SizeCutoff -> SizeCutoff -> SizeCutoff -> [SizeCutoff]
    (SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff)
    -> (Int -> SizeCutoff)
    -> (SizeCutoff -> Int)
    -> (SizeCutoff -> [SizeCutoff])
    -> (SizeCutoff -> SizeCutoff -> [SizeCutoff])
    -> (SizeCutoff -> SizeCutoff -> [SizeCutoff])
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff -> [SizeCutoff])
    -> Enum SizeCutoff
    forall a.
    (a -> a)
    -> (a -> a)
    -> (Int -> a)
    -> (a -> Int)
    -> (a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> [a])
    -> (a -> a -> a -> [a])
    -> Enum a
    $csucc :: SizeCutoff -> SizeCutoff
    succ :: SizeCutoff -> SizeCutoff
    $cpred :: SizeCutoff -> SizeCutoff
    pred :: SizeCutoff -> SizeCutoff
    $ctoEnum :: Int -> SizeCutoff
    toEnum :: Int -> SizeCutoff
    $cfromEnum :: SizeCutoff -> Int
    fromEnum :: SizeCutoff -> Int
    $cenumFrom :: SizeCutoff -> [SizeCutoff]
    enumFrom :: SizeCutoff -> [SizeCutoff]
    $cenumFromThen :: SizeCutoff -> SizeCutoff -> [SizeCutoff]
    enumFromThen :: SizeCutoff -> SizeCutoff -> [SizeCutoff]
    $cenumFromTo :: SizeCutoff -> SizeCutoff -> [SizeCutoff]
    enumFromTo :: SizeCutoff -> SizeCutoff -> [SizeCutoff]
    $cenumFromThenTo :: SizeCutoff -> SizeCutoff -> SizeCutoff -> [SizeCutoff]
    enumFromThenTo :: SizeCutoff -> SizeCutoff -> SizeCutoff -> [SizeCutoff]
    Enum, Enum SizeCutoff
    Real SizeCutoff
    (Real SizeCutoff, Enum SizeCutoff) =>
    (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> SizeCutoff)
    -> (SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff))
    -> (SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff))
    -> (SizeCutoff -> Integer)
    -> Integral SizeCutoff
    SizeCutoff -> Integer
    SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff)
    SizeCutoff -> SizeCutoff -> SizeCutoff
    forall a.
    (Real a, Enum a) =>
    (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> (a -> a -> (a, a))
    -> (a -> a -> (a, a))
    -> (a -> Integer)
    -> Integral a
    $cquot :: SizeCutoff -> SizeCutoff -> SizeCutoff
    quot :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $crem :: SizeCutoff -> SizeCutoff -> SizeCutoff
    rem :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $cdiv :: SizeCutoff -> SizeCutoff -> SizeCutoff
    div :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $cmod :: SizeCutoff -> SizeCutoff -> SizeCutoff
    mod :: SizeCutoff -> SizeCutoff -> SizeCutoff
    $cquotRem :: SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff)
    quotRem :: SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff)
    $cdivMod :: SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff)
    divMod :: SizeCutoff -> SizeCutoff -> (SizeCutoff, SizeCutoff)
    $ctoInteger :: SizeCutoff -> Integer
    toInteger :: SizeCutoff -> Integer
    Integral)
    instance IsOption SizeCutoff where
      defaultValue :: SizeCutoff
    defaultValue = SizeCutoff
    1000
      showDefaultValue :: SizeCutoff -> Maybe String
    showDefaultValue = String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String)
    -> (SizeCutoff -> String) -> SizeCutoff -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int64 -> String
    forall a. Show a => a -> String
    show (Int64 -> String) -> (SizeCutoff -> Int64) -> SizeCutoff -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . SizeCutoff -> Int64
    getSizeCutoff
      parseValue :: String -> Maybe SizeCutoff
    parseValue = (Int64 -> SizeCutoff) -> Maybe Int64 -> Maybe SizeCutoff
    forall a b. (a -> b) -> Maybe a -> Maybe b
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    fmap Int64 -> SizeCutoff
    SizeCutoff (Maybe Int64 -> Maybe SizeCutoff)
    -> (String -> Maybe Int64) -> String -> Maybe SizeCutoff
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Int64
    forall a. Read a => String -> Maybe a
    safeRead (String -> Maybe Int64)
    -> (String -> String) -> String -> Maybe Int64
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    filter (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '_')
      optionName :: Tagged SizeCutoff String
    optionName = String -> Tagged SizeCutoff String
    forall a. a -> Tagged SizeCutoff a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "size-cutoff"
      optionHelp :: Tagged SizeCutoff String
    optionHelp = String -> Tagged SizeCutoff String
    forall a. a -> Tagged SizeCutoff a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "hide golden test output if it's larger than n bytes"
      optionCLParser :: Parser SizeCutoff
    optionCLParser = Mod OptionFields SizeCutoff -> Parser SizeCutoff
    forall v. IsOption v => Mod OptionFields v -> Parser v
    mkOptionCLParser (Mod OptionFields SizeCutoff -> Parser SizeCutoff)
    -> Mod OptionFields SizeCutoff -> Parser SizeCutoff
    forall a b. (a -> b) -> a -> b
    $ String -> Mod OptionFields SizeCutoff
    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
    metavar String
    "n"

    -- | When / whether to delete the test output file,
    -- when there is a golden file
    --
    -- @since 2.3.4
    data DeleteOutputFile
      = Never  -- ^ Never delete the output file (default)
      | OnPass -- ^ Delete the output file if the test passes
      | Always -- ^ Always delete the output file. (May not be commonly used,
               --   but provided for completeness.)
      deriving (DeleteOutputFile -> DeleteOutputFile -> Bool
    (DeleteOutputFile -> DeleteOutputFile -> Bool)
    -> (DeleteOutputFile -> DeleteOutputFile -> Bool)
    -> Eq DeleteOutputFile
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DeleteOutputFile -> DeleteOutputFile -> Bool
    == :: DeleteOutputFile -> DeleteOutputFile -> Bool
    $c/= :: DeleteOutputFile -> DeleteOutputFile -> Bool
    /= :: DeleteOutputFile -> DeleteOutputFile -> Bool
    Eq, Eq DeleteOutputFile
    Eq DeleteOutputFile =>
    (DeleteOutputFile -> DeleteOutputFile -> Ordering)
    -> (DeleteOutputFile -> DeleteOutputFile -> Bool)
    -> (DeleteOutputFile -> DeleteOutputFile -> Bool)
    -> (DeleteOutputFile -> DeleteOutputFile -> Bool)
    -> (DeleteOutputFile -> DeleteOutputFile -> Bool)
    -> (DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile)
    -> (DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile)
    -> Ord DeleteOutputFile
    DeleteOutputFile -> DeleteOutputFile -> Bool
    DeleteOutputFile -> DeleteOutputFile -> Ordering
    DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile
    forall a.
    Eq a =>
    (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: DeleteOutputFile -> DeleteOutputFile -> Ordering
    compare :: DeleteOutputFile -> DeleteOutputFile -> Ordering
    $c< :: DeleteOutputFile -> DeleteOutputFile -> Bool
    < :: DeleteOutputFile -> DeleteOutputFile -> Bool
    $c<= :: DeleteOutputFile -> DeleteOutputFile -> Bool
    <= :: DeleteOutputFile -> DeleteOutputFile -> Bool
    $c> :: DeleteOutputFile -> DeleteOutputFile -> Bool
    > :: DeleteOutputFile -> DeleteOutputFile -> Bool
    $c>= :: DeleteOutputFile -> DeleteOutputFile -> Bool
    >= :: DeleteOutputFile -> DeleteOutputFile -> Bool
    $cmax :: DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile
    max :: DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile
    $cmin :: DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile
    min :: DeleteOutputFile -> DeleteOutputFile -> DeleteOutputFile
    Ord, Typeable, Int -> DeleteOutputFile -> String -> String
    [DeleteOutputFile] -> String -> String
    DeleteOutputFile -> String
    (Int -> DeleteOutputFile -> String -> String)
    -> (DeleteOutputFile -> String)
    -> ([DeleteOutputFile] -> String -> String)
    -> Show DeleteOutputFile
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DeleteOutputFile -> String -> String
    showsPrec :: Int -> DeleteOutputFile -> String -> String
    $cshow :: DeleteOutputFile -> String
    show :: DeleteOutputFile -> String
    $cshowList :: [DeleteOutputFile] -> String -> String
    showList :: [DeleteOutputFile] -> String -> String
    Show)

    -- | This option controls when / whether the test output file is deleted
    -- For example, it may be convenient to delete the output file when a test
    -- passes, since it will be the same as the golden file.
    --
    -- It does nothing if
    --
    -- * running the test or accessing an existing golden value threw an exception.
    --
    -- * there is no golden file for the test
    instance IsOption DeleteOutputFile where
      defaultValue :: DeleteOutputFile
    defaultValue = DeleteOutputFile
    Never
      parseValue :: String -> Maybe DeleteOutputFile
    parseValue = String -> Maybe DeleteOutputFile
    parseDeleteOutputFile
      optionName :: Tagged DeleteOutputFile String
    optionName = String -> Tagged DeleteOutputFile String
    forall a. a -> Tagged DeleteOutputFile a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "delete-output"
      optionHelp :: Tagged DeleteOutputFile String
    optionHelp = String -> Tagged DeleteOutputFile String
    forall a. a -> Tagged DeleteOutputFile a
    forall (m :: * -> *) a. Monad m => a -> m a
    return String
    "If there is a golden file, when to delete output files"
      showDefaultValue :: DeleteOutputFile -> Maybe String
    showDefaultValue =  String -> Maybe String
    forall a. a -> Maybe a
    Just (String -> Maybe String)
    -> (DeleteOutputFile -> String) -> DeleteOutputFile -> Maybe String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . DeleteOutputFile -> String
    displayDeleteOutputFile
      optionCLParser :: Parser DeleteOutputFile
    optionCLParser = Mod OptionFields DeleteOutputFile -> Parser DeleteOutputFile
    forall v. IsOption v => Mod OptionFields v -> Parser v
    mkOptionCLParser (Mod OptionFields DeleteOutputFile -> Parser DeleteOutputFile)
    -> Mod OptionFields DeleteOutputFile -> Parser DeleteOutputFile
    forall a b. (a -> b) -> a -> b
    $ String -> Mod OptionFields DeleteOutputFile
    forall (f :: * -> *) a. HasMetavar f => String -> Mod f a
    metavar String
    "never|onpass|always"

    parseDeleteOutputFile :: String -> Maybe DeleteOutputFile
    parseDeleteOutputFile :: String -> Maybe DeleteOutputFile
    parseDeleteOutputFile String
    s =
      case (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower String
    s of
        String
    "never"  -> DeleteOutputFile -> Maybe DeleteOutputFile
    forall a. a -> Maybe a
    Just DeleteOutputFile
    Never
        String
    "onpass" -> DeleteOutputFile -> Maybe DeleteOutputFile
    forall a. a -> Maybe a
    Just DeleteOutputFile
    OnPass
        String
    "always" -> DeleteOutputFile -> Maybe DeleteOutputFile
    forall a. a -> Maybe a
    Just DeleteOutputFile
    Always
        String
    _        -> Maybe DeleteOutputFile
    forall a. Maybe a
    Nothing

    displayDeleteOutputFile :: DeleteOutputFile -> String
    displayDeleteOutputFile :: DeleteOutputFile -> String
    displayDeleteOutputFile DeleteOutputFile
    dof = (Char -> Char) -> String -> String
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower (DeleteOutputFile -> String
    forall a. Show a => a -> String
    show DeleteOutputFile
    dof)

    instance IsTest Golden where
      run :: OptionSet -> Golden -> (Progress -> IO ()) -> IO Result
    run OptionSet
    opts Golden
    golden Progress -> IO ()
    _ = Golden -> OptionSet -> IO Result
    runGolden Golden
    golden OptionSet
    opts
      testOptions :: Tagged Golden [OptionDescription]
    testOptions =
        [OptionDescription] -> Tagged Golden [OptionDescription]
    forall a. a -> Tagged Golden a
    forall (m :: * -> *) a. Monad m => a -> m a
    return
          [ Proxy AcceptTests -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Option (Proxy AcceptTests
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy AcceptTests)
          , Proxy NoCreateFile -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Option (Proxy NoCreateFile
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy NoCreateFile)
          , Proxy SizeCutoff -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Option (Proxy SizeCutoff
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy SizeCutoff)
          , Proxy DeleteOutputFile -> OptionDescription
    forall v. IsOption v => Proxy v -> OptionDescription
    Option (Proxy DeleteOutputFile
    forall {k} (t :: k). Proxy t
    Proxy :: Proxy DeleteOutputFile)
          ]

    runGolden :: Golden -> OptionSet -> IO Result
    runGolden :: Golden -> OptionSet -> IO Result
    runGolden (Golden IO a
    getGolden IO a
    getTested a -> a -> IO (Maybe String)
    cmp a -> IO ()
    update IO ()
    delete) OptionSet
    opts = do

        mbNew <- IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO a
    getTested

        case mbNew of
          Left SomeException
    e -> do
            Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testFailed (String -> Result) -> String -> Result
    forall a b. (a -> b) -> a -> b
    $ SomeException -> String
    forall a. Show a => a -> String
    show (SomeException
    e :: SomeException)
          Right a
    new -> do

            mbRef <- IO a -> IO (Either SomeException a)
    forall e a. Exception e => IO a -> IO (Either e a)
    try IO a
    getGolden

            case mbRef of
              Left SomeException
    e
                | Just IOError
    e' <- SomeException -> Maybe IOError
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e, IOError -> Bool
    isDoesNotExistError IOError
    e' ->
                  if Bool
    noCreate
                    then
                      -- Don't ever delete the output file in this case, as there is
                      -- no duplicate golden file
                      Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testFailed String
    "Golden file does not exist; --no-create flag specified"
                    else do
                      a -> IO ()
    update a
    new
                      Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DeleteOutputFile
    delOut DeleteOutputFile -> [DeleteOutputFile] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [DeleteOutputFile
    Always, DeleteOutputFile
    OnPass]) IO ()
    delete
                      Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testPassed String
    "Golden file did not exist; created"

                | Just (AsyncException
    _ :: AsyncException) <- SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e -> SomeException -> IO Result
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    e
                | Just (IOError
    _ :: IOError) <- SomeException -> Maybe IOError
    forall e. Exception e => SomeException -> Maybe e
    fromException SomeException
    e -> SomeException -> IO Result
    forall e a. (HasCallStack, Exception e) => e -> IO a
    throwIO SomeException
    e

                | Bool
    otherwise -> do
                    -- Other types of exceptions may be due to failing to decode the
                    -- golden file. In that case, it makes sense to replace a broken
                    -- golden file with the current version.
                    a -> IO ()
    update a
    new
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DeleteOutputFile
    delOut DeleteOutputFile -> [DeleteOutputFile] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [DeleteOutputFile
    Always, DeleteOutputFile
    OnPass]) IO ()
    delete
                    Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testPassed (String -> Result) -> String -> Result
    forall a b. (a -> b) -> a -> b
    $ String
    "Accepted the new version. Was failing with exception:\n" String -> String -> String
    forall a. [a] -> [a] -> [a]
    ++ SomeException -> String
    forall a. Show a => a -> String
    show SomeException
    e

              Right a
    ref -> do

                result <- a -> a -> IO (Maybe String)
    cmp a
    ref a
    new

                case result of
                  Just String
    _reason | Bool
    accept -> do
                    -- test failed; accept the new version
                    a -> IO ()
    update a
    new
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DeleteOutputFile
    delOut DeleteOutputFile -> [DeleteOutputFile] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [DeleteOutputFile
    Always, DeleteOutputFile
    OnPass]) IO ()
    delete
                    Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testPassed String
    "Accepted the new version"

                  Just String
    reason -> do
                    -- Make sure that the result is fully evaluated and doesn't depend
                    -- on yet un-read lazy input
                    () -> IO ()
    forall a. a -> IO a
    evaluate (() -> IO ()) -> (String -> ()) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> ()
    forall a. NFData a => a -> ()
    rnf (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    reason
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DeleteOutputFile
    delOut DeleteOutputFile -> DeleteOutputFile -> Bool
    forall a. Eq a => a -> a -> Bool
    == DeleteOutputFile
    Always) IO ()
    delete
                    Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testFailed String
    reason

                  Maybe String
    Nothing -> do
                    Bool -> IO () -> IO ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when (DeleteOutputFile
    delOut DeleteOutputFile -> [DeleteOutputFile] -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` [DeleteOutputFile
    Always, DeleteOutputFile
    OnPass]) IO ()
    delete
                    Result -> IO Result
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Result -> IO Result) -> Result -> IO Result
    forall a b. (a -> b) -> a -> b
    $ String -> Result
    testPassed String
    ""
      where
        AcceptTests Bool
    accept = OptionSet -> AcceptTests
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    opts
        NoCreateFile Bool
    noCreate = OptionSet -> NoCreateFile
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    opts
        delOut :: DeleteOutputFile
    delOut = OptionSet -> DeleteOutputFile
    forall v. IsOption v => OptionSet -> v
    lookupOption OptionSet
    opts