{-# LANGUAGE FlexibleInstances, OverloadedStrings #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-- | A preprocessor that finds and combines specs.
--
-- /NOTE:/ This module is not meant for public consumption.  For user
-- documentation look at https://hspec.github.io/hspec-discover.html.
module Test.Hspec.Discover.Run (
  run

-- exported for testing
, Spec(..)
, importList
, driverWithFormatter
, moduleNameFromId
, pathToModule
, Tree(..)
, Forest(..)
, Hook(..)
, discover
) where
import           Control.Monad
import           Control.Applicative
import           Data.List
import           Data.Char
import           Data.Maybe
import           Data.String
import           System.Environment
import           System.Exit
import           System.IO
import           System.Directory (doesDirectoryExist, getDirectoryContents, doesFileExist)
import           System.FilePath hiding (combine)

import           Test.Hspec.Discover.Config
import           Test.Hspec.Discover.Sort

instance IsString ShowS where
  fromString :: FilePath -> ShowS
fromString = FilePath -> ShowS
showString

data Spec = Spec String | Hook String [Spec]
  deriving (Spec -> Spec -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Spec -> Spec -> Bool
$c/= :: Spec -> Spec -> Bool
== :: Spec -> Spec -> Bool
$c== :: Spec -> Spec -> Bool
Eq, Int -> Spec -> ShowS
[Spec] -> ShowS
Spec -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Spec] -> ShowS
$cshowList :: [Spec] -> ShowS
show :: Spec -> FilePath
$cshow :: Spec -> FilePath
showsPrec :: Int -> Spec -> ShowS
$cshowsPrec :: Int -> Spec -> ShowS
Show)

run :: [String] -> IO ()
run :: [FilePath] -> IO ()
run [FilePath]
args_ = do
  FilePath
name <- IO FilePath
getProgName
  case [FilePath]
args_ of
    FilePath
src : FilePath
_ : FilePath
dst : [FilePath]
args -> case FilePath -> [FilePath] -> Either FilePath Config
parseConfig FilePath
name [FilePath]
args of
      Left FilePath
err -> do
        Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
err
        forall a. IO a
exitFailure
      Right Config
conf -> do
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configNested Config
conf)             (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"hspec-discover: WARNING - The `--nested' option is deprecated and will be removed in a future release!")
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Config -> Bool
configNoMain Config
conf)             (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"hspec-discover: WARNING - The `--no-main' option is deprecated and will be removed in a future release!")
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust forall a b. (a -> b) -> a -> b
$ Config -> Maybe FilePath
configFormatter Config
conf) (Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr FilePath
"hspec-discover: WARNING - The `--formatter' option is deprecated and will be removed in a future release!")
        Maybe [Spec]
specs <- FilePath -> IO (Maybe [Spec])
findSpecs FilePath
src
        FilePath -> FilePath -> IO ()
writeFile FilePath
dst (FilePath -> Config -> Maybe [Spec] -> FilePath
mkSpecModule FilePath
src Config
conf Maybe [Spec]
specs)
    [FilePath]
_ -> do
      Handle -> FilePath -> IO ()
hPutStrLn Handle
stderr (ShowS
usage FilePath
name)
      forall a. IO a
exitFailure

mkSpecModule :: FilePath -> Config -> Maybe [Spec] -> String
mkSpecModule :: FilePath -> Config -> Maybe [Spec] -> FilePath
mkSpecModule FilePath
src Config
conf Maybe [Spec]
nodes =
  ( ShowS
"{-# LINE 1 " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows FilePath
src forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" #-}\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"{-# LANGUAGE NoImplicitPrelude #-}\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"{-# OPTIONS_GHC -w -Wall -fno-warn-warnings-deprecations #-}\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString (FilePath
"module " forall a. [a] -> [a] -> [a]
++ FilePath -> Config -> FilePath
moduleName FilePath
src Config
conf forall a. [a] -> [a] -> [a]
++FilePath
" where\n")
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Spec] -> ShowS
importList Maybe [Spec]
nodes
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"import Test.Hspec.Discover\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
driver FilePath -> ShowS
driverWithFormatter (Config -> Maybe FilePath
configFormatter Config
conf)
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"spec :: Spec\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"spec = "
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe [Spec] -> ShowS
formatSpecs Maybe [Spec]
nodes
  ) FilePath
"\n"
  where
    driver :: ShowS
driver =
        case Config -> Bool
configNoMain Config
conf of
          Bool
False ->
              FilePath -> ShowS
showString FilePath
"main :: IO ()\n"
            forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"main = hspec spec\n"
          Bool
True -> ShowS
""

