{-# LANGUAGE BangPatterns #-}
{-# LANGUAGE TypeApplications #-}

module Hedgehog.Extras.Test.File
  ( createDirectoryIfMissing
  , createDirectoryIfMissing_
  , createSubdirectoryIfMissing
  , createSubdirectoryIfMissing_
  , copyFile
  , renameFile
  , createFileLink
  , listDirectory

  , appendFile
  , writeFile
  , openFile
  , readFile
  , lbsWriteFile
  , lbsReadFile
  , textWriteFile
  , textReadFile

  , copyRewriteJsonFile
  , readJsonFile
  , readJsonFileOk
  , rewriteJsonFile
  , rewriteLbsJson

  , copyRewriteYamlFile
  , readYamlFile
  , readYamlFileOk
  , rewriteYamlFile
  , rewriteLbsYaml

  , cat

  , assertIsJsonFile
  , assertIsYamlFile

  , assertFileExists
  , assertFilesExist
  , assertFileMissing
  , assertFilesMissing
  , assertFileOccurences
  , assertFileLines
  , assertEndsWithSingleNewline

  , appendFileTimeDelta
  ) where

import           Control.Applicative (Applicative (..))
import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Aeson (Value)
import           Data.Bool
import           Data.Either
import           Data.Foldable (for_)
import           Data.Function
import           Data.Functor
import           Data.Int
import           Data.Maybe
import           Data.Semigroup
import           Data.String (String)
import           Data.Text (Text)
import           Data.Time.Clock (UTCTime)
import           GHC.Stack (HasCallStack)
import           Hedgehog (MonadTest)
import           Hedgehog.Extras.Stock.Monad
import           Hedgehog.Extras.Stock.OS
import           System.FilePath ((</>))
import           System.IO (FilePath, Handle, IOMode)
import           Text.Show

import qualified Data.Aeson as J
import qualified Data.ByteString.Lazy as LBS
import qualified Data.List as L
import qualified Data.Text.IO as T
import qualified Data.Time.Clock as DTC
import qualified Data.Yaml as Y
import qualified GHC.Stack as GHC
import qualified Hedgehog as H
import qualified Hedgehog.Extras.Test.Base as H
import qualified System.Directory as IO
import qualified System.IO as IO

-- | Create the 'directory' directory if it is missing.
createDirectoryIfMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m FilePath
createDirectoryIfMissing :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
createDirectoryIfMissing FilePath
directory = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Creating directory if missing: " forall a. Semigroup a => a -> a -> a
<> FilePath
directory
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
IO.createDirectoryIfMissing Bool
True FilePath
directory
  forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
directory

-- | Create the 'directory' directory if it is missing.
createDirectoryIfMissing_ :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
createDirectoryIfMissing_ :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
createDirectoryIfMissing_ FilePath
directory = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
createDirectoryIfMissing FilePath
directory

-- | Create the 'subdirectory' subdirectory if it is missing.  The subdirectory is returned.
createSubdirectoryIfMissing :: ()
  => HasCallStack
  => MonadTest m
  => MonadIO m
  => FilePath
  -> FilePath
  -> m FilePath
createSubdirectoryIfMissing :: forall (m :: * -> *).
(HasCallStack, MonadTest m, MonadIO m) =>
FilePath -> FilePath -> m FilePath
createSubdirectoryIfMissing FilePath
parent FilePath
subdirectory = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Creating subdirectory if missing: " forall a. Semigroup a => a -> a -> a
<> FilePath
subdirectory
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ Bool -> FilePath -> IO ()
IO.createDirectoryIfMissing Bool
True forall a b. (a -> b) -> a -> b
$ FilePath
parent FilePath -> FilePath -> FilePath
</> FilePath
subdirectory
  forall (f :: * -> *) a. Applicative f => a -> f a
pure FilePath
subdirectory

-- | Create the 'subdirectory' subdirectory if it is missing.  The subdirectory is returned.
createSubdirectoryIfMissing_ :: ()
  => HasCallStack
  => MonadTest m
  => MonadIO m
  => FilePath
  -> FilePath
  -> m ()
createSubdirectoryIfMissing_ :: forall (m :: * -> *).
(HasCallStack, MonadTest m, MonadIO m) =>
FilePath -> FilePath -> m ()
createSubdirectoryIfMissing_ FilePath
parent FilePath
subdirectory = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(HasCallStack, MonadTest m, MonadIO m) =>
FilePath -> FilePath -> m FilePath
createSubdirectoryIfMissing FilePath
parent FilePath
subdirectory

-- | Copy the contents of the 'src' file to the 'dst' file.
copyFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m ()
copyFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
copyFile FilePath
src FilePath
dst = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Copying from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
src forall a. Semigroup a => a -> a -> a
<> FilePath
" to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
dst
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.copyFile FilePath
src FilePath
dst

-- | Rename the 'src' file to 'dst'.
renameFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m ()
renameFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
renameFile FilePath
src FilePath
dst = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Renaming from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
src forall a. Semigroup a => a -> a -> a
<> FilePath
" to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
dst
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.renameFile FilePath
src FilePath
dst

-- | Create a symbolic link from 'dst' to 'src'.
createFileLink :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> m ()
createFileLink :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
createFileLink FilePath
src FilePath
dst = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Creating link from " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
dst forall a. Semigroup a => a -> a -> a
<> FilePath
" to " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> FilePath
show FilePath
src
  if Bool
isWin32
    then forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.copyFile FilePath
src FilePath
dst
    else forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.createFileLink FilePath
src FilePath
dst

-- | List 'p' directory.
listDirectory :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m [FilePath]
listDirectory :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m [FilePath]
listDirectory FilePath
p = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Listing directory: " forall a. Semigroup a => a -> a -> a
<> FilePath
p
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
IO.listDirectory FilePath
p

-- | Append 'contents' to the 'filePath' file.
appendFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m ()
appendFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
appendFile FilePath
filePath FilePath
contents = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.appendFile FilePath
filePath FilePath
contents

-- | Write 'contents' to the 'filePath' file.
writeFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> String -> m ()
writeFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
writeFile FilePath
filePath FilePath
contents = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> FilePath -> IO ()
IO.writeFile FilePath
filePath FilePath
contents

-- | Open a handle to the 'filePath' file.
openFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> IOMode -> m Handle
openFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> IOMode -> m Handle
openFile FilePath
filePath IOMode
mode = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Opening file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IOMode -> IO Handle
IO.openFile FilePath
filePath IOMode
mode

-- | Read the contents of the 'filePath' file.
readFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m String
readFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
readFile FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Reading file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO FilePath
IO.readFile FilePath
filePath

-- | Write 'contents' to the 'filePath' file.
lbsWriteFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> LBS.ByteString -> m ()
lbsWriteFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> ByteString -> m ()
lbsWriteFile FilePath
filePath ByteString
contents = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> ByteString -> IO ()
LBS.writeFile FilePath
filePath ByteString
contents

-- | Read the contents of the 'filePath' file.
lbsReadFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m LBS.ByteString
lbsReadFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ByteString
lbsReadFile FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Reading file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO ByteString
LBS.readFile FilePath
filePath

-- | Write 'contents' to the 'filePath' file.
textWriteFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> Text -> m ()
textWriteFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> Text -> m ()
textWriteFile FilePath
filePath Text
contents = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Writing file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> Text -> IO ()
T.writeFile FilePath
filePath Text
contents

-- | Read the contents of the 'filePath' file.
textReadFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Text
textReadFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Text
textReadFile FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Reading file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Text
T.readFile FilePath
filePath

-- | Read the 'filePath' file as JSON.
readJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either String Value)
readJsonFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m (Either FilePath Value)
readJsonFile FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Reading JSON file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either FilePath a
J.eitherDecode @Value forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
LBS.readFile FilePath
filePath

-- | Read the 'filePath' file as JSON. Same as 'readJsonFile' but fails on error.
readJsonFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value
readJsonFileOk :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Value
readJsonFileOk FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) e a.
(MonadTest m, Show e, HasCallStack) =>
m (Either e a) -> m a
H.leftFailM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m (Either FilePath Value)
readJsonFile FilePath
filePath

