{-# OPTIONS_GHC -fno-warn-orphans #-}
{-# LANGUAGE FlexibleInstances          #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}
{-# LANGUAGE StandaloneDeriving         #-}

module Test.Hspec.Dirstream
    ( -- Functions to generate a `Spec`
      testFiles
    , testFilesErr
    , testFilesIO
    , testFilesPure
    -- * Configuration helper functions
    , dirFiles
    , allFiles
    -- * Helper functions for dealing with file extensions
    , F.extension
    , hasExtension
    -- * Types and type synonyms
    , FileProcessor (..)
    , PathFilter
    , Recursor
    , PathProducer
    , SafeSpecM
    ) where

import           Control.Monad.Fail        (MonadFail (..))
import           Data.DirStream
import           Data.Text                 (Text)
import qualified Filesystem.Path.CurrentOS as F
import           Pipes
import qualified Pipes.Prelude             as P
import           Pipes.Safe
import           System.FilePath           hiding (hasExtension)
import           Test.Hspec
import           Test.Hspec.Core.Spec

deriving instance MonadCatch (SpecM a)
deriving instance MonadThrow (SpecM a)
deriving instance MonadMask (SpecM a)
deriving instance MonadIO (SpecM a)

instance MonadFail (SpecM a) where
    fail :: String -> SpecM a a
fail = String -> SpecM a a
forall a. HasCallStack => String -> a
error

hasExtension :: Text -> F.FilePath -> Bool
hasExtension :: Text -> FilePath -> Bool
hasExtension = (FilePath -> Text -> Bool) -> Text -> FilePath -> Bool
forall a b c. (a -> b -> c) -> b -> a -> c
flip FilePath -> Text -> Bool
F.hasExtension

mapS :: (a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r
mapS :: (a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r
mapS a -> SpecM () ()
act = (a -> SafeT (SpecM ()) ()) -> Consumer' a (SafeT (SpecM ())) r
forall (m :: * -> *) a r. Monad m => (a -> m ()) -> Consumer' a m r
P.mapM_ (\a
x -> SpecM () () -> SafeT (SpecM ()) ()
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (a -> SpecM () ()
act a
x))

type SafeSpecM = SafeT (SpecM ())
type Recursor = F.FilePath -> ListT SafeSpecM F.FilePath
type PathProducer = String -> PathFilter -> Producer String SafeSpecM ()

dirFiles :: PathProducer
dirFiles :: PathProducer
dirFiles = Recursor -> PathProducer
getDirFiles Recursor
forall (m :: * -> *).
(MonadSafe m, MonadFail m) =>
FilePath -> ListT m FilePath
childOf

allFiles :: PathProducer
allFiles :: PathProducer
allFiles = Recursor -> PathProducer
getDirFiles Recursor
forall (m :: * -> *).
(MonadSafe m, MonadFail m) =>
FilePath -> ListT m FilePath
descendentOf

getDirFiles :: Recursor -> PathProducer
getDirFiles :: Recursor -> PathProducer
getDirFiles Recursor
g String
dir FilePath -> Bool
p = ListT (SafeT (SpecM ())) FilePath
-> Proxy X () () FilePath (SafeT (SpecM ())) ()
forall (m :: * -> *) (t :: (* -> *) -> * -> *) a x' x.
(Monad m, Enumerable t) =>
t m a -> Proxy x' x () a m ()
every (Recursor
g FilePath
path) Proxy X () () FilePath (SafeT (SpecM ())) ()
-> Proxy () FilePath () FilePath (SafeT (SpecM ())) ()
-> Proxy X () () FilePath (SafeT (SpecM ())) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (FilePath -> Bool)
-> Proxy () FilePath () FilePath (SafeT (SpecM ())) ()
forall (m :: * -> *) a r. Functor m => (a -> Bool) -> Pipe a a m r
P.filter FilePath -> Bool
p Proxy X () () FilePath (SafeT (SpecM ())) ()
-> Proxy () FilePath () String (SafeT (SpecM ())) ()
-> Proxy X () () String (SafeT (SpecM ())) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (FilePath -> String)
-> Proxy () FilePath () String (SafeT (SpecM ())) ()
forall (m :: * -> *) a b r. Functor m => (a -> b) -> Pipe a b m r
P.map FilePath -> String
F.encodeString
    where path :: FilePath
path = String -> FilePath
F.decodeString String
dir

-- | Helper function to generate a spec. The spec runs on the given directory,
-- filtering by the given function. It then compares their output to the text of
-- the file with @.out@ as the new extension.
--
-- As an example, consider the directory structure
--
-- > test/data
-- > ├── file.hs
-- > └── file.out
--
-- If we have a function called @formatFile@ and we run
--
-- > testFiles "test/data" (hasExtension "hs") formatFile
--
-- This would read @test\/data\/file.hs@, format the file if it can, and compare
-- the output to the contents of @test\/data\/file.out@.
testFiles :: (Eq a, Show a)
          => FilePath -- ^ Base directory
          -> (F.FilePath -> Bool) -- ^ Filter on file extensions
          -> (String -> Either a String) -- ^ Function to process a file
          -> SpecWith ()
testFiles :: String
-> (FilePath -> Bool) -> (String -> Either a String) -> SpecM () ()
testFiles = ((String -> Either a String) -> String -> SpecM () ())
-> PathProducer
-> String
-> (FilePath -> Bool)
-> (String -> Either a String)
-> SpecM () ()
forall a.
(a -> String -> SpecM () ())
-> PathProducer -> String -> (FilePath -> Bool) -> a -> SpecM () ()
testHelper (String -> Either a String) -> String -> SpecM () ()
forall a.
(Eq a, Show a) =>
(String -> Either a String) -> String -> SpecM () ()
testFile PathProducer
dirFiles

testHelper :: (a -> String -> SpecWith ()) -> PathProducer -> String -> PathFilter -> a -> SpecWith ()
testHelper :: (a -> String -> SpecM () ())
-> PathProducer -> String -> (FilePath -> Bool) -> a -> SpecM () ()
testHelper a -> String -> SpecM () ()
testFunction PathProducer
paths String
dir FilePath -> Bool
p = SafeT (SpecM ()) () -> SpecM () ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT (SpecM ()) () -> SpecM () ())
-> (a -> SafeT (SpecM ()) ()) -> a -> SpecM () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ())
-> (a -> Effect (SafeT (SpecM ())) ()) -> a -> SafeT (SpecM ()) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathProducer
paths String
dir FilePath -> Bool
p Proxy X () () String (SafeT (SpecM ())) ()
-> Proxy () String () X (SafeT (SpecM ())) ()
-> Effect (SafeT (SpecM ())) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>->) (Proxy () String () X (SafeT (SpecM ())) ()
 -> Effect (SafeT (SpecM ())) ())
-> (a -> Proxy () String () X (SafeT (SpecM ())) ())
-> a
-> Effect (SafeT (SpecM ())) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> SpecM () ())
-> Proxy () String () X (SafeT (SpecM ())) ()
forall a y' y r.
(a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r
mapS ((String -> SpecM () ())
 -> Proxy () String () X (SafeT (SpecM ())) ())
-> (a -> String -> SpecM () ())
-> a
-> Proxy () String () X (SafeT (SpecM ())) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String -> SpecM () ()
testFunction

testFilesIO :: FilePath
            -> PathFilter
            -> (String -> IO String)
            -> SpecWith ()
testFilesIO :: String
-> (FilePath -> Bool) -> (String -> IO String) -> SpecM () ()
testFilesIO = ((String -> IO String) -> String -> SpecM () ())
-> PathProducer
-> String
-> (FilePath -> Bool)
-> (String -> IO String)
-> SpecM () ()
forall a.
(a -> String -> SpecM () ())
-> PathProducer -> String -> (FilePath -> Bool) -> a -> SpecM () ()
testHelper (String -> IO String) -> String -> SpecM () ()
testFileIO PathProducer
dirFiles

-- | A very general means of testing files, where the check function is pure.
testFilesPure :: (Show b, Eq b)
           => FilePath
           -> PathFilter
           -> PathProducer
           -> FileProcessor a b
           -> SpecWith ()
testFilesPure :: String
-> (FilePath -> Bool)
-> PathProducer
-> FileProcessor a b
-> SpecM () ()
testFilesPure String
dir FilePath -> Bool
p PathProducer
paths = SafeT (SpecM ()) () -> SpecM () ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT (SpecM ()) () -> SpecM () ())
-> (FileProcessor a b -> SafeT (SpecM ()) ())
-> FileProcessor a b
-> SpecM () ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ())
-> (FileProcessor a b -> Effect (SafeT (SpecM ())) ())
-> FileProcessor a b
-> SafeT (SpecM ()) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PathProducer
paths String
dir FilePath -> Bool
p Proxy X () () String (SafeT (SpecM ())) ()
-> Proxy () String () X (SafeT (SpecM ())) ()
-> Effect (SafeT (SpecM ())) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>->) (Proxy () String () X (SafeT (SpecM ())) ()
 -> Effect (SafeT (SpecM ())) ())