moduleName :: FilePath -> Config -> String
moduleName :: FilePath -> Config -> FilePath
moduleName FilePath
src Config
conf = forall a. a -> Maybe a -> a
fromMaybe (if Config -> Bool
configNoMain Config
conf then ShowS
pathToModule FilePath
src else FilePath
"Main") (Config -> Maybe FilePath
configModuleName Config
conf)

-- | Derive module name from specified path.
pathToModule :: FilePath -> String
pathToModule :: ShowS
pathToModule FilePath
f = Char -> Char
toUpper Char
mforall a. a -> [a] -> [a]
:FilePath
ms
  where
    fileName :: FilePath
fileName = forall a. [a] -> a
last forall a b. (a -> b) -> a -> b
$ FilePath -> [FilePath]
splitDirectories FilePath
f
    Char
m:FilePath
ms = forall a. (a -> Bool) -> [a] -> [a]
takeWhile (forall a. Eq a => a -> a -> Bool
/=Char
'.') FilePath
fileName

driverWithFormatter :: String -> ShowS
driverWithFormatter :: FilePath -> ShowS
driverWithFormatter FilePath
f =
    FilePath -> ShowS
showString FilePath
"import qualified " forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString (ShowS
moduleNameFromId FilePath
f) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"main :: IO ()\n"
  forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
"main = hspecWithFormatter " forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
" spec\n"

-- | Return module name of a fully qualified identifier.
moduleNameFromId :: String -> String
moduleNameFromId :: ShowS
moduleNameFromId = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
== Char
'.') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile (forall a. Eq a => a -> a -> Bool
/= Char
'.') forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- | Generate imports for a list of specs.
importList :: Maybe [Spec] -> ShowS
importList :: Maybe [Spec] -> ShowS
importList = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map FilePath -> ShowS
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] [Spec] -> [FilePath]
moduleNames
  where
    f :: String -> ShowS
    f :: FilePath -> ShowS
f FilePath
spec = ShowS
"import qualified " forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
spec forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
"\n"

moduleNames :: [Spec] -> [String]
moduleNames :: [Spec] -> [FilePath]
moduleNames = [Spec] -> [FilePath]
fromForest
  where
    fromForest :: [Spec] -> [String]
    fromForest :: [Spec] -> [FilePath]
fromForest = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Spec -> [FilePath]
fromTree

    fromTree :: Spec -> [String]
    fromTree :: Spec -> [FilePath]
fromTree Spec
tree = case Spec
tree of
      Spec FilePath
name -> [FilePath
name forall a. [a] -> [a] -> [a]
++ FilePath
"Spec"]
      Hook FilePath
name [Spec]
forest -> FilePath
name forall a. a -> [a] -> [a]
: [Spec] -> [FilePath]
fromForest [Spec]
forest

-- | Combine a list of strings with (>>).
sequenceS :: [ShowS] -> ShowS
sequenceS :: [ShowS] -> ShowS
sequenceS = forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall b c a. (b -> c) -> (a -> b) -> a -> c
(.) ShowS
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. a -> [a] -> [a]
intersperse ShowS
" >> "

formatSpecs :: Maybe [Spec] -> ShowS
formatSpecs :: Maybe [Spec] -> ShowS
formatSpecs = forall b a. b -> (a -> b) -> Maybe a -> b
maybe ShowS
"return ()" [Spec] -> ShowS
fromForest
  where
    fromForest :: [Spec] -> ShowS
    fromForest :: [Spec] -> ShowS
fromForest = [ShowS] -> ShowS
sequenceS forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Spec -> ShowS
fromTree

    fromTree :: Spec -> ShowS
    fromTree :: Spec -> ShowS
fromTree Spec
tree = case Spec
tree of
      Spec FilePath
name -> ShowS
"describe " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> ShowS
shows FilePath
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
" " forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
"Spec.spec"
      Hook FilePath
name [Spec]
forest -> ShowS
"(" forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> ShowS
showString FilePath
name forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
".hook $ " forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Spec] -> ShowS
fromForest [Spec]
forest forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShowS
")"

findSpecs :: FilePath -> IO (Maybe [Spec])
findSpecs :: FilePath -> IO (Maybe [Spec])
findSpecs = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Forest -> [Spec]
toSpecs) forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> IO (Maybe Forest)
discover

toSpecs :: Forest -> [Spec]
toSpecs :: Forest -> [Spec]
toSpecs = [FilePath] -> Forest -> [Spec]
fromForest []
  where
    fromForest :: [String] -> Forest -> [Spec]
    fromForest :: [FilePath] -> Forest -> [Spec]
fromForest [FilePath]
names (Forest Hook
WithHook [Tree]
xs) = [FilePath -> [Spec] -> Spec
Hook ([FilePath] -> FilePath
mkModule (FilePath
"SpecHook" forall a. a -> [a] -> [a]
: [FilePath]
names)) forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([FilePath] -> Tree -> [Spec]
fromTree [FilePath]
names) [Tree]
xs]
    fromForest [FilePath]
