{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE DeriveFoldable #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE DeriveTraversable #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
module Goldplate
( main
, Options (..)
, defaultOptions
, mainWith
, Spec (..)
, Assert (..)
) where
import Control.Applicative (optional, (<|>))
import qualified Control.Concurrent.Async as Async
import qualified Control.Concurrent.MVar as MVar
import Control.Exception (Exception, finally, throwIO)
import Control.Monad (forM, forM_, mzero, unless, when)
import qualified Data.Aeson as A
import qualified Data.Aeson.Encode.Pretty as Aeson.Pretty
import Data.Algorithm.Diff
import Data.Algorithm.DiffOutput
import qualified Data.ByteString as B
import qualified Data.ByteString.Lazy as BL
import qualified Data.Foldable as F
import Data.Function (on)
import qualified Data.HashMap.Strict as HMS
import qualified Data.IORef as IORef
import qualified Data.List as List
import Data.Maybe (catMaybes)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Version (showVersion)
import qualified Options.Applicative as OA
import Paths_goldplate (version)
import qualified System.Directory as Dir
import System.Environment (getEnvironment)
import System.Exit (ExitCode (..), exitWith)
import qualified System.FilePath as FP
import qualified System.FilePath.Glob as Glob
import qualified System.IO as IO
import qualified System.Process as Process
import qualified Text.Regex.PCRE.Simple as Pcre
import Text.Splice
data Multiple a = Multiple [a] | Single a
deriving ((forall m. Monoid m => Multiple m -> m)
-> (forall m a. Monoid m => (a -> m) -> Multiple a -> m)
-> (forall m a. Monoid m => (a -> m) -> Multiple a -> m)
-> (forall a b. (a -> b -> b) -> b -> Multiple a -> b)
-> (forall a b. (a -> b -> b) -> b -> Multiple a -> b)
-> (forall b a. (b -> a -> b) -> b -> Multiple a -> b)
-> (forall b a. (b -> a -> b) -> b -> Multiple a -> b)
-> (forall a. (a -> a -> a) -> Multiple a -> a)
-> (forall a. (a -> a -> a) -> Multiple a -> a)
-> (forall a. Multiple a -> [a])
-> (forall a. Multiple a -> Bool)
-> (forall a. Multiple a -> Int)
-> (forall a. Eq a => a -> Multiple a -> Bool)
-> (forall a. Ord a => Multiple a -> a)
-> (forall a. Ord a => Multiple a -> a)
-> (forall a. Num a => Multiple a -> a)
-> (forall a. Num a => Multiple a -> a)
-> Foldable Multiple
forall a. Eq a => a -> Multiple a -> Bool
forall a. Num a => Multiple a -> a
forall a. Ord a => Multiple a -> a
forall m. Monoid m => Multiple m -> m
forall a. Multiple a -> Bool
forall a. Multiple a -> Int
forall a. Multiple a -> [a]
forall a. (a -> a -> a) -> Multiple a -> a
forall m a. Monoid m => (a -> m) -> Multiple a -> m
forall b a. (b -> a -> b) -> b -> Multiple a -> b
forall a b. (a -> b -> b) -> b -> Multiple a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Multiple m -> m
fold :: forall m. Monoid m => Multiple m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Multiple a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Multiple a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Multiple a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Multiple a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Multiple a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Multiple a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Multiple a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Multiple a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Multiple a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Multiple a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Multiple a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Multiple a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Multiple a -> a
foldr1 :: forall a. (a -> a -> a) -> Multiple a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Multiple a -> a
foldl1 :: forall a. (a -> a -> a) -> Multiple a -> a
$ctoList :: forall a. Multiple a -> [a]
toList :: forall a. Multiple a -> [a]
$cnull :: forall a. Multiple a -> Bool
null :: forall a. Multiple a -> Bool
$clength :: forall a. Multiple a -> Int
length :: forall a. Multiple a -> Int
$celem :: forall a. Eq a => a -> Multiple a -> Bool
elem :: forall a. Eq a => a -> Multiple a -> Bool
$cmaximum :: forall a. Ord a => Multiple a -> a
maximum :: forall a. Ord a => Multiple a -> a
$cminimum :: forall a. Ord a => Multiple a -> a
minimum :: forall a. Ord a => Multiple a -> a
$csum :: forall a. Num a => Multiple a -> a
sum :: forall a. Num a => Multiple a -> a
$cproduct :: forall a. Num a => Multiple a -> a
product :: forall a. Num a => Multiple a -> a
Foldable, (forall a b. (a -> b) -> Multiple a -> Multiple b)
-> (forall a b. a -> Multiple b -> Multiple a) -> Functor Multiple
forall a b. a -> Multiple b -> Multiple a
forall a b. (a -> b) -> Multiple a -> Multiple b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Multiple a -> Multiple b
fmap :: forall a b. (a -> b) -> Multiple a -> Multiple b
$c<$ :: forall a b. a -> Multiple b -> Multiple a
<$ :: forall a b. a -> Multiple b -> Multiple a
Functor, Functor Multiple
Foldable Multiple
(Functor Multiple, Foldable Multiple) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Multiple a -> f (Multiple b))
-> (forall (f :: * -> *) a.
Applicative f =>
Multiple (f a) -> f (Multiple a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Multiple a -> m (Multiple b))
-> (forall (m :: * -> *) a.
Monad m =>
Multiple (m a) -> m (Multiple a))
-> Traversable Multiple
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Multiple (m a) -> m (Multiple a)
forall (f :: * -> *) a.
Applicative f =>
Multiple (f a) -> f (Multiple a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Multiple a -> m (Multiple b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Multiple a -> f (Multiple b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Multiple a -> f (Multiple b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Multiple a -> f (Multiple b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Multiple (f a) -> f (Multiple a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Multiple (f a) -> f (Multiple a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Multiple a -> m (Multiple b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Multiple a -> m (Multiple b)
$csequence :: forall (m :: * -> *) a. Monad m => Multiple (m a) -> m (Multiple a)
sequence :: forall (m :: * -> *) a. Monad m => Multiple (m a) -> m (Multiple a)
Traversable)
instance A.FromJSON a => A.FromJSON (Multiple a) where
parseJSON :: Value -> Parser (Multiple a)
parseJSON Value
v = ([a] -> Multiple a
forall a. [a] -> Multiple a
Multiple ([a] -> Multiple a) -> Parser [a] -> Parser (Multiple a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser [a]
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v) Parser (Multiple a) -> Parser (Multiple a) -> Parser (Multiple a)
forall a. Parser a -> Parser a -> Parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (a -> Multiple a
forall a. a -> Multiple a
Single (a -> Multiple a) -> Parser a -> Parser (Multiple a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Parser a
forall a. FromJSON a => Value -> Parser a
A.parseJSON Value
v)
multipleToList :: Multiple a -> [a]
multipleToList :: forall a. Multiple a -> [a]
multipleToList = Multiple a -> [a]
forall a. Multiple a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList
data Spec a = Spec
{ forall a. Spec a -> Maybe a
specInputFiles :: !(Maybe a)
, forall a. Spec a -> a
specCommand :: !a
, forall a. Spec a -> [a]
specArguments :: ![a]
, forall a. Spec a -> Maybe (Multiple a)
specStdin :: !(Maybe (Multiple a))
, forall a. Spec a -> [(a, a)]
specEnv :: ![(a, a)]
, forall a. Spec a -> Maybe a
specWorkDir :: !(Maybe a)
, forall a. Spec a -> [Assert a]
specAsserts :: ![Assert a]
} deriving ((forall m. Monoid m => Spec m -> m)
-> (forall m a. Monoid m => (a -> m) -> Spec a -> m)
-> (forall m a. Monoid m => (a -> m) -> Spec a -> m)
-> (forall a b. (a -> b -> b) -> b -> Spec a -> b)
-> (forall a b. (a -> b -> b) -> b -> Spec a -> b)
-> (forall b a. (b -> a -> b) -> b -> Spec a -> b)
-> (forall b a. (b -> a -> b) -> b -> Spec a -> b)
-> (forall a. (a -> a -> a) -> Spec a -> a)
-> (forall a. (a -> a -> a) -> Spec a -> a)
-> (forall a. Spec a -> [a])
-> (forall a. Spec a -> Bool)
-> (forall a. Spec a -> Int)
-> (forall a. Eq a => a -> Spec a -> Bool)
-> (forall a. Ord a => Spec a -> a)
-> (forall a. Ord a => Spec a -> a)
-> (forall a. Num a => Spec a -> a)
-> (forall a. Num a => Spec a -> a)
-> Foldable Spec
forall a. Eq a => a -> Spec a -> Bool
forall a. Num a => Spec a -> a
forall a. Ord a => Spec a -> a
forall m. Monoid m => Spec m -> m
forall a. Spec a -> Bool
forall a. Spec a -> Int
forall a. Spec a -> [a]
forall a. (a -> a -> a) -> Spec a -> a
forall m a. Monoid m => (a -> m) -> Spec a -> m
forall b a. (b -> a -> b) -> b -> Spec a -> b
forall a b. (a -> b -> b) -> b -> Spec a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Spec m -> m
fold :: forall m. Monoid m => Spec m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Spec a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Spec a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Spec a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Spec a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Spec a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Spec a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Spec a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Spec a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Spec a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Spec a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Spec a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Spec a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Spec a -> a
foldr1 :: forall a. (a -> a -> a) -> Spec a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Spec a -> a
foldl1 :: forall a. (a -> a -> a) -> Spec a -> a
$ctoList :: forall a. Spec a -> [a]
toList :: forall a. Spec a -> [a]
$cnull :: forall a. Spec a -> Bool
null :: forall a. Spec a -> Bool
$clength :: forall a. Spec a -> Int
length :: forall a. Spec a -> Int
$celem :: forall a. Eq a => a -> Spec a -> Bool
elem :: forall a. Eq a => a -> Spec a -> Bool
$cmaximum :: forall a. Ord a => Spec a -> a
maximum :: forall a. Ord a => Spec a -> a
$cminimum :: forall a. Ord a => Spec a -> a
minimum :: forall a. Ord a => Spec a -> a
$csum :: forall a. Num a => Spec a -> a
sum :: forall a. Num a => Spec a -> a
$cproduct :: forall a. Num a => Spec a -> a
product :: forall a. Num a => Spec a -> a
Foldable, (forall a b. (a -> b) -> Spec a -> Spec b)
-> (forall a b. a -> Spec b -> Spec a) -> Functor Spec
forall a b. a -> Spec b -> Spec a
forall a b. (a -> b) -> Spec a -> Spec b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Spec a -> Spec b
fmap :: forall a b. (a -> b) -> Spec a -> Spec b
$c<$ :: forall a b. a -> Spec b -> Spec a
<$ :: forall a b. a -> Spec b -> Spec a
Functor, Functor Spec
Foldable Spec
(Functor Spec, Foldable Spec) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spec a -> f (Spec b))
-> (forall (f :: * -> *) a.
Applicative f =>
Spec (f a) -> f (Spec a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spec a -> m (Spec b))
-> (forall (m :: * -> *) a. Monad m => Spec (m a) -> m (Spec a))
-> Traversable Spec
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Spec (m a) -> m (Spec a)
forall (f :: * -> *) a. Applicative f => Spec (f a) -> f (Spec a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spec a -> m (Spec b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spec a -> f (Spec b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spec a -> f (Spec b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spec a -> f (Spec b)
$csequenceA :: forall (f :: * -> *) a. Applicative f => Spec (f a) -> f (Spec a)
sequenceA :: forall (f :: * -> *) a. Applicative f => Spec (f a) -> f (Spec a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spec a -> m (Spec b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Spec a -> m (Spec b)
$csequence :: forall (m :: * -> *) a. Monad m => Spec (m a) -> m (Spec a)
sequence :: forall (m :: * -> *) a. Monad m => Spec (m a) -> m (Spec a)
Traversable)
instance A.FromJSON (Spec String) where
parseJSON :: Value -> Parser (Spec FilePath)
parseJSON = FilePath
-> (Object -> Parser (Spec FilePath))
-> Value
-> Parser (Spec FilePath)
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON Spec" ((Object -> Parser (Spec FilePath))
-> Value -> Parser (Spec FilePath))
-> (Object -> Parser (Spec FilePath))
-> Value
-> Parser (Spec FilePath)
forall a b. (a -> b) -> a -> b
$ \Object
o -> Maybe FilePath
-> FilePath
-> [FilePath]
-> Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath
forall a.
Maybe a
-> a
-> [a]
-> Maybe (Multiple a)
-> [(a, a)]
-> Maybe a
-> [Assert a]
-> Spec a
Spec
(Maybe FilePath
-> FilePath
-> [FilePath]
-> Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
-> Parser (Maybe FilePath)
-> Parser
(FilePath
-> [FilePath]
-> Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe FilePath)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"input_files"
Parser
(FilePath
-> [FilePath]
-> Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
-> Parser FilePath
-> Parser
([FilePath]
-> Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser FilePath
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"command"
Parser
([FilePath]
-> Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
-> Parser [FilePath]
-> Parser
(Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe [FilePath])
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"arguments" Parser (Maybe [FilePath]) -> [FilePath] -> Parser [FilePath]
forall a. Parser (Maybe a) -> a -> Parser a
A..!= []
Parser
(Maybe (Multiple FilePath)
-> [(FilePath, FilePath)]
-> Maybe FilePath
-> [Assert FilePath]
-> Spec FilePath)
-> Parser (Maybe (Multiple FilePath))
-> Parser
([(FilePath, FilePath)]
-> Maybe FilePath -> [Assert FilePath] -> Spec FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe (Multiple FilePath))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"stdin"
Parser
([(FilePath, FilePath)]
-> Maybe FilePath -> [Assert FilePath] -> Spec FilePath)
-> Parser [(FilePath, FilePath)]
-> Parser (Maybe FilePath -> [Assert FilePath] -> Spec FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ([(FilePath, FilePath)]
-> (HashMap FilePath FilePath -> [(FilePath, FilePath)])
-> Maybe (HashMap FilePath FilePath)
-> [(FilePath, FilePath)]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] HashMap FilePath FilePath -> [(FilePath, FilePath)]
forall k v. HashMap k v -> [(k, v)]
HMS.toList (Maybe (HashMap FilePath FilePath) -> [(FilePath, FilePath)])
-> Parser (Maybe (HashMap FilePath FilePath))
-> Parser [(FilePath, FilePath)]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (HashMap FilePath FilePath))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"environment")
Parser (Maybe FilePath -> [Assert FilePath] -> Spec FilePath)
-> Parser (Maybe FilePath)
-> Parser ([Assert FilePath] -> Spec FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe FilePath)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"working_directory"
Parser ([Assert FilePath] -> Spec FilePath)
-> Parser [Assert FilePath] -> Parser (Spec FilePath)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser [Assert FilePath]
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"asserts"
type PostProcess = [PostProcessStep]
data PostProcessStep
= PrettifyJsonStep
| ReplaceStep !Pcre.Regex !T.Text
instance A.FromJSON PostProcessStep where
parseJSON :: Value -> Parser PostProcessStep
parseJSON = \case
A.String Text
"prettify_json" -> PostProcessStep -> Parser PostProcessStep
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PostProcessStep
PrettifyJsonStep
A.Object Object
o -> Regex -> Text -> PostProcessStep
ReplaceStep
(Regex -> Text -> PostProcessStep)
-> Parser Regex -> Parser (Text -> PostProcessStep)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (do
Text
p <- Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"pattern"
(FilePath -> Parser Regex)
-> (Regex -> Parser Regex) -> Either FilePath Regex -> Parser Regex
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (FilePath -> Parser Regex
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser Regex)
-> (FilePath -> FilePath) -> FilePath -> Parser Regex
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
forall a. Show a => a -> FilePath
show) Regex -> Parser Regex
forall a. a -> Parser a
forall (m :: * -> *) a. Monad m => a -> m a
return (CompileOptions -> ExecOptions -> Text -> Either FilePath Regex
Pcre.compile CompileOptions
copts ExecOptions
eopts Text
p))
Parser (Text -> PostProcessStep)
-> Parser Text -> Parser PostProcessStep
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser Text
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"replacement"
Value
_ -> Parser PostProcessStep
forall a. Parser a
forall (m :: * -> *) a. MonadPlus m => m a
mzero
where
copts :: CompileOptions
copts = CompileOptions
Pcre.optionUtf8 CompileOptions -> CompileOptions -> CompileOptions
forall a. Semigroup a => a -> a -> a
<> CompileOptions
Pcre.optionMultiline
eopts :: ExecOptions
eopts = ExecOptions
forall a. Monoid a => a
mempty
postProcess :: PostProcess -> B.ByteString -> B.ByteString
postProcess :: [PostProcessStep] -> ByteString -> ByteString
postProcess [PostProcessStep]
ps ByteString
bs0 = (ByteString -> PostProcessStep -> ByteString)
-> ByteString -> [PostProcessStep] -> ByteString
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
List.foldl' ((PostProcessStep -> ByteString -> ByteString)
-> ByteString -> PostProcessStep -> ByteString
forall a b c. (a -> b -> c) -> b -> a -> c
flip PostProcessStep -> ByteString -> ByteString
postProcessStep) ByteString
bs0 [PostProcessStep]
ps
postProcessStep :: PostProcessStep -> B.ByteString -> B.ByteString
postProcessStep :: PostProcessStep -> ByteString -> ByteString
postProcessStep PostProcessStep
PrettifyJsonStep ByteString
bs = ByteString -> (Value -> ByteString) -> Maybe Value -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
bs
(LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (Value -> LazyByteString) -> Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> Value -> LazyByteString
forall a. ToJSON a => Config -> a -> LazyByteString
Aeson.Pretty.encodePretty' Config
prettyConfig)
(ByteString -> Maybe Value
forall a. FromJSON a => ByteString -> Maybe a
A.decodeStrict ByteString
bs :: Maybe A.Value)
where
prettyConfig :: Config
prettyConfig = Config
Aeson.Pretty.defConfig
{ Aeson.Pretty.confIndent = (Aeson.Pretty.Spaces 2)
, Aeson.Pretty.confCompare = compare
}
postProcessStep (ReplaceStep Regex
regex Text
replacement) ByteString
bs =
(FilePath -> ByteString)
-> (Text -> ByteString) -> Either FilePath Text -> ByteString
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (ByteString -> FilePath -> ByteString
forall a b. a -> b -> a
const ByteString
bs) Text -> ByteString
T.encodeUtf8 (Either FilePath Text -> ByteString)
-> (Text -> Either FilePath Text) -> Text -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
Regex -> Text -> Text -> Either FilePath Text
Pcre.replaceAll Regex
regex Text
replacement (Text -> ByteString) -> Text -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Text
T.decodeUtf8 ByteString
bs
data Assert a
= ExitCodeAssert !Int
| StdoutAssert
{ forall a. Assert a -> a
stdoutFilePath :: !a
, forall a. Assert a -> [PostProcessStep]
stdoutPostProcess :: !PostProcess
}
| StderrAssert
{ forall a. Assert a -> a
stderrFilePath :: !a
, forall a. Assert a -> [PostProcessStep]
stderrPostProcess :: !PostProcess
}
| CreatedFileAssert
{ forall a. Assert a -> a
createdFilePath :: !a
, forall a. Assert a -> Maybe a
createdFileContents :: !(Maybe a)
, forall a. Assert a -> [PostProcessStep]
createdFilePostProcess :: !PostProcess
}
| CreatedDirectoryAssert
{ forall a. Assert a -> a
createdDirectoryPath :: !a
}
deriving ((forall m. Monoid m => Assert m -> m)
-> (forall m a. Monoid m => (a -> m) -> Assert a -> m)
-> (forall m a. Monoid m => (a -> m) -> Assert a -> m)
-> (forall a b. (a -> b -> b) -> b -> Assert a -> b)
-> (forall a b. (a -> b -> b) -> b -> Assert a -> b)
-> (forall b a. (b -> a -> b) -> b -> Assert a -> b)
-> (forall b a. (b -> a -> b) -> b -> Assert a -> b)
-> (forall a. (a -> a -> a) -> Assert a -> a)
-> (forall a. (a -> a -> a) -> Assert a -> a)
-> (forall a. Assert a -> [a])
-> (forall a. Assert a -> Bool)
-> (forall a. Assert a -> Int)
-> (forall a. Eq a => a -> Assert a -> Bool)
-> (forall a. Ord a => Assert a -> a)
-> (forall a. Ord a => Assert a -> a)
-> (forall a. Num a => Assert a -> a)
-> (forall a. Num a => Assert a -> a)
-> Foldable Assert
forall a. Eq a => a -> Assert a -> Bool
forall a. Num a => Assert a -> a
forall a. Ord a => Assert a -> a
forall m. Monoid m => Assert m -> m
forall a. Assert a -> Bool
forall a. Assert a -> Int
forall a. Assert a -> [a]
forall a. (a -> a -> a) -> Assert a -> a
forall m a. Monoid m => (a -> m) -> Assert a -> m
forall b a. (b -> a -> b) -> b -> Assert a -> b
forall a b. (a -> b -> b) -> b -> Assert a -> b
forall (t :: * -> *).
(forall m. Monoid m => t m -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall m a. Monoid m => (a -> m) -> t a -> m)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall a b. (a -> b -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall b a. (b -> a -> b) -> b -> t a -> b)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. (a -> a -> a) -> t a -> a)
-> (forall a. t a -> [a])
-> (forall a. t a -> Bool)
-> (forall a. t a -> Int)
-> (forall a. Eq a => a -> t a -> Bool)
-> (forall a. Ord a => t a -> a)
-> (forall a. Ord a => t a -> a)
-> (forall a. Num a => t a -> a)
-> (forall a. Num a => t a -> a)
-> Foldable t
$cfold :: forall m. Monoid m => Assert m -> m
fold :: forall m. Monoid m => Assert m -> m
$cfoldMap :: forall m a. Monoid m => (a -> m) -> Assert a -> m
foldMap :: forall m a. Monoid m => (a -> m) -> Assert a -> m
$cfoldMap' :: forall m a. Monoid m => (a -> m) -> Assert a -> m
foldMap' :: forall m a. Monoid m => (a -> m) -> Assert a -> m
$cfoldr :: forall a b. (a -> b -> b) -> b -> Assert a -> b
foldr :: forall a b. (a -> b -> b) -> b -> Assert a -> b
$cfoldr' :: forall a b. (a -> b -> b) -> b -> Assert a -> b
foldr' :: forall a b. (a -> b -> b) -> b -> Assert a -> b
$cfoldl :: forall b a. (b -> a -> b) -> b -> Assert a -> b
foldl :: forall b a. (b -> a -> b) -> b -> Assert a -> b
$cfoldl' :: forall b a. (b -> a -> b) -> b -> Assert a -> b
foldl' :: forall b a. (b -> a -> b) -> b -> Assert a -> b
$cfoldr1 :: forall a. (a -> a -> a) -> Assert a -> a
foldr1 :: forall a. (a -> a -> a) -> Assert a -> a
$cfoldl1 :: forall a. (a -> a -> a) -> Assert a -> a
foldl1 :: forall a. (a -> a -> a) -> Assert a -> a
$ctoList :: forall a. Assert a -> [a]
toList :: forall a. Assert a -> [a]
$cnull :: forall a. Assert a -> Bool
null :: forall a. Assert a -> Bool
$clength :: forall a. Assert a -> Int
length :: forall a. Assert a -> Int
$celem :: forall a. Eq a => a -> Assert a -> Bool
elem :: forall a. Eq a => a -> Assert a -> Bool
$cmaximum :: forall a. Ord a => Assert a -> a
maximum :: forall a. Ord a => Assert a -> a
$cminimum :: forall a. Ord a => Assert a -> a
minimum :: forall a. Ord a => Assert a -> a
$csum :: forall a. Num a => Assert a -> a
sum :: forall a. Num a => Assert a -> a
$cproduct :: forall a. Num a => Assert a -> a
product :: forall a. Num a => Assert a -> a
Foldable, (forall a b. (a -> b) -> Assert a -> Assert b)
-> (forall a b. a -> Assert b -> Assert a) -> Functor Assert
forall a b. a -> Assert b -> Assert a
forall a b. (a -> b) -> Assert a -> Assert b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Assert a -> Assert b
fmap :: forall a b. (a -> b) -> Assert a -> Assert b
$c<$ :: forall a b. a -> Assert b -> Assert a
<$ :: forall a b. a -> Assert b -> Assert a
Functor, Functor Assert
Foldable Assert
(Functor Assert, Foldable Assert) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Assert a -> f (Assert b))
-> (forall (f :: * -> *) a.
Applicative f =>
Assert (f a) -> f (Assert a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Assert a -> m (Assert b))
-> (forall (m :: * -> *) a.
Monad m =>
Assert (m a) -> m (Assert a))
-> Traversable Assert
forall (t :: * -> *).
(Functor t, Foldable t) =>
(forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> t a -> f (t b))
-> (forall (f :: * -> *) a. Applicative f => t (f a) -> f (t a))
-> (forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> t a -> m (t b))
-> (forall (m :: * -> *) a. Monad m => t (m a) -> m (t a))
-> Traversable t
forall (m :: * -> *) a. Monad m => Assert (m a) -> m (Assert a)
forall (f :: * -> *) a.
Applicative f =>
Assert (f a) -> f (Assert a)
forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Assert a -> m (Assert b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Assert a -> f (Assert b)
$ctraverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Assert a -> f (Assert b)
traverse :: forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Assert a -> f (Assert b)
$csequenceA :: forall (f :: * -> *) a.
Applicative f =>
Assert (f a) -> f (Assert a)
sequenceA :: forall (f :: * -> *) a.
Applicative f =>
Assert (f a) -> f (Assert a)
$cmapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Assert a -> m (Assert b)
mapM :: forall (m :: * -> *) a b.
Monad m =>
(a -> m b) -> Assert a -> m (Assert b)
$csequence :: forall (m :: * -> *) a. Monad m => Assert (m a) -> m (Assert a)
sequence :: forall (m :: * -> *) a. Monad m => Assert (m a) -> m (Assert a)
Traversable)
instance A.FromJSON a => A.FromJSON (Assert a) where
parseJSON :: Value -> Parser (Assert a)
parseJSON = FilePath
-> (Object -> Parser (Assert a)) -> Value -> Parser (Assert a)
forall a. FilePath -> (Object -> Parser a) -> Value -> Parser a
A.withObject FilePath
"FromJSON Assert" ((Object -> Parser (Assert a)) -> Value -> Parser (Assert a))
-> (Object -> Parser (Assert a)) -> Value -> Parser (Assert a)
forall a b. (a -> b) -> a -> b
$ \Object
o -> do
[Maybe (Assert a)]
options <- [Parser (Maybe (Assert a))] -> Parser [Maybe (Assert a)]
forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
forall (f :: * -> *) a. Applicative f => [f a] -> f [a]
sequenceA ([Parser (Maybe (Assert a))] -> Parser [Maybe (Assert a)])
-> [Parser (Maybe (Assert a))] -> Parser [Maybe (Assert a)]
forall a b. (a -> b) -> a -> b
$ (Parser (Assert a) -> Parser (Maybe (Assert a)))
-> [Parser (Assert a)] -> [Parser (Maybe (Assert a))]
forall a b. (a -> b) -> [a] -> [b]
map Parser (Assert a) -> Parser (Maybe (Assert a))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional
[ Int -> Assert a
forall a. Int -> Assert a
ExitCodeAssert (Int -> Assert a) -> Parser Int -> Parser (Assert a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser Int
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"exit_code"
, a -> [PostProcessStep] -> Assert a
forall a. a -> [PostProcessStep] -> Assert a
StdoutAssert (a -> [PostProcessStep] -> Assert a)
-> Parser a -> Parser ([PostProcessStep] -> Assert a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"stdout" Parser ([PostProcessStep] -> Assert a)
-> Parser [PostProcessStep] -> Parser (Assert a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser [PostProcessStep]
forall {a}. FromJSON a => Object -> Parser [a]
pp Object
o
, a -> [PostProcessStep] -> Assert a
forall a. a -> [PostProcessStep] -> Assert a
StderrAssert (a -> [PostProcessStep] -> Assert a)
-> Parser a -> Parser ([PostProcessStep] -> Assert a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"stderr" Parser ([PostProcessStep] -> Assert a)
-> Parser [PostProcessStep] -> Parser (Assert a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser [PostProcessStep]
forall {a}. FromJSON a => Object -> Parser [a]
pp Object
o
, a -> Maybe a -> [PostProcessStep] -> Assert a
forall a. a -> Maybe a -> [PostProcessStep] -> Assert a
CreatedFileAssert
(a -> Maybe a -> [PostProcessStep] -> Assert a)
-> Parser a -> Parser (Maybe a -> [PostProcessStep] -> Assert a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"created_file" Parser (Maybe a -> [PostProcessStep] -> Assert a)
-> Parser (Maybe a) -> Parser ([PostProcessStep] -> Assert a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object
o Object -> Key -> Parser (Maybe a)
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"contents" Parser ([PostProcessStep] -> Assert a)
-> Parser [PostProcessStep] -> Parser (Assert a)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Object -> Parser [PostProcessStep]
forall {a}. FromJSON a => Object -> Parser [a]
pp Object
o
, a -> Assert a
forall a. a -> Assert a
CreatedDirectoryAssert (a -> Assert a) -> Parser a -> Parser (Assert a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser a
forall a. FromJSON a => Object -> Key -> Parser a
A..: Key
"created_directory"
]
case [Maybe (Assert a)] -> [Assert a]
forall a. [Maybe a] -> [a]
catMaybes [Maybe (Assert a)]
options of
[Assert a
opt] -> Assert a -> Parser (Assert a)
forall a. a -> Parser a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Assert a
opt
[] -> FilePath -> Parser (Assert a)
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail FilePath
"no assert discriminator"
[Assert a]
opts -> FilePath -> Parser (Assert a)
forall a. FilePath -> Parser a
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
fail (FilePath -> Parser (Assert a)) -> FilePath -> Parser (Assert a)
forall a b. (a -> b) -> a -> b
$ FilePath
"multiple assert discriminators: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath -> [FilePath] -> FilePath
forall a. [a] -> [[a]] -> [a]
List.intercalate FilePath
", " ((Assert a -> FilePath) -> [Assert a] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map Assert a -> FilePath
forall a. Assert a -> FilePath
assertDiscriminator [Assert a]
opts)
where
pp :: Object -> Parser [a]
pp Object
o = [a] -> (Multiple a -> [a]) -> Maybe (Multiple a) -> [a]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] Multiple a -> [a]
forall a. Multiple a -> [a]
multipleToList (Maybe (Multiple a) -> [a])
-> Parser (Maybe (Multiple a)) -> Parser [a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Object
o Object -> Key -> Parser (Maybe (Multiple a))
forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
A..:? Key
"post_process"
assertDiscriminator :: Assert a -> String
assertDiscriminator :: forall a. Assert a -> FilePath
assertDiscriminator (ExitCodeAssert Int
_) = FilePath
"exit_code"
assertDiscriminator (StdoutAssert a
_ [PostProcessStep]
_) = FilePath
"stdout"
assertDiscriminator (StderrAssert a
_ [PostProcessStep]
_) = FilePath
"stderr"
assertDiscriminator (CreatedFileAssert a
_ Maybe a
_ [PostProcessStep]
_) = FilePath
"created_file"
assertDiscriminator (CreatedDirectoryAssert a
_) = FilePath
"created_directory"
data Logger = Logger
{ Logger -> [FilePath] -> IO ()
logDebug :: [String] -> IO ()
, Logger -> [FilePath] -> IO ()
logError :: [String] -> IO ()
, Logger -> [FilePath] -> IO ()
logOut :: [String] -> IO ()
}
makeLogger :: Bool -> IO Logger
makeLogger :: Bool -> IO Logger
makeLogger Bool
verbose = do
MVar ()
lock <- () -> IO (MVar ())
forall a. a -> IO (MVar a)
MVar.newMVar ()
let writeLines :: Handle -> t FilePath -> IO ()
writeLines Handle
h t FilePath
ls = MVar () -> (() -> IO ()) -> IO ()
forall a b. MVar a -> (a -> IO b) -> IO b
MVar.withMVar MVar ()
lock ((() -> IO ()) -> IO ()) -> (() -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \() -> (FilePath -> IO ()) -> t FilePath -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
h) t FilePath
ls
Logger -> IO Logger
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Logger
{ logDebug :: [FilePath] -> IO ()
logDebug = if Bool
verbose then Handle -> [FilePath] -> IO ()
forall {t :: * -> *}. Foldable t => Handle -> t FilePath -> IO ()
writeLines Handle
IO.stderr else \[FilePath]
_ -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
, logError :: [FilePath] -> IO ()
logError = Handle -> [FilePath] -> IO ()
forall {t :: * -> *}. Foldable t => Handle -> t FilePath -> IO ()
writeLines Handle
IO.stderr
, logOut :: [FilePath] -> IO ()
logOut = Handle -> [FilePath] -> IO ()
forall {t :: * -> *}. Foldable t => Handle -> t FilePath -> IO ()
writeLines Handle
IO.stdout
}
data Execution = Execution
{ Execution -> Spec FilePath
executionSpec :: Spec String
, Execution -> Maybe FilePath
executionInputFile :: Maybe FilePath
, Execution -> FilePath
executionSpecPath :: FilePath
, Execution -> FilePath
executionSpecName :: String
, Execution -> FilePath
executionDirectory :: FilePath
}
specExecutions :: FilePath -> Spec String -> IO [Execution]
specExecutions :: FilePath -> Spec FilePath -> IO [Execution]
specExecutions FilePath
specPath Spec FilePath
spec = do
FilePath
absoluteSpecPath <- FilePath -> IO FilePath
Dir.makeAbsolute FilePath
specPath
let (FilePath
specDirectory, FilePath
specBaseName) = FilePath -> (FilePath, FilePath)
FP.splitFileName FilePath
specPath
specName :: FilePath
specName = FilePath -> FilePath
FP.dropExtension FilePath
specBaseName
mkAbsoluteWorkDir :: FilePath -> FilePath
mkAbsoluteWorkDir :: FilePath -> FilePath
mkAbsoluteWorkDir FilePath
dir | FilePath -> Bool
FP.isRelative FilePath
dir = FilePath
specDirectory FilePath -> FilePath -> FilePath
FP.</> FilePath
dir
| Bool
otherwise = FilePath
dir
workDirectory :: FilePath
workDirectory = FilePath -> (FilePath -> FilePath) -> Maybe FilePath -> FilePath
forall b a. b -> (a -> b) -> Maybe a -> b
maybe FilePath
specDirectory FilePath -> FilePath
mkAbsoluteWorkDir (Spec FilePath -> Maybe FilePath
forall a. Spec a -> Maybe a
specWorkDir Spec FilePath
spec)
[(FilePath, FilePath)]
env0 <- IO [(FilePath, FilePath)]
getEnvironment
let env1 :: [(FilePath, FilePath)]
env1 =
((FilePath, FilePath) -> (FilePath, FilePath) -> Bool)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. (a -> a -> Bool) -> [a] -> [a]
List.nubBy (FilePath -> FilePath -> Bool
forall a. Eq a => a -> a -> Bool
(==) (FilePath -> FilePath -> Bool)
-> ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath)
-> (FilePath, FilePath)
-> Bool
forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> a
fst) ([(FilePath, FilePath)] -> [(FilePath, FilePath)])
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a b. (a -> b) -> a -> b
$
(FilePath
"GOLDPLATE_NAME", FilePath
specName) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:
(FilePath
"GOLDPLATE_FILE", FilePath
absoluteSpecPath) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:
(FilePath
"GOLDPLATE_BASENAME", FilePath
specBaseName) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:
Spec FilePath -> [(FilePath, FilePath)]
forall a. Spec a -> [(a, a)]
specEnv Spec FilePath
spec [(FilePath, FilePath)]
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. [a] -> [a] -> [a]
++ [(FilePath, FilePath)]
env0
[Maybe FilePath]
concreteInputFiles <- case Spec FilePath -> Maybe FilePath
forall a. Spec a -> Maybe a
specInputFiles Spec FilePath
spec of
Maybe FilePath
Nothing -> [Maybe FilePath] -> IO [Maybe FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [Maybe FilePath
forall a. Maybe a
Nothing]
Just FilePath
glob0 -> do
FilePath
glob <- Either MissingEnvVar FilePath -> IO FilePath
forall a. Either MissingEnvVar a -> IO a
hoistEither (Either MissingEnvVar FilePath -> IO FilePath)
-> Either MissingEnvVar FilePath -> IO FilePath
forall a b. (a -> b) -> a -> b
$ [(FilePath, FilePath)] -> FilePath -> Either MissingEnvVar FilePath
splice [(FilePath, FilePath)]
env1 FilePath
glob0
[FilePath]
inputFiles <- FilePath -> IO [FilePath] -> IO [FilePath]
forall a. FilePath -> IO a -> IO a
Dir.withCurrentDirectory FilePath
workDirectory (IO [FilePath] -> IO [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ do
[FilePath]
matches <- FilePath -> IO [FilePath]
globCurrentDir FilePath
glob
[FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [FilePath]
matches Int -> IO [FilePath] -> IO [FilePath]
forall a b. a -> b -> b
`seq` [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath]
matches
[Maybe FilePath] -> IO [Maybe FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ((FilePath -> Maybe FilePath) -> [FilePath] -> [Maybe FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just (FilePath -> Maybe FilePath)
-> (FilePath -> FilePath) -> FilePath -> Maybe FilePath
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
FP.normalise) [FilePath]
inputFiles)
[Maybe FilePath]
-> (Maybe FilePath -> IO Execution) -> IO [Execution]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [Maybe FilePath]
concreteInputFiles ((Maybe FilePath -> IO Execution) -> IO [Execution])
-> (Maybe FilePath -> IO Execution) -> IO [Execution]
forall a b. (a -> b) -> a -> b
$ \Maybe FilePath
mbInputFile -> do
let env2 :: [(FilePath, FilePath)]
env2 = case Maybe FilePath
mbInputFile of
Maybe FilePath
Nothing -> [(FilePath, FilePath)]
env1
Just FilePath
inputFile ->
(FilePath
"GOLDPLATE_INPUT_FILE", FilePath
inputFile) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:
(FilePath
"GOLDPLATE_INPUT_NAME", FilePath -> FilePath
FP.dropExtension FilePath
inputFile) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:
(FilePath
"GOLDPLATE_INPUT_BASENAME", (FilePath, FilePath) -> FilePath
forall a b. (a, b) -> b
snd ((FilePath, FilePath) -> FilePath)
-> (FilePath, FilePath) -> FilePath
forall a b. (a -> b) -> a -> b
$ FilePath -> (FilePath, FilePath)
FP.splitFileName FilePath
inputFile) (FilePath, FilePath)
-> [(FilePath, FilePath)] -> [(FilePath, FilePath)]
forall a. a -> [a] -> [a]
:
[(FilePath, FilePath)]
env1
Either MissingEnvVar Execution -> IO Execution
forall a. Either MissingEnvVar a -> IO a
hoistEither (Either MissingEnvVar Execution -> IO Execution)
-> Either MissingEnvVar Execution -> IO Execution
forall a b. (a -> b) -> a -> b
$ do
Spec FilePath
spec' <- (FilePath -> Either MissingEnvVar FilePath)
-> Spec FilePath -> Either MissingEnvVar (Spec FilePath)
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
forall (f :: * -> *) a b.
Applicative f =>
(a -> f b) -> Spec a -> f (Spec b)
traverse ([(FilePath, FilePath)] -> FilePath -> Either MissingEnvVar FilePath
splice [(FilePath, FilePath)]
env2) Spec FilePath
spec
Execution -> Either MissingEnvVar Execution
forall a. a -> Either MissingEnvVar a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Execution
{ executionSpec :: Spec FilePath
executionSpec = Spec FilePath
spec' {specEnv = env2}
, executionInputFile :: Maybe FilePath
executionInputFile = Maybe FilePath
mbInputFile
, executionSpecPath :: FilePath
executionSpecPath = FilePath
specPath
, executionSpecName :: FilePath
executionSpecName = FilePath
specName
, executionDirectory :: FilePath
executionDirectory = FilePath
workDirectory
}
where
hoistEither :: Either MissingEnvVar a -> IO a
hoistEither :: forall a. Either MissingEnvVar a -> IO a
hoistEither = (MissingEnvVar -> IO a)
-> (a -> IO a) -> Either MissingEnvVar a -> IO a
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either MissingEnvVar -> IO a
forall e a. Exception e => e -> IO a
throwIO a -> IO a
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return
executionHeader :: Execution -> String
Execution
execution =
Execution -> FilePath
executionSpecPath Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
case Execution -> Maybe FilePath
executionInputFile Execution
execution of
Maybe FilePath
Nothing -> FilePath
": "
Just FilePath
fp -> FilePath
" (" FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
fp FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"): "
data Env = Env
{ Env -> Logger
envLogger :: !Logger
, Env -> Bool
envDiff :: !Bool
, Env -> Bool
envPrettyDiff :: !Bool
, Env -> Bool
envFix :: !Bool
}
data ExecutionResult = ExecutionResult
{ ExecutionResult -> ExitCode
erExitCode :: !ExitCode
, ExecutionResult -> ByteString
erStdout :: !B.ByteString
, ExecutionResult -> ByteString
erStderr :: !B.ByteString
} deriving (Int -> ExecutionResult -> FilePath -> FilePath
[ExecutionResult] -> FilePath -> FilePath
ExecutionResult -> FilePath
(Int -> ExecutionResult -> FilePath -> FilePath)
-> (ExecutionResult -> FilePath)
-> ([ExecutionResult] -> FilePath -> FilePath)
-> Show ExecutionResult
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> ExecutionResult -> FilePath -> FilePath
showsPrec :: Int -> ExecutionResult -> FilePath -> FilePath
$cshow :: ExecutionResult -> FilePath
show :: ExecutionResult -> FilePath
$cshowList :: [ExecutionResult] -> FilePath -> FilePath
showList :: [ExecutionResult] -> FilePath -> FilePath
Show)
runExecution
:: Env -> Execution -> IO ExecutionResult
runExecution :: Env -> Execution -> IO ExecutionResult
runExecution Env
env execution :: Execution
execution@Execution {FilePath
Maybe FilePath
Spec FilePath
executionSpec :: Execution -> Spec FilePath
executionInputFile :: Execution -> Maybe FilePath
executionSpecPath :: Execution -> FilePath
executionSpecName :: Execution -> FilePath
executionDirectory :: Execution -> FilePath
executionSpec :: Spec FilePath
executionInputFile :: Maybe FilePath
executionSpecPath :: FilePath
executionSpecName :: FilePath
executionDirectory :: FilePath
..} = do
let Spec {FilePath
[FilePath]
[(FilePath, FilePath)]
[Assert FilePath]
Maybe FilePath
Maybe (Multiple FilePath)
specInputFiles :: forall a. Spec a -> Maybe a
specCommand :: forall a. Spec a -> a
specArguments :: forall a. Spec a -> [a]
specStdin :: forall a. Spec a -> Maybe (Multiple a)
specEnv :: forall a. Spec a -> [(a, a)]
specWorkDir :: forall a. Spec a -> Maybe a
specAsserts :: forall a. Spec a -> [Assert a]
specInputFiles :: Maybe FilePath
specCommand :: FilePath
specArguments :: [FilePath]
specStdin :: Maybe (Multiple FilePath)
specEnv :: [(FilePath, FilePath)]
specWorkDir :: Maybe FilePath
specAsserts :: [Assert FilePath]
..} = Spec FilePath
executionSpec
Logger -> [FilePath] -> IO ()
logDebug (Env -> Logger
envLogger Env
env) [Execution -> FilePath
executionHeader Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"running..."]
let createProcess :: CreateProcess
createProcess = (FilePath -> [FilePath] -> CreateProcess
Process.proc FilePath
specCommand [FilePath]
specArguments)
{ Process.env = Just specEnv
, Process.cwd = Just executionDirectory
, Process.std_in = Process.CreatePipe
, Process.std_out = Process.CreatePipe
, Process.std_err = Process.CreatePipe
}
Logger -> [FilePath] -> IO ()
logDebug (Env -> Logger
envLogger Env
env) [Execution -> FilePath
executionHeader Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
specCommand FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ [FilePath] -> FilePath
unwords [FilePath]
specArguments]
(Just Handle
hIn, Just Handle
hOut, Just Handle
hErr, ProcessHandle
hProc) <-
CreateProcess
-> IO (Maybe Handle, Maybe Handle, Maybe Handle, ProcessHandle)
Process.createProcess CreateProcess
createProcess
let writeStdin :: IO ()
writeStdin = (IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO a
`finally` Handle -> IO ()
IO.hClose Handle
hIn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ case Maybe (Multiple FilePath)
specStdin of
Maybe (Multiple FilePath)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
Just (Single FilePath
str) -> Handle -> FilePath -> IO ()
IO.hPutStr Handle
hIn FilePath
str
Just (Multiple [FilePath]
strs) -> (FilePath -> IO ()) -> [FilePath] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Handle -> FilePath -> IO ()
IO.hPutStrLn Handle
hIn) [FilePath]
strs
IO () -> (Async () -> IO ExecutionResult) -> IO ExecutionResult
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync IO ()
writeStdin ((Async () -> IO ExecutionResult) -> IO ExecutionResult)
-> (Async () -> IO ExecutionResult) -> IO ExecutionResult
forall a b. (a -> b) -> a -> b
$ \Async ()
_ ->
IO ByteString
-> (Async ByteString -> IO ExecutionResult) -> IO ExecutionResult
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (Handle -> IO ByteString
B.hGetContents Handle
hOut) ((Async ByteString -> IO ExecutionResult) -> IO ExecutionResult)
-> (Async ByteString -> IO ExecutionResult) -> IO ExecutionResult
forall a b. (a -> b) -> a -> b
$ \Async ByteString
outAsync ->
IO ByteString
-> (Async ByteString -> IO ExecutionResult) -> IO ExecutionResult
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (Handle -> IO ByteString
B.hGetContents Handle
hErr) ((Async ByteString -> IO ExecutionResult) -> IO ExecutionResult)
-> (Async ByteString -> IO ExecutionResult) -> IO ExecutionResult
forall a b. (a -> b) -> a -> b
$ \Async ByteString
errAsync ->
IO ExitCode
-> (Async ExitCode -> IO ExecutionResult) -> IO ExecutionResult
forall a b. IO a -> (Async a -> IO b) -> IO b
Async.withAsync (ProcessHandle -> IO ExitCode
Process.waitForProcess ProcessHandle
hProc) ((Async ExitCode -> IO ExecutionResult) -> IO ExecutionResult)
-> (Async ExitCode -> IO ExecutionResult) -> IO ExecutionResult
forall a b. (a -> b) -> a -> b
$ \Async ExitCode
exitAsync -> do
!ExitCode
exitCode <- Async ExitCode -> IO ExitCode
forall a. Async a -> IO a
Async.wait Async ExitCode
exitAsync
!ByteString
actualOut <- Async ByteString -> IO ByteString
forall a. Async a -> IO a
Async.wait Async ByteString
outAsync
!ByteString
actualErr <- Async ByteString -> IO ByteString
forall a. Async a -> IO a
Async.wait Async ByteString
errAsync
Logger -> [FilePath] -> IO ()
logDebug (Env -> Logger
envLogger Env
env)
[ Execution -> FilePath
executionHeader Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"finished"
, FilePath
"exit code: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ ExitCode -> FilePath
forall a. Show a => a -> FilePath
show ExitCode
exitCode
, FilePath
"stdout:", ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
actualOut
, FilePath
"stderr:", ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
actualErr
]
ExecutionResult -> IO ExecutionResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ExecutionResult
{ erExitCode :: ExitCode
erExitCode = ExitCode
exitCode
, erStdout :: ByteString
erStdout = ByteString
actualOut
, erStderr :: ByteString
erStderr = ByteString
actualErr
}
data AssertResult = AssertResult
{ AssertResult -> Bool
arOk :: Bool
, :: String
, AssertResult -> [FilePath]
arMessage :: [String]
} deriving (Int -> AssertResult -> FilePath -> FilePath
[AssertResult] -> FilePath -> FilePath
AssertResult -> FilePath
(Int -> AssertResult -> FilePath -> FilePath)
-> (AssertResult -> FilePath)
-> ([AssertResult] -> FilePath -> FilePath)
-> Show AssertResult
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> AssertResult -> FilePath -> FilePath
showsPrec :: Int -> AssertResult -> FilePath -> FilePath
$cshow :: AssertResult -> FilePath
show :: AssertResult -> FilePath
$cshowList :: [AssertResult] -> FilePath -> FilePath
showList :: [AssertResult] -> FilePath -> FilePath
Show)
assertResultToTap :: AssertResult -> [String]
assertResultToTap :: AssertResult -> [FilePath]
assertResultToTap AssertResult
ar =
((if AssertResult -> Bool
arOk AssertResult
ar then FilePath
"ok " else FilePath
"not ok ") FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ AssertResult -> FilePath
arHeader AssertResult
ar) FilePath -> [FilePath] -> [FilePath]
forall a. a -> [a] -> [a]
:
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
" " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++) ((FilePath -> [FilePath]) -> [FilePath] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap FilePath -> [FilePath]
lines ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ AssertResult -> [FilePath]
arMessage AssertResult
ar)
runAssert
:: Env -> Execution -> ExecutionResult -> Assert String -> IO AssertResult
runAssert :: Env
-> Execution
-> ExecutionResult
-> Assert FilePath
-> IO AssertResult
runAssert Env
env execution :: Execution
execution@Execution {FilePath
Maybe FilePath
Spec FilePath
executionSpec :: Execution -> Spec FilePath
executionInputFile :: Execution -> Maybe FilePath
executionSpecPath :: Execution -> FilePath
executionSpecName :: Execution -> FilePath
executionDirectory :: Execution -> FilePath
executionSpec :: Spec FilePath
executionInputFile :: Maybe FilePath
executionSpecPath :: FilePath
executionSpecName :: FilePath
executionDirectory :: FilePath
..} ExecutionResult {ByteString
ExitCode
erExitCode :: ExecutionResult -> ExitCode
erStdout :: ExecutionResult -> ByteString
erStderr :: ExecutionResult -> ByteString
erExitCode :: ExitCode
erStdout :: ByteString
erStderr :: ByteString
..} Assert FilePath
assert =
case Assert FilePath
assert of
ExitCodeAssert Int
expectedExitCode ->
let actualExitCode :: Int
actualExitCode = case ExitCode
erExitCode of
ExitCode
ExitSuccess -> Int
0
ExitFailure Int
c -> Int
c
success :: Bool
success = Int
expectedExitCode Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
actualExitCode in
AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertResult -> IO AssertResult)
-> AssertResult -> IO AssertResult
forall a b. (a -> b) -> a -> b
$ Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
success
[FilePath
"expected " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
expectedExitCode FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
FilePath
" but got " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
actualExitCode | Bool -> Bool
not Bool
success]
StdoutAssert {FilePath
[PostProcessStep]
stdoutFilePath :: forall a. Assert a -> a
stdoutPostProcess :: forall a. Assert a -> [PostProcessStep]
stdoutFilePath :: FilePath
stdoutPostProcess :: [PostProcessStep]
..} -> FilePath -> [PostProcessStep] -> ByteString -> IO AssertResult
checkAgainstFile
(FilePath -> FilePath
inExecutionDir FilePath
stdoutFilePath) [PostProcessStep]
stdoutPostProcess ByteString
erStdout
StderrAssert {FilePath
[PostProcessStep]
stderrFilePath :: forall a. Assert a -> a
stderrPostProcess :: forall a. Assert a -> [PostProcessStep]
stderrFilePath :: FilePath
stderrPostProcess :: [PostProcessStep]
..} -> FilePath -> [PostProcessStep] -> ByteString -> IO AssertResult
checkAgainstFile
(FilePath -> FilePath
inExecutionDir FilePath
stderrFilePath) [PostProcessStep]
stderrPostProcess ByteString
erStderr
CreatedFileAssert {FilePath
[PostProcessStep]
Maybe FilePath
createdFilePath :: forall a. Assert a -> a
createdFileContents :: forall a. Assert a -> Maybe a
createdFilePostProcess :: forall a. Assert a -> [PostProcessStep]
createdFilePath :: FilePath
createdFileContents :: Maybe FilePath
createdFilePostProcess :: [PostProcessStep]
..} -> do
let path :: FilePath
path = FilePath -> FilePath
inExecutionDir FilePath
createdFilePath
Bool
exists <- FilePath -> IO Bool
Dir.doesFileExist FilePath
path
case Bool
exists of
Bool
False -> AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertResult -> IO AssertResult)
-> AssertResult -> IO AssertResult
forall a b. (a -> b) -> a -> b
$ Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
False
[FilePath
createdFilePath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" was not created"]
Bool
True -> case Maybe FilePath
createdFileContents of
Maybe FilePath
Nothing -> AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertResult -> IO AssertResult)
-> AssertResult -> IO AssertResult
forall a b. (a -> b) -> a -> b
$ Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
True []
Just FilePath
expectedPath -> do
!ByteString
actual <- FilePath -> IO ByteString
readFileOrEmpty FilePath
path
AssertResult
ar <- FilePath -> [PostProcessStep] -> ByteString -> IO AssertResult
checkAgainstFile
(FilePath -> FilePath
inExecutionDir FilePath
expectedPath)
[PostProcessStep]
createdFilePostProcess ByteString
actual
FilePath -> IO ()
Dir.removeFile FilePath
path
Logger -> [FilePath] -> IO ()
logDebug (Env -> Logger
envLogger Env
env)
[Execution -> FilePath
executionHeader Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"removed " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path]
AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure AssertResult
ar
CreatedDirectoryAssert {FilePath
createdDirectoryPath :: forall a. Assert a -> a
createdDirectoryPath :: FilePath
..} -> do
let path :: FilePath
path = FilePath -> FilePath
inExecutionDir FilePath
createdDirectoryPath
Bool
exists <- FilePath -> IO Bool
Dir.doesDirectoryExist FilePath
path
case Bool
exists of
Bool
False -> AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertResult -> IO AssertResult)
-> AssertResult -> IO AssertResult
forall a b. (a -> b) -> a -> b
$ Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
False
[FilePath
createdDirectoryPath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" was not created"]
Bool
True -> do
FilePath -> IO ()
Dir.removeDirectoryRecursive FilePath
path
Logger -> [FilePath] -> IO ()
logDebug (Env -> Logger
envLogger Env
env)
[Execution -> FilePath
executionHeader Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
"removed " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
path]
AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertResult -> IO AssertResult)
-> AssertResult -> IO AssertResult
forall a b. (a -> b) -> a -> b
$ Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
True []
where
makeAssertResult :: Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
ok = Bool -> FilePath -> [FilePath] -> AssertResult
AssertResult Bool
ok
(Execution -> FilePath
executionHeader Execution
execution FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Assert FilePath -> FilePath
forall a. Assert a -> FilePath
assertDiscriminator Assert FilePath
assert)
inExecutionDir :: FilePath -> FilePath
inExecutionDir :: FilePath -> FilePath
inExecutionDir FilePath
fp =
if FilePath -> Bool
FP.isAbsolute FilePath
fp then FilePath
fp else FilePath
executionDirectory FilePath -> FilePath -> FilePath
FP.</> FilePath
fp
checkAgainstFile
:: FilePath -> PostProcess -> B.ByteString -> IO AssertResult
checkAgainstFile :: FilePath -> [PostProcessStep] -> ByteString -> IO AssertResult
checkAgainstFile FilePath
expectedPath [PostProcessStep]
processor ByteString
actual0 = do
ByteString
expected <- FilePath -> IO ByteString
readFileOrEmpty FilePath
expectedPath
let !actual1 :: ByteString
actual1 = [PostProcessStep] -> ByteString -> ByteString
postProcess [PostProcessStep]
processor ByteString
actual0
success :: Bool
success = ByteString
actual1 ByteString -> ByteString -> Bool
forall a. Eq a => a -> a -> Bool
== ByteString
expected
shouldFix :: Bool
shouldFix = Env -> Bool
envFix Env
env Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
success
[Diff [FilePath]]
diff :: [Diff [String]] = (UnicodeException -> [Diff [FilePath]])
-> ([Diff [FilePath]] -> [Diff [FilePath]])
-> Either UnicodeException [Diff [FilePath]]
-> [Diff [FilePath]]
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ([Diff [FilePath]] -> UnicodeException -> [Diff [FilePath]]
forall a b. a -> b -> a
const []) [Diff [FilePath]] -> [Diff [FilePath]]
forall a. a -> a
id (Either UnicodeException [Diff [FilePath]] -> [Diff [FilePath]])
-> Either UnicodeException [Diff [FilePath]] -> [Diff [FilePath]]
forall a b. (a -> b) -> a -> b
$ do
FilePath
expected' <- Text -> FilePath
T.unpack (Text -> FilePath)
-> Either UnicodeException Text -> Either UnicodeException FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
expected
FilePath
actual1' <- Text -> FilePath
T.unpack (Text -> FilePath)
-> Either UnicodeException Text -> Either UnicodeException FilePath
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByteString -> Either UnicodeException Text
T.decodeUtf8' ByteString
actual1
[Diff [FilePath]] -> Either UnicodeException [Diff [FilePath]]
forall a. a -> Either UnicodeException a
forall (m :: * -> *) a. Monad m => a -> m a
return ([Diff [FilePath]] -> Either UnicodeException [Diff [FilePath]])
-> [Diff [FilePath]] -> Either UnicodeException [Diff [FilePath]]
forall a b. (a -> b) -> a -> b
$
[FilePath] -> [FilePath] -> [Diff [FilePath]]
forall a. Eq a => [a] -> [a] -> [Diff [a]]
getGroupedDiff
(FilePath -> [FilePath]
lines FilePath
expected')
(FilePath -> [FilePath]
lines FilePath
actual1')
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldFix (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
B.writeFile FilePath
expectedPath ByteString
actual1
AssertResult -> IO AssertResult
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (AssertResult -> IO AssertResult)
-> ([[FilePath]] -> AssertResult)
-> [[FilePath]]
-> IO AssertResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> [FilePath] -> AssertResult
makeAssertResult Bool
success ([FilePath] -> AssertResult)
-> ([[FilePath]] -> [FilePath]) -> [[FilePath]] -> AssertResult
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat ([[FilePath]] -> IO AssertResult)
-> [[FilePath]] -> IO AssertResult
forall a b. (a -> b) -> a -> b
$
[ [ FilePath
"expected:"
, ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
expected
, FilePath
"actual:"
, ByteString -> FilePath
forall a. Show a => a -> FilePath
show ByteString
actual1
]
| Bool -> Bool
not Bool
success Bool -> Bool -> Bool
&& Env -> Bool
envDiff Env
env
] [[FilePath]] -> [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a] -> [a]
++
[ [ FilePath
"diff:", [Diff [FilePath]] -> FilePath
ppDiff [Diff [FilePath]]
diff ]
| Bool -> Bool
not Bool
success Bool -> Bool -> Bool
&& Env -> Bool
envPrettyDiff Env
env
] [[FilePath]] -> [[FilePath]] -> [[FilePath]]
forall a. [a] -> [a] -> [a]
++
[ [FilePath
"fixed " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
expectedPath] | Bool
shouldFix ]
readFileOrEmpty :: FilePath -> IO B.ByteString
readFileOrEmpty :: FilePath -> IO ByteString
readFileOrEmpty FilePath
fp = do
Bool
exists <- FilePath -> IO Bool
Dir.doesFileExist FilePath
fp
if Bool
exists then FilePath -> IO ByteString
B.readFile FilePath
fp else ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
B.empty
findSpecs :: [FilePath] -> IO [FilePath]
findSpecs :: [FilePath] -> IO [FilePath]
findSpecs [FilePath]
fps = ([[FilePath]] -> [FilePath]) -> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[FilePath]] -> [FilePath]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[FilePath]] -> IO [FilePath])
-> IO [[FilePath]] -> IO [FilePath]
forall a b. (a -> b) -> a -> b
$ [FilePath] -> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
fps ((FilePath -> IO [FilePath]) -> IO [[FilePath]])
-> (FilePath -> IO [FilePath]) -> IO [[FilePath]]
forall a b. (a -> b) -> a -> b
$ \FilePath
fp -> do
Bool
isDir <- FilePath -> IO Bool
Dir.doesDirectoryExist FilePath
fp
case Bool
isDir of
Bool
False -> [FilePath] -> IO [FilePath]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [FilePath
fp]
Bool
True -> Pattern -> FilePath -> IO [FilePath]
Glob.globDir1 (FilePath -> Pattern
Glob.compile FilePath
"**/*.goldplate") FilePath
fp
globCurrentDir :: String -> IO [FilePath]
globCurrentDir :: FilePath -> IO [FilePath]
globCurrentDir FilePath
pattern =
(FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map FilePath -> FilePath
dropLeadingDot ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> FilePath -> IO [FilePath]
Glob.globDir1 (FilePath -> Pattern
Glob.compile FilePath
pattern) FilePath
"."
where
dropLeadingDot :: FilePath -> FilePath
dropLeadingDot FilePath
fp0 = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break Char -> Bool
FP.isPathSeparator FilePath
fp0 of
(FilePath
".", FilePath
fp1) -> Int -> FilePath -> FilePath
forall a. Int -> [a] -> [a]
drop Int
1 FilePath
fp1
(FilePath, FilePath)
_ -> FilePath
fp0
data Options = Options
{ Options -> [FilePath]
oPaths :: [FilePath]
, Options -> Bool
oVerbose :: Bool
, Options -> Bool
oDiff :: Bool
, Options -> Bool
oPrettyDiff :: Bool
, Options -> Bool
oFix :: Bool
, Options -> Int
oJobs :: Int
}
defaultOptions :: Options
defaultOptions :: Options
defaultOptions = Options
{ oPaths :: [FilePath]
oPaths = []
, oVerbose :: Bool
oVerbose = Bool
False
, oDiff :: Bool
oDiff = Bool
False
, oPrettyDiff :: Bool
oPrettyDiff = Bool
False
, oFix :: Bool
oFix = Bool
False
, oJobs :: Int
oJobs = Int
1
}
parseOptions :: OA.Parser Options
parseOptions :: Parser Options
parseOptions = [FilePath] -> Bool -> Bool -> Bool -> Bool -> Int -> Options
Options
([FilePath] -> Bool -> Bool -> Bool -> Bool -> Int -> Options)
-> Parser [FilePath]
-> Parser (Bool -> Bool -> Bool -> Bool -> Int -> Options)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser FilePath -> Parser [FilePath]
forall a. Parser a -> Parser [a]
forall (f :: * -> *) a. Alternative f => f a -> f [a]
OA.some (Mod ArgumentFields FilePath -> Parser FilePath
forall s. IsString s => Mod ArgumentFields s -> Parser s
OA.strArgument (
FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. HasMetavar f => FilePath -> Mod f a
OA.metavar FilePath
"PATH" Mod ArgumentFields FilePath
-> Mod ArgumentFields FilePath -> Mod ArgumentFields FilePath
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod ArgumentFields FilePath
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Test files/directories"))
Parser (Bool -> Bool -> Bool -> Bool -> Int -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Bool -> Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch (
Char -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'v' Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Print debug info")
Parser (Bool -> Bool -> Bool -> Int -> Options)
-> Parser Bool -> Parser (Bool -> Bool -> Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch (
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"diff" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Show differences in files")
Parser (Bool -> Bool -> Int -> Options)
-> Parser Bool -> Parser (Bool -> Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch (
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"pretty-diff" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Show differences in files, output in patch format")
Parser (Bool -> Int -> Options)
-> Parser Bool -> Parser (Int -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Mod FlagFields Bool -> Parser Bool
OA.switch (
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"fix" Mod FlagFields Bool -> Mod FlagFields Bool -> Mod FlagFields Bool
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod FlagFields Bool
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Attempt to fix broken tests")
Parser (Int -> Options) -> Parser Int -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ReadM Int -> Mod OptionFields Int -> Parser Int
forall a. ReadM a -> Mod OptionFields a -> Parser a
OA.option ReadM Int
forall a. Read a => ReadM a
OA.auto (
FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"jobs" Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
Char -> Mod OptionFields Int
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'j' Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
Int -> Mod OptionFields Int
forall (f :: * -> *) a. HasValue f => a -> Mod f a
OA.value (Options -> Int
oJobs Options
defaultOptions) Mod OptionFields Int
-> Mod OptionFields Int -> Mod OptionFields Int
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod OptionFields Int
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Number of worker jobs")
parserInfo :: OA.ParserInfo Options
parserInfo :: ParserInfo Options
parserInfo = Parser Options -> InfoMod Options -> ParserInfo Options
forall a. Parser a -> InfoMod a -> ParserInfo a
OA.info (Parser ((Options -> Options) -> Options -> Options)
forall a. Parser (a -> a)
OA.helper Parser ((Options -> Options) -> Options -> Options)
-> Parser (Options -> Options) -> Parser (Options -> Options)
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser (Options -> Options)
forall a. Parser (a -> a)
versionOption Parser (Options -> Options) -> Parser Options -> Parser Options
forall a b. Parser (a -> b) -> Parser a -> Parser b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Options
parseOptions) (InfoMod Options -> ParserInfo Options)
-> InfoMod Options -> ParserInfo Options
forall a b. (a -> b) -> a -> b
$
InfoMod Options
forall a. InfoMod a
OA.fullDesc InfoMod Options -> InfoMod Options -> InfoMod Options
forall a. Semigroup a => a -> a -> a
<>
FilePath -> InfoMod Options
forall a. FilePath -> InfoMod a
OA.header FilePath
goldplateVersion
where
versionOption :: Parser (a -> a)
versionOption = FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a. FilePath -> Mod OptionFields (a -> a) -> Parser (a -> a)
OA.infoOption FilePath
goldplateVersion (Mod OptionFields (a -> a) -> Parser (a -> a))
-> Mod OptionFields (a -> a) -> Parser (a -> a)
forall a b. (a -> b) -> a -> b
$
FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => FilePath -> Mod f a
OA.long FilePath
"version" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<>
Char -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. HasName f => Char -> Mod f a
OA.short Char
'V' Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<>
FilePath -> Mod OptionFields (a -> a)
forall (f :: * -> *) a. FilePath -> Mod f a
OA.help FilePath
"Show version info" Mod OptionFields (a -> a)
-> Mod OptionFields (a -> a) -> Mod OptionFields (a -> a)
forall a. Semigroup a => a -> a -> a
<>
Mod OptionFields (a -> a)
forall (f :: * -> *) a. Mod f a
OA.hidden
goldplateVersion :: String
goldplateVersion :: FilePath
goldplateVersion = FilePath
"goldplate v" FilePath -> FilePath -> FilePath
forall a. Semigroup a => a -> a -> a
<> Version -> FilePath
showVersion Version
version
worker
:: IORef.IORef [a]
-> (a -> IO ())
-> IO ()
worker :: forall a. IORef [a] -> (a -> IO ()) -> IO ()
worker IORef [a]
pool a -> IO ()
f = do
Maybe a
mbWorkload <- IORef [a] -> ([a] -> ([a], Maybe a)) -> IO (Maybe a)
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef [a]
pool (([a] -> ([a], Maybe a)) -> IO (Maybe a))
-> ([a] -> ([a], Maybe a)) -> IO (Maybe a)
forall a b. (a -> b) -> a -> b
$ \case
[] -> ([], Maybe a
forall a. Maybe a
Nothing)
(a
x : [a]
xs) -> ([a]
xs, a -> Maybe a
forall a. a -> Maybe a
Just a
x)
case Maybe a
mbWorkload of
Maybe a
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
Just a
workload -> a -> IO ()
f a
workload IO () -> IO () -> IO ()
forall a b. IO a -> IO b -> IO b
forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> IORef [a] -> (a -> IO ()) -> IO ()
forall a. IORef [a] -> (a -> IO ()) -> IO ()
worker IORef [a]
pool a -> IO ()
f
data InvalidSpec = InvalidSpec FilePath deriving (Int -> InvalidSpec -> FilePath -> FilePath
[InvalidSpec] -> FilePath -> FilePath
InvalidSpec -> FilePath
(Int -> InvalidSpec -> FilePath -> FilePath)
-> (InvalidSpec -> FilePath)
-> ([InvalidSpec] -> FilePath -> FilePath)
-> Show InvalidSpec
forall a.
(Int -> a -> FilePath -> FilePath)
-> (a -> FilePath) -> ([a] -> FilePath -> FilePath) -> Show a
$cshowsPrec :: Int -> InvalidSpec -> FilePath -> FilePath
showsPrec :: Int -> InvalidSpec -> FilePath -> FilePath
$cshow :: InvalidSpec -> FilePath
show :: InvalidSpec -> FilePath
$cshowList :: [InvalidSpec] -> FilePath -> FilePath
showList :: [InvalidSpec] -> FilePath -> FilePath
Show)
instance Exception InvalidSpec
mainWith :: Options -> IO ExitCode
mainWith :: Options -> IO ExitCode
mainWith Options
options = do
IORef Int
failed <- Int -> IO (IORef Int)
forall a. a -> IO (IORef a)
IORef.newIORef (Int
0 :: Int)
Env
env <- Logger -> Bool -> Bool -> Bool -> Env
Env
(Logger -> Bool -> Bool -> Bool -> Env)
-> IO Logger -> IO (Bool -> Bool -> Bool -> Env)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Bool -> IO Logger
makeLogger (Options -> Bool
oVerbose Options
options)
IO (Bool -> Bool -> Bool -> Env)
-> IO Bool -> IO (Bool -> Bool -> Env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Options -> Bool
oDiff Options
options)
IO (Bool -> Bool -> Env) -> IO Bool -> IO (Bool -> Env)
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Options -> Bool
oPrettyDiff Options
options)
IO (Bool -> Env) -> IO Bool -> IO Env
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Options -> Bool
oFix Options
options)
[FilePath]
specPaths <- [FilePath] -> IO [FilePath]
findSpecs (Options -> [FilePath]
oPaths Options
options)
[(FilePath, Spec FilePath)]
specs <- [FilePath]
-> (FilePath -> IO (FilePath, Spec FilePath))
-> IO [(FilePath, Spec FilePath)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [FilePath]
specPaths ((FilePath -> IO (FilePath, Spec FilePath))
-> IO [(FilePath, Spec FilePath)])
-> (FilePath -> IO (FilePath, Spec FilePath))
-> IO [(FilePath, Spec FilePath)]
forall a b. (a -> b) -> a -> b
$ \FilePath
specPath -> do
!Either FilePath (Spec FilePath)
errOrSpec <- ByteString -> Either FilePath (Spec FilePath)
forall a. FromJSON a => ByteString -> Either FilePath a
A.eitherDecodeStrict (ByteString -> Either FilePath (Spec FilePath))
-> IO ByteString -> IO (Either FilePath (Spec FilePath))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
B.readFile FilePath
specPath
case Either FilePath (Spec FilePath)
errOrSpec of
Right !Spec FilePath
spec -> (FilePath, Spec FilePath) -> IO (FilePath, Spec FilePath)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath
specPath, Spec FilePath
spec)
Left !FilePath
err -> do
Logger -> [FilePath] -> IO ()
logError (Env -> Logger
envLogger Env
env)
[FilePath
specPath FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
": could not parse JSON: " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
err]
InvalidSpec -> IO (FilePath, Spec FilePath)
forall e a. Exception e => e -> IO a
throwIO (InvalidSpec -> IO (FilePath, Spec FilePath))
-> InvalidSpec -> IO (FilePath, Spec FilePath)
forall a b. (a -> b) -> a -> b
$ FilePath -> InvalidSpec
InvalidSpec FilePath
specPath
let numSpecs :: Int
numSpecs = [(FilePath, Spec FilePath)] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [(FilePath, Spec FilePath)]
specs
Logger -> [FilePath] -> IO ()
logDebug (Env -> Logger
envLogger Env
env) [FilePath
"Found " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numSpecs FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" specs"]
[Execution]
executions <- ([[Execution]] -> [Execution])
-> IO [[Execution]] -> IO [Execution]
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [[Execution]] -> [Execution]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat (IO [[Execution]] -> IO [Execution])
-> IO [[Execution]] -> IO [Execution]
forall a b. (a -> b) -> a -> b
$ [(FilePath, Spec FilePath)]
-> ((FilePath, Spec FilePath) -> IO [Execution])
-> IO [[Execution]]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [(FilePath, Spec FilePath)]
specs (((FilePath, Spec FilePath) -> IO [Execution]) -> IO [[Execution]])
-> ((FilePath, Spec FilePath) -> IO [Execution])
-> IO [[Execution]]
forall a b. (a -> b) -> a -> b
$
\(FilePath
specPath, Spec FilePath
spec) -> FilePath -> Spec FilePath -> IO [Execution]
specExecutions FilePath
specPath Spec FilePath
spec
let numJobs :: Int
numJobs = Options -> Int
oJobs Options
options
numAsserts :: Int
numAsserts = [Int] -> Int
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum ([Int] -> Int) -> [Int] -> Int
forall a b. (a -> b) -> a -> b
$
(Execution -> Int) -> [Execution] -> [Int]
forall a b. (a -> b) -> [a] -> [b]
map ([Assert FilePath] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Assert FilePath] -> Int)
-> (Execution -> [Assert FilePath]) -> Execution -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Spec FilePath -> [Assert FilePath]
forall a. Spec a -> [Assert a]
specAsserts (Spec FilePath -> [Assert FilePath])
-> (Execution -> Spec FilePath) -> Execution -> [Assert FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Execution -> Spec FilePath
executionSpec) [Execution]
executions
Logger -> [FilePath] -> IO ()
logOut (Env -> Logger
envLogger Env
env) [FilePath
"1.." FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numAsserts]
IORef [Execution]
pool <- [Execution] -> IO (IORef [Execution])
forall a. a -> IO (IORef a)
IORef.newIORef [Execution]
executions
Int -> IO () -> IO ()
forall a. Int -> IO a -> IO ()
Async.replicateConcurrently_ Int
numJobs (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef [Execution] -> (Execution -> IO ()) -> IO ()
forall a. IORef [a] -> (a -> IO ()) -> IO ()
worker IORef [Execution]
pool ((Execution -> IO ()) -> IO ()) -> (Execution -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Execution
execution -> do
ExecutionResult
executionResult <- Env -> Execution -> IO ExecutionResult
runExecution Env
env Execution
execution
[Assert FilePath] -> (Assert FilePath -> IO ()) -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ (Spec FilePath -> [Assert FilePath]
forall a. Spec a -> [Assert a]
specAsserts (Spec FilePath -> [Assert FilePath])
-> Spec FilePath -> [Assert FilePath]
forall a b. (a -> b) -> a -> b
$ Execution -> Spec FilePath
executionSpec Execution
execution) ((Assert FilePath -> IO ()) -> IO ())
-> (Assert FilePath -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Assert FilePath
assert -> do
AssertResult
assertResult <- Env
-> Execution
-> ExecutionResult
-> Assert FilePath
-> IO AssertResult
runAssert Env
env Execution
execution ExecutionResult
executionResult Assert FilePath
assert
Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (AssertResult -> Bool
arOk AssertResult
assertResult) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ IORef Int -> (Int -> (Int, ())) -> IO ()
forall a b. IORef a -> (a -> (a, b)) -> IO b
IORef.atomicModifyIORef' IORef Int
failed ((Int -> (Int, ())) -> IO ()) -> (Int -> (Int, ())) -> IO ()
forall a b. (a -> b) -> a -> b
$
\Int
x -> (Int
x Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1, ())
Logger -> [FilePath] -> IO ()
logOut (Env -> Logger
envLogger Env
env) ([FilePath] -> IO ()) -> [FilePath] -> IO ()
forall a b. (a -> b) -> a -> b
$ AssertResult -> [FilePath]
assertResultToTap AssertResult
assertResult
Int
numFailed <- IORef Int -> IO Int
forall a. IORef a -> IO a
IORef.readIORef IORef Int
failed
Logger -> [FilePath] -> IO ()
logOut (Env -> Logger
envLogger Env
env) ([FilePath] -> IO ())
-> (FilePath -> [FilePath]) -> FilePath -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> [FilePath]
forall a. a -> [a]
forall (f :: * -> *) a. Applicative f => a -> f a
pure (FilePath -> IO ()) -> FilePath -> IO ()
forall a b. (a -> b) -> a -> b
$
FilePath
"# goldplate ran " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numAsserts FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" asserts, " FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++
(if Int
numFailed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> FilePath
forall a. Show a => a -> FilePath
show Int
numFailed FilePath -> FilePath -> FilePath
forall a. [a] -> [a] -> [a]
++ FilePath
" failed" else FilePath
"all OK")
ExitCode -> IO ExitCode
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ExitCode -> IO ExitCode) -> ExitCode -> IO ExitCode
forall a b. (a -> b) -> a -> b
$ if Int
numFailed Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0 then Int -> ExitCode
ExitFailure Int
1 else ExitCode
ExitSuccess
main :: IO ()
main :: IO ()
main = do
Options
options <- ParserInfo Options -> IO Options
forall a. ParserInfo a -> IO a
OA.execParser ParserInfo Options
parserInfo
Options -> IO ExitCode
mainWith Options
options IO ExitCode -> (ExitCode -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ExitCode -> IO ()
forall a. ExitCode -> IO a
exitWith