{-# LANGUAGE CPP #-}

module Language.Haskell.Source.Enumerator
  ( enumeratePath
  ) where

import           Conduit
import           Control.Applicative
import           Control.Monad
import           Data.List
import           Distribution.PackageDescription
import qualified Distribution.Verbosity                 as Verbosity
import           System.Directory
import           System.FilePath
#if MIN_VERSION_Cabal(2,2,0)
import           Distribution.PackageDescription.Parsec (readGenericPackageDescription)
#elif MIN_VERSION_Cabal(2,0,0)
import           Distribution.PackageDescription.Parse  (readGenericPackageDescription)
#else
import           Distribution.PackageDescription.Parse  (readPackageDescription)

readGenericPackageDescription ::
     Verbosity.Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription = readPackageDescription
#endif
enumeratePath :: FilePath -> ConduitT () FilePath IO ()
enumeratePath :: FilePath -> ConduitT () FilePath IO ()
enumeratePath FilePath
path = FilePath -> ConduitT () FilePath IO ()
enumPath FilePath
path ConduitT () FilePath IO ()
-> ConduitM FilePath FilePath IO () -> ConduitT () FilePath IO ()
forall (m :: * -> *) a b c r.
Monad m =>
ConduitM a b m () -> ConduitM b c m r -> ConduitM a c m r
.| (FilePath -> FilePath) -> ConduitM FilePath FilePath IO ()
forall (m :: * -> *) a b. Monad m => (a -> b) -> ConduitT a b m ()
mapC FilePath -> FilePath
normalise

enumPath :: FilePath -> ConduitT () FilePath IO ()
enumPath :: FilePath -> ConduitT () FilePath IO ()
enumPath FilePath
path = do
  Bool
isDirectory <- IO Bool -> ConduitT () FilePath IO Bool
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO Bool -> ConduitT () FilePath IO Bool)
-> IO Bool -> ConduitT () FilePath IO Bool
forall a b. (a -> b) -> a -> b
$ FilePath -> IO Bool
doesDirectoryExist FilePath
path
  case Bool
isDirectory of
    Bool
True -> FilePath -> ConduitT () FilePath IO ()
enumDirectory FilePath
path
    Bool
False
      | FilePath -> Bool
hasCabalExtension FilePath
path -> FilePath -> ConduitT () FilePath IO ()
enumPackage FilePath
path
    Bool
False
      | FilePath -> Bool
hasHaskellExtension FilePath
path -> FilePath -> ConduitT () FilePath IO ()
forall (m :: * -> *) o i. Monad m => o -> ConduitT i o m ()
yield FilePath
path
    Bool
False -> () -> ConduitT () FilePath IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

enumPackage :: FilePath -> ConduitT () FilePath IO ()
enumPackage :: FilePath -> ConduitT () FilePath IO ()
enumPackage FilePath
cabalFile = FilePath -> ConduitT () FilePath IO GenericPackageDescription
readPackage FilePath
cabalFile ConduitT () FilePath IO GenericPackageDescription
-> (GenericPackageDescription -> ConduitT () FilePath IO ())
-> ConduitT () FilePath IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= GenericPackageDescription -> ConduitT () FilePath IO ()
expandPaths
  where
    readPackage :: FilePath -> ConduitT () FilePath IO GenericPackageDescription
readPackage = IO GenericPackageDescription
-> ConduitT () FilePath IO GenericPackageDescription
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO GenericPackageDescription
 -> ConduitT () FilePath IO GenericPackageDescription)
-> (FilePath -> IO GenericPackageDescription)
-> FilePath
-> ConduitT () FilePath IO GenericPackageDescription
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
Verbosity.silent
    expandPaths :: GenericPackageDescription -> ConduitT () FilePath IO ()
expandPaths = (FilePath -> ConduitT () FilePath IO ())
-> [FilePath] -> ConduitT () FilePath IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (FilePath -> ConduitT () FilePath IO ()
enumPath (FilePath -> ConduitT () FilePath IO ())
-> (FilePath -> FilePath) -> FilePath -> ConduitT () FilePath IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath
mkFull) ([FilePath] -> ConduitT () FilePath IO ())
-> (GenericPackageDescription -> [FilePath])
-> GenericPackageDescription
-> ConduitT () FilePath IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> [FilePath]
sourcePaths
    packageDir :: FilePath
