{-# 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

--------------------------------------------------------------------------------

-- | This is a little helper type that we use when we either support multiple
-- things (e.g. lines of stdin) or a single thing (e.g. a single string of
-- stdin).
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

--------------------------------------------------------------------------------

-- | A specification that we parse from a JSON file.
-- The type parameter indicates the fields that we allow splicing over.
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"

--------------------------------------------------------------------------------

-- | Post processing of stdout or created files.
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

--------------------------------------------------------------------------------

-- | Asserts that can happen after an execution.
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
        }

--------------------------------------------------------------------------------

-- | A plain 'Spec' parsed from a JSON file usually gives us one more or
-- executions of a process.  This contains more info than a plain 'Spec'.
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)

    -- Compute initial environment to get input files.
    [(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

    -- Get a list of concrete input files (a list maybes).
    [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)

    -- Create an execution for every concrete input.
    [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
        -- Extend environment.
        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

        -- Return execution after doing some splicing.
        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
executionHeader :: Execution -> FilePath
executionHeader 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..."]

    -- Create a "CreateProcess" description.
    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
            }

    -- Actually run the process.
    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

        -- Get output.
        !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
    , AssertResult -> FilePath
arHeader  :: 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)

-- | Check a single assertion.
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 ]


--------------------------------------------------------------------------------

-- | Read a file if it exists, otherwise pretend it's empty.
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

-- | Recursively finds all '.goldplate' files in bunch of files or directories.
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

-- | Perform a glob match in the current directory.
--
-- This is a drop-in replacement for `glob` from the `Glob` library, which has a
-- an annoying tendency to return absolute file paths.
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

--------------------------------------------------------------------------------

-- | Command-line options.
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

--------------------------------------------------------------------------------

-- | Spawn a worker thread that takes workloads from a shared pool.
worker
    :: IORef.IORef [a]                         -- ^ Ref to a pool of work
    -> (a -> IO ())                            -- ^ Worker function
    -> 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)

    -- Find all specs and decode them.
    [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

    -- Each spec might produce a number of executions.  We can't really
    -- parallelize this because 'specExecutions' needs to change the working
    -- directory all the time and that might mess with our tests.
    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

    -- Create a pool full of executions.
    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

    -- Spawn some workers to run the 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

    -- Report summary.
    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