names (Forest Hook
WithoutHook [Tree]
xs) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ([FilePath] -> Tree -> [Spec]
fromTree [FilePath]
names) [Tree]
xs

    fromTree :: [String] -> Tree -> [Spec]
    fromTree :: [FilePath] -> Tree -> [Spec]
fromTree [FilePath]
names Tree
spec = case Tree
spec of
      Leaf FilePath
name -> [FilePath -> Spec
Spec forall a b. (a -> b) -> a -> b
$ [FilePath] -> FilePath
mkModule (FilePath
name forall a. a -> [a] -> [a]
: [FilePath]
names )]
      Node FilePath
name Forest
forest -> [FilePath] -> Forest -> [Spec]
fromForest (FilePath
name forall a. a -> [a] -> [a]
: [FilePath]
names) Forest
forest

    mkModule :: [String] -> String
    mkModule :: [FilePath] -> FilePath
mkModule = forall a. [a] -> [[a]] -> [a]
intercalate FilePath
"." forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [a] -> [a]
reverse

-- See `Cabal.Distribution.ModuleName` (https://git.io/bj34)
isValidModuleName :: String -> Bool
isValidModuleName :: FilePath -> Bool
isValidModuleName [] = Bool
False
isValidModuleName (Char
c:FilePath
cs) = Char -> Bool
isUpper Char
c Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isValidModuleChar FilePath
cs

isValidModuleChar :: Char -> Bool
isValidModuleChar :: Char -> Bool
isValidModuleChar Char
c = Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\''

data Tree = Leaf String | Node String Forest
  deriving (Tree -> Tree -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Tree -> Tree -> Bool
$c/= :: Tree -> Tree -> Bool
== :: Tree -> Tree -> Bool
$c== :: Tree -> Tree -> Bool
Eq, Int -> Tree -> ShowS
[Tree] -> ShowS
Tree -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Tree] -> ShowS
$cshowList :: [Tree] -> ShowS
show :: Tree -> FilePath
$cshow :: Tree -> FilePath
showsPrec :: Int -> Tree -> ShowS
$cshowsPrec :: Int -> Tree -> ShowS
Show)

data Forest = Forest Hook [Tree]
  deriving (Forest -> Forest -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Forest -> Forest -> Bool
$c/= :: Forest -> Forest -> Bool
== :: Forest -> Forest -> Bool
$c== :: Forest -> Forest -> Bool
Eq, Int -> Forest -> ShowS
[Forest] -> ShowS
Forest -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Forest] -> ShowS
$cshowList :: [Forest] -> ShowS
show :: Forest -> FilePath
$cshow :: Forest -> FilePath
showsPrec :: Int -> Forest -> ShowS
$cshowsPrec :: Int -> Forest -> ShowS
Show)

data Hook = WithHook | WithoutHook
  deriving (Hook -> Hook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Hook -> Hook -> Bool
$c/= :: Hook -> Hook -> Bool
== :: Hook -> Hook -> Bool
$c== :: Hook -> Hook -> Bool
Eq, Int -> Hook -> ShowS
[Hook] -> ShowS
Hook -> FilePath
forall a.
(Int -> a -> ShowS) -> (a -> FilePath) -> ([a] -> ShowS) -> Show a
showList :: [Hook] -> ShowS
$cshowList :: [Hook] -> ShowS
show :: Hook -> FilePath
$cshow :: Hook -> FilePath
showsPrec :: Int -> Hook -> ShowS
$cshowsPrec :: Int -> Hook -> ShowS
Show)

sortKey :: Tree -> (String, Int)
sortKey :: Tree -> (FilePath, Int)
sortKey Tree
tree = case Tree
tree of
  Leaf FilePath
name -> (FilePath
name, Int
0)
  Node FilePath
name Forest
_ -> (FilePath
name, Int
1)

discover :: FilePath -> IO (Maybe Forest)
discover :: FilePath -> IO (Maybe Forest)
discover FilePath
src = (forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Forest -> Maybe Forest
filterSrc) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO (Maybe Forest)
specForest FilePath
dir
  where
    filterSrc :: Forest -> Maybe Forest
    filterSrc :: Forest -> Maybe Forest
filterSrc (Forest Hook
hook [Tree]
xs) = Hook -> [Tree] -> Maybe Forest
ensureForest Hook
hook forall a b. (a -> b) -> a -> b
$ forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. a -> a
id (forall a. (a -> Bool) -> [a] -> [a]
filter forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Eq a => a -> a -> Bool
(/=)) (FilePath -> Maybe Tree
toSpec FilePath
file) [Tree]
xs

    (FilePath
dir, FilePath
file) = FilePath -> (FilePath, FilePath)
splitFileName FilePath
src