-> (FileProcessor a b
    -> Proxy () String () X (SafeT (SpecM ())) ())
-> FileProcessor a b
-> Effect (SafeT (SpecM ())) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (String -> SpecM () ())
-> Proxy () String () X (SafeT (SpecM ())) ()
forall a y' y r.
(a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r
mapS ((String -> SpecM () ())
 -> Proxy () String () X (SafeT (SpecM ())) ())
-> (FileProcessor a b -> String -> SpecM () ())
-> FileProcessor a b
-> Proxy () String () X (SafeT (SpecM ())) ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FileProcessor a b -> String -> SpecM () ()
forall b a.
(Eq b, Show b) =>
FileProcessor a b -> String -> SpecM () ()
testFilePure

testFileIO :: (String -> IO String) -> String -> SpecWith ()
testFileIO :: (String -> IO String) -> String -> SpecM () ()
testFileIO String -> IO String
fun String
f = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
f (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    String
sample <- String -> IO String
readFile String
f
    String
expected <- String -> IO String
readFile (String -> String -> String
replaceExtension String
f String
".out")
    String -> IO String
fun String
sample IO String -> (String -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (String -> String -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` String
expected)

type PathFilter = F.FilePath -> Bool

-- | This function simply tests that each file returns a 'Left' value and that
-- the error message contained therein matches the contents of the appropriate
-- file.
testFilesErr :: (Show b, Eq b) => FilePath -> PathFilter -> (String -> Either String b) -> SpecWith ()
testFilesErr :: String
-> (FilePath -> Bool) -> (String -> Either String b) -> SpecM () ()
testFilesErr String
dir FilePath -> Bool
p String -> Either String b
f = SafeT (SpecM ()) () -> SpecM () ()
forall (m :: * -> *) r.
(MonadMask m, MonadIO m) =>
SafeT m r -> m r
runSafeT (SafeT (SpecM ()) () -> SpecM () ())
-> SafeT (SpecM ()) () -> SpecM () ()
forall a b. (a -> b) -> a -> b
$ Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ()
forall (m :: * -> *) r. Monad m => Effect m r -> m r
runEffect (Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ())
-> Effect (SafeT (SpecM ())) () -> SafeT (SpecM ()) ()
forall a b. (a -> b) -> a -> b
$ PathProducer
dirFiles String
dir FilePath -> Bool
p Proxy X () () String (SafeT (SpecM ())) ()
-> Proxy () String () X (SafeT (SpecM ())) ()
-> Effect (SafeT (SpecM ())) ()
forall (m :: * -> *) a' a b r c' c.
Functor m =>
Proxy a' a () b m r -> Proxy () b c' c m r -> Proxy a' a c' c m r
>-> (String -> SpecM () ())
-> Proxy () String () X (SafeT (SpecM ())) ()
forall a y' y r.
(a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r
mapS ((String -> Either String b) -> String -> SpecM () ()
forall b.
(Eq b, Show b) =>
(String -> Either String b) -> String -> SpecM () ()
testFileErr String -> Either String b
f)

data FileProcessor a b = FileProc { FileProcessor a b -> String -> IO a
reader    :: FilePath -> IO a -- ^ A function to read files
                                  , FileProcessor a b -> a -> b
processor :: a -> b -- ^ A function to process files after they have been read
                                  , FileProcessor a b -> b -> Bool
check     :: b -> Bool -- ^ A predicate to check the output.
                                  }

testFilePure :: (Eq b, Show b) => FileProcessor a b -- ^ How to process a given file
                                      -> String -- ^ File name
                                      -> SpecWith ()
testFilePure :: FileProcessor a b -> String -> SpecM () ()
testFilePure (FileProc String -> IO a
rdr a -> b
g b -> Bool
p) String
f = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
f (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    a
sample <- String -> IO a
rdr String
f
    a -> b
g a
sample b -> (b -> Bool) -> IO ()
forall a. (HasCallStack, Show a) => a -> (a -> Bool) -> IO ()
`shouldSatisfy` b -> Bool
p

testFileErr :: (Eq b, Show b) => (String -> Either String b) -> String -> SpecWith ()
testFileErr :: (String -> Either String b) -> String -> SpecM () ()
testFileErr String -> Either String b
fun String
f = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
f (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    String
sample <- String -> IO String
readFile String
f
    String
expected <- String -> IO String
readFile (String -> String -> String
replaceExtension String
f String
".out")
    String -> Either String b
fun String
sample Either String b -> Either String b -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` String -> Either String b
forall a b. a -> Either a b
Left String
expected

testFile :: (Eq a, Show a) => (String -> Either a String) -> String -> SpecWith ()
testFile :: (String -> Either a String) -> String -> SpecM () ()
testFile String -> Either a String
fun String
f = String -> IO () -> SpecWith (Arg (IO ()))
forall a.
(HasCallStack, Example a) =>
String -> a -> SpecWith (Arg a)
it String
f (IO () -> SpecWith (Arg (IO ())))
-> IO () -> SpecWith (Arg (IO ()))
forall a b. (a -> b) -> a -> b
$ do
    String
sample <- String -> IO String
readFile String
f
    String
expected <- String -> IO String
readFile (String -> String -> String
replaceExtension String
f String
".out")
    String -> Either a String
fun String
sample Either a String -> Either a String -> IO ()
forall a. (HasCallStack, Show a, Eq a) => a -> a -> IO ()
`shouldBe` String -> Either a String
forall a b. b -> Either a b
Right String
expected