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

hasExtension :: Text -> F.FilePath -> Bool
hasExtension = flip F.hasExtension

mapS :: (a -> SpecM () ()) -> Proxy () a y' y (SafeT (SpecM ())) r
mapS act = P.mapM_ (\x -> lift (act x))

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

dirFiles :: PathProducer
dirFiles = getDirFiles childOf

allFiles :: PathProducer
allFiles = getDirFiles descendentOf

getDirFiles :: Recursor -> PathProducer
getDirFiles g dir p = every (g path) >-> P.filter p >-> P.map F.encodeString
    where path = F.decodeString 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 = testHelper testFile dirFiles

testHelper :: (a -> String -> SpecWith ()) -> PathProducer -> String -> PathFilter -> a -> SpecWith ()
testHelper testFunction paths dir p = runSafeT . runEffect . (paths dir p >->) . mapS . testFunction

testFilesIO :: FilePath
            -> PathFilter
            -> (String -> IO String)
            -> SpecWith ()
testFilesIO = testHelper testFileIO 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 dir p paths = runSafeT . runEffect . (paths dir p >->) . mapS . testFilePure

testFileIO :: (String -> IO String) -> String -> SpecWith ()
testFileIO fun f = it f $ do
    sample <- readFile f
    expected <- readFile (replaceExtension f ".out")
    fun sample >>= (`shouldBe` 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 dir p f = runSafeT $ runEffect $ dirFiles dir p >-> mapS (testFileErr f)

data FileProcessor a b = FileProc { reader    :: FilePath -> IO a -- ^ A function to read files
                                  , processor :: a -> b -- ^ A function to process files after they have been read
                                  , 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 (FileProc rdr g p) f = it f $ do
    sample <- rdr f
    g sample `shouldSatisfy` p

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

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