packageDir = FilePath -> FilePath
dropFileName FilePath
cabalFile
    mkFull :: FilePath -> FilePath
mkFull = (FilePath
packageDir FilePath -> FilePath -> FilePath
</>)

enumDirectory :: FilePath -> ConduitT () FilePath IO ()
enumDirectory :: FilePath -> ConduitT () FilePath IO ()
enumDirectory FilePath
path = do
  [FilePath]
contents <- IO [FilePath] -> ConduitT () FilePath IO [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [FilePath] -> ConduitT () FilePath IO [FilePath])
-> IO [FilePath] -> ConduitT () FilePath IO [FilePath]
forall a b. (a -> b) -> a -> b
$ FilePath -> IO [FilePath]
getDirectoryContentFullPaths FilePath
path
  [FilePath]
cabalFiles <- IO [FilePath] -> ConduitT () FilePath IO [FilePath]
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift (IO [FilePath] -> ConduitT () FilePath IO [FilePath])
-> IO [FilePath] -> ConduitT () FilePath IO [FilePath]
forall a b. (a -> b) -> a -> b
$ (FilePath -> IO Bool) -> [FilePath] -> IO [FilePath]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
isCabalFile [FilePath]
contents
  if [FilePath] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [FilePath]
cabalFiles
    then (FilePath -> ConduitT () FilePath IO ())
-> [FilePath] -> ConduitT () FilePath IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> ConduitT () FilePath IO ()
enumPath [FilePath]
contents
    else (FilePath -> ConduitT () FilePath IO ())
-> [FilePath] -> ConduitT () FilePath IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ FilePath -> ConduitT () FilePath IO ()
enumPackage [FilePath]
cabalFiles

getDirectoryContentFullPaths :: FilePath -> IO [FilePath]
getDirectoryContentFullPaths :: FilePath -> IO [FilePath]
getDirectoryContentFullPaths FilePath
path =
  [FilePath] -> [FilePath]
mkFull ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
notHidden ([FilePath] -> [FilePath])
-> ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [FilePath] -> [FilePath]
notMeta ([FilePath] -> [FilePath]) -> IO [FilePath] -> IO [FilePath]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> FilePath -> IO [FilePath]
getDirectoryContents FilePath
path
  where
    mkFull :: [FilePath] -> [FilePath]
mkFull = (FilePath -> FilePath) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> [a] -> [b]
map (FilePath
path FilePath -> FilePath -> FilePath
</>)
    notHidden :: [FilePath] -> [FilePath]
notHidden = (FilePath -> Bool) -> [FilePath] -> [FilePath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Bool -> Bool
not (Bool -> Bool) -> (FilePath -> Bool) -> FilePath -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
isPrefixOf FilePath
".")
    notMeta :: [FilePath] -> [FilePath]
notMeta = ([FilePath] -> [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a] -> [a]
\\ [FilePath
".", FilePath
".."])

isCabalFile :: FilePath -> IO Bool
isCabalFile :: FilePath -> IO Bool
isCabalFile FilePath
path = Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (FilePath -> Bool
hasCabalExtension FilePath
path) IO Bool -> IO Bool -> IO Bool
forall (f :: * -> *). Applicative f => f Bool -> f Bool -> f Bool
<&&> FilePath -> IO Bool
doesFileExist FilePath
path

hasCabalExtension :: FilePath -> Bool
hasCabalExtension :: FilePath -> Bool
hasCabalExtension FilePath
path = FilePath
".cabal" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
path

hasHaskellExtension :: FilePath -> Bool
hasHaskellExtension :: FilePath -> Bool
hasHaskellExtension FilePath
path = FilePath
".hs" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
path Bool -> Bool -> Bool
|| FilePath
".lhs" FilePath -> FilePath -> Bool
forall a. Eq a => [a] -> [a] -> Bool
`isSuffixOf` FilePath
path

