{-# 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 <&&>