specForest :: FilePath -> IO (Maybe Forest)
specForest :: FilePath -> IO (Maybe Forest)
specForest FilePath
dir = do
  [FilePath]
files <- FilePath -> IO [FilePath]
listDirectory FilePath
dir
  Hook
hook <- FilePath -> [FilePath] -> IO Hook
mkHook FilePath
dir [FilePath]
files
  Hook -> [Tree] -> Maybe Forest
ensureForest Hook
hook forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> (FilePath, Int)) -> [a] -> [a]
sortNaturallyBy Tree -> (FilePath, Int)
sortKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. [Maybe a] -> [a]
catMaybes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM FilePath -> IO (Maybe Tree)
toSpecTree [FilePath]
files
  where
    toSpecTree :: FilePath -> IO (Maybe Tree)
    toSpecTree :: FilePath -> IO (Maybe Tree)
toSpecTree FilePath
name
      | FilePath -> Bool
isValidModuleName FilePath
name = do
          FilePath -> IO Bool
doesDirectoryExist (FilePath
dir FilePath -> ShowS
</> FilePath
name) forall a. IO Bool -> a -> IO a -> IO a
`fallback` forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
            Maybe Forest
xs <- FilePath -> IO (Maybe Forest)
specForest (FilePath
dir FilePath -> ShowS
</> FilePath
name)
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Forest -> Tree
Node FilePath
name forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Forest
xs
      | Bool
otherwise = do
          FilePath -> IO Bool
doesFileExist (FilePath
dir FilePath -> ShowS
</> FilePath
name) forall a. IO Bool -> a -> IO a -> IO a
`fallback` forall a. Maybe a
Nothing forall a b. (a -> b) -> a -> b
$ do
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FilePath -> Maybe Tree
toSpec FilePath
name

mkHook :: FilePath -> [FilePath] -> IO Hook
mkHook :: FilePath -> [FilePath] -> IO Hook
mkHook FilePath
dir [FilePath]
files
  | FilePath
"SpecHook.hs" forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FilePath]
files = do
    FilePath -> IO Bool
doesFileExist (FilePath
dir FilePath -> ShowS
</> FilePath
"SpecHook.hs") forall a. IO Bool -> a -> IO a -> IO a
`fallback` Hook
WithoutHook forall a b. (a -> b) -> a -> b
$ do
      forall (m :: * -> *) a. Monad m => a -> m a
return Hook
WithHook
  | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return Hook
WithoutHook

fallback :: IO Bool -> a -> IO a -> IO a
fallback :: forall a. IO Bool -> a -> IO a -> IO a
fallback IO Bool
p a
def IO a
action = do
  Bool
bool <- IO Bool
p
  if Bool
bool then IO a
action else forall (m :: * -> *) a. Monad m => a -> m a
return a
def

toSpec :: FilePath -> Maybe Tree
toSpec :: FilePath -> Maybe Tree
toSpec FilePath
file = FilePath -> Tree
Leaf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Maybe FilePath
spec forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall a. (a -> Bool) -> a -> Maybe a
ensure FilePath -> Bool
isValidModuleName)
  where
    spec :: Maybe String
    spec :: Maybe FilePath
spec = forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
"Spec.hs" FilePath
file forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix FilePath
"Spec.lhs" FilePath
file

    stripSuffix :: Eq a => [a] -> [a] -> Maybe [a]
    stripSuffix :: forall a. Eq a => [a] -> [a] -> Maybe [a]
stripSuffix [a]
suffix [a]
str = forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Eq a => [a] -> [a] -> Maybe [a]
stripPrefix (forall a. [a] -> [a]
reverse [a]
suffix) (forall a. [a] -> [a]
reverse [a]
str)

ensure :: (a -> Bool) -> a -> Maybe a
ensure :: forall a. (a -> Bool) -> a -> Maybe a
ensure a -> Bool
p a
a = forall (f :: * -> *). Alternative f => Bool -> f ()
guard (a -> Bool
p a
a) forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall a. a -> Maybe a
Just a
a

ensureForest :: Hook -> [Tree] -> Maybe Forest
ensureForest :: Hook -> [Tree] -> Maybe Forest
ensureForest Hook
hook = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Hook -> [Tree] -> Forest
Forest Hook
hook) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> a -> Maybe a
ensure (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> Bool
null)

listDirectory :: FilePath -> IO [FilePath]
listDirectory :: FilePath -> IO [FilePath]
listDirectory FilePath
path = forall a. (a -> Bool) -> [a] -> [a]
filter forall {a}. (Eq a, IsString a) => a -> Bool
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
  where f :: a -> Bool
f a
filename = a
filename forall a. Eq a => a -> a -> Bool
/= a
"." Bool -> Bool -> Bool
&& a
filename forall a. Eq a => a -> a -> Bool
/= a
".."