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

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

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

  , copyRewriteJsonFile
  , readJsonFile
  , rewriteJsonFile
  , rewriteLbsJson

  , copyRewriteYamlFile
  , readYamlFile
  , rewriteYamlFile
  , rewriteLbsYaml

  , cat

  , assertIsJsonFile
  , assertIsYamlFile

  , assertFilesExist
  , assertFileOccurences
  , assertFileLines
  , assertEndsWithSingleNewline

  , appendFileTimeDelta
  ) where

import           Control.Monad
import           Control.Monad.IO.Class
import           Data.Aeson (Value)
import           Data.Bool
import           Data.Either
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.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 'filePath' 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
filePath = 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
filePath
  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
filePath

-- | 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
"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.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

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

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

-- | Checks if all files gives exists. If this fails, all files are deleted.
assertFilesExist :: (MonadTest m, MonadIO m, HasCallStack) => [FilePath] -> m ()
assertFilesExist :: forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
[FilePath] -> m ()
assertFilesExist [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
assertFilesExist (FilePath
file:[FilePath]
rest) = 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
  if Bool
exists
    then forall a. HasCallStack => (HasCallStack => a) -> a
GHC.withFrozenCallStack forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *).
(MonadTest m, MonadIO m, HasCallStack) =>
[FilePath] -> m ()
assertFilesExist [FilePath]
rest
    else 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.")

-- | 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"