rewriteLbsJson :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString
rewriteLbsJson :: forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
(Value -> Value) -> ByteString -> m ByteString
rewriteLbsJson Value -> Value
f ByteString
lbs = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  case forall a. FromJSON a => ByteString -> Either FilePath a
J.eitherDecode ByteString
lbs of
    Right Value
iv -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
J.encode (Value -> Value
f Value
iv))
    Left FilePath
msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack FilePath
msg

-- | Rewrite the 'filePath' JSON file using the function 'f'.
rewriteJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m ()
rewriteJsonFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> (Value -> Value) -> m ()
rewriteJsonFile FilePath
filePath Value -> Value
f = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Rewriting JSON file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ByteString
lbsReadFile FilePath
filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
(Value -> Value) -> ByteString -> m ByteString
rewriteLbsJson Value -> Value
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> ByteString -> m ()
lbsWriteFile FilePath
filePath

-- | Rewrite the 'filePath' JSON file using the function 'f'.
copyRewriteJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m ()
copyRewriteJsonFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> (Value -> Value) -> m ()
copyRewriteJsonFile FilePath
src FilePath
dst Value -> Value
f = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Rewriting JSON from file: " forall a. Semigroup a => a -> a -> a
<> FilePath
src forall a. Semigroup a => a -> a -> a
<> FilePath
" to file " forall a. Semigroup a => a -> a -> a
<> FilePath
dst
  forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ByteString
