module Development.Shake.Cabal ( getCabalDeps
, getCabalDepsV
, getCabalDepsA
, shakeVerbosityToCabalVerbosity
, HsCompiler (..)
, platform
, hsCompiler
, prettyShow
) where
import Control.Arrow
import Control.Composition
import Control.Monad
import Data.Foldable (toList)
import Data.Maybe (catMaybes)
import Development.Shake hiding (doesFileExist)
import qualified Development.Shake as Shake
import Distribution.ModuleName
import Distribution.PackageDescription
import Distribution.PackageDescription.Parsec
import Distribution.Pretty
import Distribution.Types.CondTree
import Distribution.Types.PackageId
import Distribution.Verbosity as Distribution
import Distribution.Version
import System.Directory (doesFileExist)
import System.Info (arch, os)
data HsCompiler = GHC { HsCompiler -> Maybe String
_suff :: Maybe String
}
| GHCJS { _suff :: Maybe String
}
hsCompiler :: HsCompiler -> String
hsCompiler :: HsCompiler -> String
hsCompiler (GHC Maybe String
Nothing) = String
"ghc"
hsCompiler (GHC (Just String
v)) = String
"ghc-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v
hsCompiler (GHCJS Maybe String
Nothing) = String
"ghcjs"
hsCompiler (GHCJS (Just String
v)) = String
"ghcjs-" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
v
platform :: String
platform :: String
platform = String
arch String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"-" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
os
libraryToFiles :: Library -> [FilePath]
libraryToFiles :: Library -> [String]
libraryToFiles Library
lib = [[String]] -> [String]
forall a. Monoid a => [a] -> a
mconcat [[String]
cs, [String]
is, [String]
hs]
where ([String]
cs, [String]
is) = (BuildInfo -> [String]
cSources (BuildInfo -> [String])
-> (BuildInfo -> [String]) -> BuildInfo -> ([String], [String])
forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& BuildInfo -> [String]
includes) (BuildInfo -> ([String], [String]))
-> BuildInfo -> ([String], [String])
forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
hs :: [String]
hs = (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
".hs") (String -> String)
-> (ModuleName -> String) -> ModuleName -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> String
toFilePath (ModuleName -> String) -> [ModuleName] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Library -> [ModuleName]
explicitLibModules Library
lib
extract :: CondTree a b Library -> [Library]
(CondNode Library
d b
_ []) = [Library
d]
extract (CondNode Library
d b
_ [CondBranch a b Library]
bs) = Library
d Library -> [Library] -> [Library]
forall a. a -> [a] -> [a]
: (CondBranch a b Library -> [Library]
forall a b. CondBranch a b Library -> [Library]
g (CondBranch a b Library -> [Library])
-> [CondBranch a b Library] -> [Library]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CondBranch a b Library]
bs)
where g :: CondBranch a b Library -> [Library]
g (CondBranch Condition a
_ CondTree a b Library
tb Maybe (CondTree a b Library)
fb) = [[Library]] -> [Library]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join ([[Library]] -> [Library]) -> [[Library]] -> [Library]
forall a b. (a -> b) -> a -> b
$ [Maybe [Library]] -> [[Library]]
forall a. [Maybe a] -> [a]
catMaybes [[Library] -> Maybe [Library]
forall a. a -> Maybe a
Just ([Library] -> Maybe [Library]) -> [Library] -> Maybe [Library]
forall a b. (a -> b) -> a -> b
$ CondTree a b Library -> [Library]
forall a b. CondTree a b Library -> [Library]
extract CondTree a b Library
tb, CondTree a b Library -> [Library]
forall a b. CondTree a b Library -> [Library]
extract (CondTree a b Library -> [Library])
-> Maybe (CondTree a b Library) -> Maybe [Library]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree a b Library)
fb]
shakeVerbosityToCabalVerbosity :: Shake.Verbosity -> Distribution.Verbosity
shakeVerbosityToCabalVerbosity :: Verbosity -> Verbosity
shakeVerbosityToCabalVerbosity Verbosity
Silent = Verbosity
silent
shakeVerbosityToCabalVerbosity Verbosity
Quiet = Verbosity
normal
shakeVerbosityToCabalVerbosity Verbosity
Normal = Verbosity
normal
shakeVerbosityToCabalVerbosity Verbosity
Loud = Verbosity
verbose
shakeVerbosityToCabalVerbosity Verbosity
Chatty = Verbosity
verbose
shakeVerbosityToCabalVerbosity Verbosity
Diagnostic = Verbosity
deafening
getCabalDepsA :: FilePath -> Action (Version, [FilePath])
getCabalDepsA :: String -> Action (Version, [String])
getCabalDepsA = Action (Action (Version, [String])) -> Action (Version, [String])
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Action (Action (Version, [String])) -> Action (Version, [String]))
-> (String -> Action (Action (Version, [String])))
-> String
-> Action (Version, [String])
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Verbosity -> String -> Action (Version, [String])
g (Verbosity -> String -> Action (Version, [String]))
-> Action Verbosity
-> Action (String -> Action (Version, [String]))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Verbosity -> Verbosity) -> Action Verbosity -> Action Verbosity
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Verbosity -> Verbosity
shakeVerbosityToCabalVerbosity Action Verbosity
getVerbosity Action (String -> Action (Version, [String]))
-> Action String -> Action (Action (Version, [String]))
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) (Action String -> Action (Action (Version, [String])))
-> (String -> Action String)
-> String
-> Action (Action (Version, [String]))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Action String
forall (f :: * -> *) a. Applicative f => a -> f a
pure
where g :: Verbosity -> String -> Action (Version, [String])
g = IO (Version, [String]) -> Action (Version, [String])
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO (Version, [String]) -> Action (Version, [String]))
-> (Verbosity -> String -> IO (Version, [String]))
-> Verbosity
-> String
-> Action (Version, [String])
forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Verbosity -> String -> IO (Version, [String])
getCabalDepsV
getCabalDeps :: FilePath -> IO (Version, [FilePath])
getCabalDeps :: String -> IO (Version, [String])
getCabalDeps = Verbosity -> String -> IO (Version, [String])
getCabalDepsV Verbosity
normal
getCabalDepsV :: Distribution.Verbosity -> FilePath -> IO (Version, [FilePath])
getCabalDepsV :: Verbosity -> String -> IO (Version, [String])
getCabalDepsV Verbosity
v String
p = do
GenericPackageDescription
pkg <- Verbosity -> String -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
v String
p
let descr :: PackageDescription
descr = GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
pkg
extraSrc :: [String]
extraSrc = PackageDescription -> [String]
extraSrcFiles PackageDescription
descr
vers :: Version
vers = PackageIdentifier -> Version
pkgVersion (PackageDescription -> PackageIdentifier
package PackageDescription
descr)
libs :: [CondTree ConfVar [Dependency] Library]
libs = Maybe (CondTree ConfVar [Dependency] Library)
-> [CondTree ConfVar [Dependency] Library]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg)
normalSrc :: [String]
normalSrc = (Library -> [String]
libraryToFiles (Library -> [String])
-> (CondTree ConfVar [Dependency] Library -> [Library])
-> CondTree ConfVar [Dependency] Library
-> [String]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CondTree ConfVar [Dependency] Library -> [Library]
forall a b. CondTree a b Library -> [Library]
extract) (CondTree ConfVar [Dependency] Library -> [String])
-> [CondTree ConfVar [Dependency] Library] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CondTree ConfVar [Dependency] Library]
libs
dir :: [String]
dir = ((String -> String) -> [String] -> [String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"/") ([String] -> [String])
-> (Library -> [String]) -> Library -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [String]
hsSourceDirs (BuildInfo -> [String])
-> (Library -> BuildInfo) -> Library -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Library -> BuildInfo
libBuildInfo (Library -> [String])
-> (CondTree ConfVar [Dependency] Library -> [Library])
-> CondTree ConfVar [Dependency] Library
-> [String]
forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< CondTree ConfVar [Dependency] Library -> [Library]
forall a b. CondTree a b Library -> [Library]
extract) (CondTree ConfVar [Dependency] Library -> [String])
-> [CondTree ConfVar [Dependency] Library] -> [String]
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CondTree ConfVar [Dependency] Library]
libs
dirge :: [String] -> [String]
dirge = (String -> String -> String
forall a. Semigroup a => a -> a -> a
(<>) (String -> String -> String) -> [String] -> [String -> String]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [String]
dir [String -> String] -> [String] -> [String]
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)
h :: [String] -> IO [String]
h = (String -> IO Bool) -> [String] -> IO [String]
forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM String -> IO Bool
doesFileExist
[String]
norms <- [String] -> IO [String]
h ([String] -> [String]
dirge [String]
normalSrc)
(Version, [String]) -> IO (Version, [String])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version
vers, [String]
extraSrc [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
norms)