sourcePaths :: GenericPackageDescription -> [FilePath]
sourcePaths :: GenericPackageDescription -> [FilePath]
sourcePaths GenericPackageDescription
pkg = [FilePath] -> [FilePath]
forall a. Eq a => [a] -> [a]
nub ([FilePath] -> [FilePath]) -> [FilePath] -> [FilePath]
forall a b. (a -> b) -> a -> b
$ ((GenericPackageDescription -> [FilePath]) -> [FilePath])
-> [GenericPackageDescription -> [FilePath]] -> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap ((GenericPackageDescription -> [FilePath])
-> GenericPackageDescription -> [FilePath]
forall a b. (a -> b) -> a -> b
$ GenericPackageDescription
pkg) [GenericPackageDescription -> [FilePath]]
pathExtractors
  where
    pathExtractors :: [GenericPackageDescription -> [FilePath]]
pathExtractors =
      [ [FilePath]
-> (CondTree ConfVar [Dependency] Library -> [FilePath])
-> Maybe (CondTree ConfVar [Dependency] Library)
-> [FilePath]
forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (BuildInfo -> [FilePath]
hsSourceDirs (BuildInfo -> [FilePath])
-> (CondTree ConfVar [Dependency] Library -> BuildInfo)
-> CondTree ConfVar [Dependency] Library
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo (Library -> BuildInfo)
-> (CondTree ConfVar [Dependency] Library -> Library)
-> CondTree ConfVar [Dependency] Library
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Library -> Library
forall v c a. CondTree v c a -> a
condTreeData) (Maybe (CondTree ConfVar [Dependency] Library) -> [FilePath])
-> (GenericPackageDescription
    -> Maybe (CondTree ConfVar [Dependency] Library))
-> GenericPackageDescription
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary
      , ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
 -> [FilePath])
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
-> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [FilePath]
hsSourceDirs (BuildInfo -> [FilePath])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> BuildInfo)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Executable -> BuildInfo
buildInfo (Executable -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Executable -> Executable
forall v c a. CondTree v c a -> a
condTreeData (CondTree ConfVar [Dependency] Executable -> Executable)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Executable)
    -> CondTree ConfVar [Dependency] Executable)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> Executable
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Executable)
-> CondTree ConfVar [Dependency] Executable
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] Executable)]
 -> [FilePath])
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Executable)])
-> GenericPackageDescription
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables
      , ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
 -> [FilePath])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
-> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [FilePath]
hsSourceDirs (BuildInfo -> [FilePath])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> BuildInfo)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestSuite -> BuildInfo
testBuildInfo (TestSuite -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] TestSuite -> TestSuite
forall v c a. CondTree v c a -> a
condTreeData (CondTree ConfVar [Dependency] TestSuite -> TestSuite)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
    -> CondTree ConfVar [Dependency] TestSuite)
-> (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> TestSuite
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)
-> CondTree ConfVar [Dependency] TestSuite
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
 -> [FilePath])
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] TestSuite)])
-> GenericPackageDescription
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites
      , ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
 -> [FilePath])
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
-> [FilePath]
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (BuildInfo -> [FilePath]
hsSourceDirs (BuildInfo -> [FilePath])
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> BuildInfo)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Benchmark -> BuildInfo
benchmarkBuildInfo (Benchmark -> BuildInfo)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> BuildInfo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CondTree ConfVar [Dependency] Benchmark -> Benchmark
forall v c a. CondTree v c a -> a
condTreeData (CondTree ConfVar [Dependency] Benchmark -> Benchmark)
-> ((UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
    -> CondTree ConfVar [Dependency] Benchmark)
-> (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> Benchmark
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)
-> CondTree ConfVar [Dependency] Benchmark
forall a b. (a, b) -> b
snd) ([(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
 -> [FilePath])
-> (GenericPackageDescription
    -> [(UnqualComponentName,
         CondTree ConfVar [Dependency] Benchmark)])
-> GenericPackageDescription
-> [FilePath]
forall b c a. (b -> c) -> (a -> b) -> a -> c
.
        GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks
      ]

(<&&>) :: Applicative f => f Bool -> f Bool -> f Bool
<&&> :: f Bool -> f Bool -> f Bool
(<&&>) = (Bool -> Bool -> Bool) -> f Bool -> f Bool -> f Bool
forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Bool -> Bool -> Bool
(&&)

infixr 3 <&&> -- same as (&&)