lbsReadFile FilePath
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
(Value -> Value) -> ByteString -> m ByteString
rewriteLbsJson Value -> Value
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> ByteString -> m ()
lbsWriteFile FilePath
dst

-- | Read the 'filePath' file as YAML.
readYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m (Either Y.ParseException Value)
readYamlFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m (Either ParseException Value)
readYamlFile FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Reading YAML file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' @Value forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> ByteString
LBS.toStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO ByteString
LBS.readFile FilePath
filePath

-- | Read the 'filePath' file as YAML.  Same as 'readYamlFile' but fails on error.
readYamlFileOk :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m Value
readYamlFileOk :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m Value
readYamlFileOk FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) e a.
(MonadTest m, Show e, HasCallStack) =>
m (Either e a) -> m a
H.leftFailM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m (Either ParseException Value)
readYamlFile FilePath
filePath

rewriteLbsYaml :: (MonadTest m, HasCallStack) => (Value -> Value) -> LBS.ByteString -> m LBS.ByteString
rewriteLbsYaml :: forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
(Value -> Value) -> ByteString -> m ByteString
rewriteLbsYaml Value -> Value
f ByteString
lbs = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  case forall a. FromJSON a => ByteString -> Either ParseException a
Y.decodeEither' (ByteString -> ByteString
LBS.toStrict ByteString
lbs) of
    Right Value
iv -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. ToJSON a => a -> ByteString
J.encode (Value -> Value
f Value
iv))
    Left ParseException
msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack (forall a. Show a => a -> FilePath
show ParseException
msg)

-- | Rewrite the 'filePath' YAML file using the function 'f'.
rewriteYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> (Value -> Value) -> m ()
rewriteYamlFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> (Value -> Value) -> m ()
rewriteYamlFile FilePath
filePath Value -> Value
f = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Rewriting YAML file: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath
  forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ByteString
lbsReadFile FilePath
filePath forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
(Value -> Value) -> ByteString -> m ByteString
rewriteLbsYaml Value -> Value
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> ByteString -> m ()
lbsWriteFile FilePath
filePath

-- | Rewrite the 'filePath' YAML file using the function 'f'.
copyRewriteYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> FilePath -> (Value -> Value) -> m ()
copyRewriteYamlFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> (Value -> Value) -> m ()
copyRewriteYamlFile FilePath
src FilePath
dst Value -> Value
f = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ FilePath
"Rewriting YAML from file: " forall a. Semigroup a => a -> a -> a
<> FilePath
src forall a. Semigroup a => a -> a -> a
<> FilePath
" to file " forall a. Semigroup a => a -> a -> a
<> FilePath
dst
  forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ByteString
lbsReadFile FilePath
src forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
(Value -> Value) -> ByteString -> m ByteString
rewriteLbsYaml Value -> Value
f forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> ByteString -> m ()
lbsWriteFile FilePath
dst

-- | Annotate the contents of the 'filePath' file.
cat :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
cat :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
cat FilePath
filePath = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  !FilePath
contents <- forall (m :: * -> *) a. (Monad m, NFData a) => m a -> m a
forceM forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
readFile FilePath
filePath
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (m :: * -> *).
(MonadTest m, HasCallStack) =>
FilePath -> m ()
H.annotate forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
L.unlines
    [ FilePath
"━━━━ File: " forall a. Semigroup a => a -> a -> a
<> FilePath
filePath forall a. Semigroup a => a -> a -> a
<> FilePath
" ━━━━"
    , FilePath
contents
    ]
  forall (m :: * -> *) a. Monad m => a -> m a
return ()

-- | Assert the 'filePath' can be parsed as JSON.
assertIsJsonFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertIsJsonFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertIsJsonFile FilePath
fp = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  Either FilePath Value
jsonResult <- forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m (Either FilePath Value)
readJsonFile FilePath
fp
  case Either FilePath Value
jsonResult of
    Right Value
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left FilePath
msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack FilePath
msg

-- | Assert the 'filePath' can be parsed as YAML.
assertIsYamlFile :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertIsYamlFile :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertIsYamlFile FilePath
fp = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  Either FilePath Value
result <- forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m (Either FilePath Value)
readJsonFile FilePath
fp
  case Either FilePath Value
result of
    Right Value
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Left FilePath
msg -> forall (m :: * -> *) a. MonadTest m => CallStack -> FilePath -> m a
H.failMessage HasCallStack => CallStack
GHC.callStack FilePath
msg

-- | Asserts that the given file exists.
assertFileExists :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertFileExists :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertFileExists FilePath
file = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  Bool
exists <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
IO.doesFileExist FilePath
file
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
exists forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> FilePath -> m a
H.failWithCustom HasCallStack => CallStack
GHC.callStack forall a. Maybe a
Nothing (FilePath
file forall a. Semigroup a => a -> a -> a
<> FilePath
" has not been successfully created.")

-- | Asserts that all of the given files exist.
assertFilesExist :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m ()
assertFilesExist :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
[FilePath] -> m ()
assertFilesExist [FilePath]
files = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [FilePath]
files forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertFileExists

-- | Asserts that the given file is missing.
assertFileMissing :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertFileMissing :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertFileMissing FilePath
file = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  Bool
exists <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack) =>
IO a -> m a
H.evalIO forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
IO.doesFileExist FilePath
file
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
exists forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> FilePath -> m a
H.failWithCustom HasCallStack => CallStack
GHC.callStack forall a. Maybe a
Nothing (FilePath
file forall a. Semigroup a => a -> a -> a
<> FilePath
" should not have been created.")

-- | Asserts that all of the given files are missing.
assertFilesMissing :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m ()
assertFilesMissing :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
[FilePath] -> m ()
assertFilesMissing [FilePath]
files = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ [FilePath]
files forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertFileMissing

-- | Assert the file contains the given number of occurrences of the given string
assertFileOccurences :: (MonadTest m, MonadIO m, HasCallStack) => Int -> String -> FilePath -> m ()
assertFileOccurences :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
Int -> FilePath -> FilePath -> m ()
assertFileOccurences Int
n FilePath
s FilePath
fp = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  FilePath
contents <- forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
readFile FilePath
fp

  forall (t :: * -> *) a. Foldable t => t a -> Int
L.length (forall a. (a -> Bool) -> [a] -> [a]
L.filter (FilePath
s forall a. Eq a => [a] -> [a] -> Bool
`L.isInfixOf`) (FilePath -> [FilePath]
L.lines FilePath
contents)) forall (m :: * -> *) a.
(MonadTest m, Eq a, Show a, HasCallStack) =>
a -> a -> m ()
H.=== Int
n

-- | Assert the file contains the given number of occurrences of the given string
assertFileLines :: (MonadTest m, MonadIO m, HasCallStack) => (Int -> Bool) -> FilePath -> m ()
assertFileLines :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
(Int -> Bool) -> FilePath -> m ()
assertFileLines Int -> Bool
p FilePath
fp = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  FilePath
contents <- forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
readFile FilePath
fp

  let lines :: [FilePath]
lines = FilePath -> [FilePath]
L.lines FilePath
contents

  let len :: Int
len = case forall a. [a] -> [a]
L.reverse [FilePath]
lines of
        FilePath
"":[FilePath]
xs -> forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
xs
        [FilePath]
xs -> forall (t :: * -> *) a. Foldable t => t a -> Int
L.length [FilePath]
xs

  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Int -> Bool
p Int
len) forall a b. (a -> b) -> a -> b
$ do
    forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> FilePath -> m a
H.failWithCustom HasCallStack => CallStack
GHC.callStack forall a. Maybe a
Nothing (FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
" has an unexpected number of lines")

-- | Assert the file contains the given number of occurrences of the given string
assertEndsWithSingleNewline :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> m ()
assertEndsWithSingleNewline :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m ()
assertEndsWithSingleNewline FilePath
fp = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  FilePath
contents <- forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> m FilePath
readFile FilePath
fp

  case forall a. [a] -> [a]
L.reverse FilePath
contents of
    Char
'\n':Char
'\n':FilePath
_ -> forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> FilePath -> m a
H.failWithCustom HasCallStack => CallStack
GHC.callStack forall a. Maybe a
Nothing (FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
" ends with too many newlines.")
    Char
'\n':FilePath
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
    FilePath
_ -> forall (m :: * -> *) a.
MonadTest m =>
CallStack -> Maybe Diff -> FilePath -> m a
H.failWithCustom HasCallStack => CallStack
GHC.callStack forall a. Maybe a
Nothing (FilePath
fp forall a. Semigroup a => a -> a -> a
<> FilePath
" must end with newline.")

-- | Write 'contents' to the 'filePath' file.
appendFileTimeDelta :: (MonadTest m, MonadIO m, HasCallStack) => FilePath -> UTCTime ->  m ()
appendFileTimeDelta :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> UTCTime -> m ()
appendFileTimeDelta FilePath
filePath UTCTime
offsetTime = forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ do
  UTCTime
baseTime <- forall (m :: * -> *) a.
(MonadTest m, MonadIO m, HasCallStack, Show a) =>
IO a -> m a
H.noteShowIO IO UTCTime
DTC.getCurrentTime
  let delay :: NominalDiffTime
delay = UTCTime -> UTCTime -> NominalDiffTime
DTC.diffUTCTime UTCTime
baseTime UTCTime
offsetTime
  forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
FilePath -> FilePath -> m ()
appendFile FilePath
filePath forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> FilePath
show @DTC.NominalDiffTime NominalDiffTime
delay forall a. Semigroup a => a -> a -> a
<> FilePath
"\n"