module Development.Shake.Cabal ( getCabalDeps
                               , getCabalDepsV
                               , getCabalDepsA
                               , shakeVerbosityToCabalVerbosity
                               -- * Oracles
                               , hsOracle
                               , cabalOracle
                               -- * Types
                               , HsCompiler (..)
                               -- * Oracle dummy types
                               , CabalVersion (..)
                               -- * Helper functions
                               , platform
                               , hsCompiler
                               -- * Reëxports from "Distribution.Version"
                               , prettyShow
                               ) where

import           Control.Applicative
import           Control.Arrow
import           Control.Composition
import           Control.Monad
import           Data.Foldable                          (fold, toList)
import           Data.Maybe                             (catMaybes)
import           Development.Shake                      hiding (doesFileExist)
import qualified Development.Shake                      as Shake
import           Development.Shake.Cabal.Oracles
import           Distribution.ModuleName
import           Distribution.PackageDescription
import           Distribution.Pretty
import           Distribution.Simple.PackageDescription (readGenericPackageDescription)
import           Distribution.Utils.Path                (getSymbolicPath)
import           Distribution.Verbosity                 as Distribution
import           Distribution.Version
import           System.Directory                       (doesFileExist)
import           System.FilePath                        (pathSeparator)
import           System.Info                            (arch, os)

hsCompiler :: HsCompiler -> String
hsCompiler :: HsCompiler -> FilePath
hsCompiler (GHC Maybe FilePath
Nothing Maybe FilePath
Nothing)       = FilePath
"ghc"
hsCompiler (GHC Maybe FilePath
Nothing (Just FilePath
v))      = FilePath
"ghc-" forall a. [a] -> [a] -> [a]
++ FilePath
v
hsCompiler (GHC (Just FilePath
arch') (Just FilePath
v)) = FilePath
arch' forall a. [a] -> [a] -> [a]
++ FilePath
"-ghc-" forall a. [a] -> [a] -> [a]
++ FilePath
v
hsCompiler (GHC (Just FilePath
arch') Maybe FilePath
Nothing)  = FilePath
arch' forall a. [a] -> [a] -> [a]
++ FilePath
"-ghc"
hsCompiler (GHCJS Maybe FilePath
Nothing)             = FilePath
"ghcjs"
hsCompiler (GHCJS (Just FilePath
v))            = FilePath
"ghcjs-" forall a. [a] -> [a] -> [a]
++ FilePath
v

-- | E.g. @x86_64-linux@
platform :: String
platform :: FilePath
platform = FilePath
arch forall a. [a] -> [a] -> [a]
++ FilePath
"-" forall a. [a] -> [a] -> [a]
++ FilePath -> FilePath
processOS FilePath
os
    where processOS :: FilePath -> FilePath
processOS FilePath
"darwin" = FilePath
"osx"
          processOS FilePath
x        = FilePath
x

-- FIXME: should also work with .x, .cpphs, .y, .c2hs files
libraryToFiles :: Library -> [FilePath]
libraryToFiles :: Library -> [FilePath]
libraryToFiles Library
lib = forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold [[FilePath]
cs, [FilePath]
is, [FilePath]
hs]
    where ([FilePath]
cs, [FilePath]
is) = (BuildInfo -> [FilePath]
cSources forall (a :: * -> * -> *) b c c'.
Arrow a =>
a b c -> a b c' -> a b (c, c')
&&& BuildInfo -> [FilePath]
includes) forall a b. (a -> b) -> a -> b
$ Library -> BuildInfo
libBuildInfo Library
lib
          hs :: [FilePath]
hs = (forall a. [a] -> [a] -> [a]
++ FilePath
".hs") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
toFilePath forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Library -> [ModuleName]
explicitLibModules Library
lib

fileHelper :: (a -> [ModuleName]) -> a -> [FilePath]
fileHelper :: forall a. (a -> [ModuleName]) -> a -> [FilePath]
fileHelper = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. [a] -> [a] -> [a]
++ FilePath
".hs") forall b c a. (b -> c) -> (a -> b) -> a -> c
. ModuleName -> FilePath
toFilePath) forall b c a. (b -> c) -> (a -> b) -> a -> c
.)

exeToFiles :: Executable -> [FilePath]
exeToFiles :: Executable -> [FilePath]
exeToFiles = forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (:) Executable -> FilePath
modulePath (forall a. (a -> [ModuleName]) -> a -> [FilePath]
fileHelper Executable -> [ModuleName]
exeModules)

testToFiles :: TestSuite -> [FilePath]
testToFiles :: TestSuite -> [FilePath]
testToFiles = forall a. (a -> [ModuleName]) -> a -> [FilePath]
fileHelper TestSuite -> [ModuleName]
testModules

benchToFiles :: Benchmark -> [FilePath]
benchToFiles :: Benchmark -> [FilePath]
benchToFiles = forall a. (a -> [ModuleName]) -> a -> [FilePath]
fileHelper Benchmark -> [ModuleName]
benchmarkModules

foreignToFiles :: ForeignLib -> [FilePath]
foreignToFiles :: ForeignLib -> [FilePath]
foreignToFiles = forall a. (a -> [ModuleName]) -> a -> [FilePath]
fileHelper ForeignLib -> [ModuleName]
foreignLibModules

extract :: CondTree a b c -> [c]
extract :: forall a b c. CondTree a b c -> [c]
extract (CondNode c
d b
_ []) = [c
d]
extract (CondNode c
d b
_ [CondBranch a b c]
bs) = c
d forall a. a -> [a] -> [a]
: (forall {a} {b} {a}. CondBranch a b a -> [a]
g forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CondBranch a b c]
bs)
    where g :: CondBranch a b a -> [a]
g (CondBranch Condition a
_ CondTree a b a
tb Maybe (CondTree a b a)
fb) = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ forall a b c. CondTree a b c -> [c]
extract CondTree a b a
tb, forall a b c. CondTree a b c -> [c]
extract forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (CondTree a b a)
fb]

-- | Assign each shake @Verbosity@ level to a Cabal @Verbosity@ level.
shakeVerbosityToCabalVerbosity :: Shake.Verbosity -> Distribution.Verbosity
shakeVerbosityToCabalVerbosity :: Verbosity -> Verbosity
shakeVerbosityToCabalVerbosity Verbosity
Silent     = Verbosity
silent
shakeVerbosityToCabalVerbosity Verbosity
Error      = Verbosity
normal
shakeVerbosityToCabalVerbosity Verbosity
Warn       = Verbosity
normal
shakeVerbosityToCabalVerbosity Verbosity
Info       = Verbosity
verbose
shakeVerbosityToCabalVerbosity Verbosity
Verbose    = Verbosity
verbose
shakeVerbosityToCabalVerbosity Verbosity
Diagnostic = Verbosity
deafening

-- | Get cabal dependencies, respecting verbosity level given to
-- [shake](http://shakebuild.com/).
getCabalDepsA :: FilePath -> Action (Version, [FilePath])
getCabalDepsA :: FilePath -> Action (Version, [FilePath])
getCabalDepsA = forall (m :: * -> *) a. Monad m => m (m a) -> m a
join forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Verbosity -> FilePath -> Action (Version, [FilePath])
g forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Verbosity -> Verbosity
shakeVerbosityToCabalVerbosity Action Verbosity
getVerbosity forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a. Applicative f => a -> f a
pure
    where g :: Verbosity -> FilePath -> Action (Version, [FilePath])
g = forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO forall c d a b. (c -> d) -> (a -> b -> c) -> a -> b -> d
.* Verbosity -> FilePath -> IO (Version, [FilePath])
getCabalDepsV

-- | Get library dependencies from a @.cabal@ file. This will only work for
-- @.hs@ files; module signatures are not supported.
getCabalDeps :: FilePath -> IO (Version, [FilePath])
getCabalDeps :: FilePath -> IO (Version, [FilePath])
getCabalDeps = Verbosity -> FilePath -> IO (Version, [FilePath])
getCabalDepsV Verbosity
normal

getCabalDepsV :: Distribution.Verbosity -> FilePath -> IO (Version, [FilePath])
getCabalDepsV :: Verbosity -> FilePath -> IO (Version, [FilePath])
getCabalDepsV Verbosity
v FilePath
p = do
    GenericPackageDescription
pkg <- Verbosity -> FilePath -> IO GenericPackageDescription
readGenericPackageDescription Verbosity
v FilePath
p
    let descr :: PackageDescription
descr = GenericPackageDescription -> PackageDescription
packageDescription GenericPackageDescription
pkg
        extraSrc :: [FilePath]
extraSrc = PackageDescription -> [FilePath]
extraSrcFiles PackageDescription
descr
        vers :: Version
vers = PackageIdentifier -> Version
pkgVersion (PackageDescription -> PackageIdentifier
package PackageDescription
descr)

        mkHelper :: (GenericPackageDescription -> t (a, a)) -> [a]
mkHelper GenericPackageDescription -> t (a, a)
f = (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. GenericPackageDescription -> t (a, a)
f) GenericPackageDescription
pkg

        libs :: [CondTree ConfVar [Dependency] Library]
libs = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (GenericPackageDescription
-> Maybe (CondTree ConfVar [Dependency] Library)
condLibrary GenericPackageDescription
pkg)
        exes :: [CondTree ConfVar [Dependency] Executable]
exes = forall {t :: * -> *} {a} {a}.
(Foldable t, Functor t) =>
(GenericPackageDescription -> t (a, a)) -> [a]
mkHelper GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] Executable)]
condExecutables
        subLibs :: [CondTree ConfVar [Dependency] Library]
subLibs = forall {t :: * -> *} {a} {a}.
(Foldable t, Functor t) =>
(GenericPackageDescription -> t (a, a)) -> [a]
mkHelper GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Library)]
condSubLibraries
        tests :: [CondTree ConfVar [Dependency] TestSuite]
tests = forall {t :: * -> *} {a} {a}.
(Foldable t, Functor t) =>
(GenericPackageDescription -> t (a, a)) -> [a]
mkHelper GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] TestSuite)]
condTestSuites
        benches :: [CondTree ConfVar [Dependency] Benchmark]
benches = forall {t :: * -> *} {a} {a}.
(Foldable t, Functor t) =>
(GenericPackageDescription -> t (a, a)) -> [a]
mkHelper GenericPackageDescription
-> [(UnqualComponentName, CondTree ConfVar [Dependency] Benchmark)]
condBenchmarks
        foreigns :: [CondTree ConfVar [Dependency] ForeignLib]
foreigns = forall {t :: * -> *} {a} {a}.
(Foldable t, Functor t) =>
(GenericPackageDescription -> t (a, a)) -> [a]
mkHelper GenericPackageDescription
-> [(UnqualComponentName,
     CondTree ConfVar [Dependency] ForeignLib)]
condForeignLibs

        extractHelper :: (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper b -> [b]
f [CondTree a b b]
xs = (b -> [b]
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a b c. CondTree a b c -> [c]
extract) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CondTree a b b]
xs

        normalSrc :: [FilePath]
normalSrc = forall {b} {b} {a} {b}. (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper Library -> [FilePath]
libraryToFiles [CondTree ConfVar [Dependency] Library]
libs
        exeSrc :: [FilePath]
exeSrc = forall {b} {b} {a} {b}. (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper Executable -> [FilePath]
exeToFiles [CondTree ConfVar [Dependency] Executable]
exes
        subSrc :: [FilePath]
subSrc = forall {b} {b} {a} {b}. (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper Library -> [FilePath]
libraryToFiles [CondTree ConfVar [Dependency] Library]
subLibs
        testSrc :: [FilePath]
testSrc = forall {b} {b} {a} {b}. (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper TestSuite -> [FilePath]
testToFiles [CondTree ConfVar [Dependency] TestSuite]
tests
        benchSrc :: [FilePath]
benchSrc = forall {b} {b} {a} {b}. (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper Benchmark -> [FilePath]
benchToFiles [CondTree ConfVar [Dependency] Benchmark]
benches
        foreignSrc :: [FilePath]
foreignSrc = forall {b} {b} {a} {b}. (b -> [b]) -> [CondTree a b b] -> [b]
extractHelper ForeignLib -> [FilePath]
foreignToFiles [CondTree ConfVar [Dependency] ForeignLib]
foreigns

        dirHelper :: (b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper b -> BuildInfo
f [CondTree a b b]
xs = (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ((forall a. [a] -> [a] -> [a]
++ [Char
pathSeparator]) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> FilePath
getSymbolicPath) forall b c a. (b -> c) -> (a -> b) -> a -> c
. BuildInfo -> [SymbolicPath PackageDir SourceDir]
hsSourceDirs forall b c a. (b -> c) -> (a -> b) -> a -> c
. b -> BuildInfo
f forall (m :: * -> *) b c a.
Monad m =>
(b -> m c) -> (a -> m b) -> a -> m c
<=< forall a b c. CondTree a b c -> [c]
extract) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< [CondTree a b b]
xs

        dir :: [FilePath]
dir = forall {b} {a} {b}.
(b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper Library -> BuildInfo
libBuildInfo [CondTree ConfVar [Dependency] Library]
libs
        exeDir :: [FilePath]
exeDir = forall {b} {a} {b}.
(b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper Executable -> BuildInfo
buildInfo [CondTree ConfVar [Dependency] Executable]
exes
        subDirs :: [FilePath]
subDirs = forall {b} {a} {b}.
(b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper Library -> BuildInfo
libBuildInfo [CondTree ConfVar [Dependency] Library]
subLibs
        testDirs :: [FilePath]
testDirs = forall {b} {a} {b}.
(b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper TestSuite -> BuildInfo
testBuildInfo [CondTree ConfVar [Dependency] TestSuite]
tests
        benchDirs :: [FilePath]
benchDirs = forall {b} {a} {b}.
(b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper Benchmark -> BuildInfo
benchmarkBuildInfo [CondTree ConfVar [Dependency] Benchmark]
benches
        foreignDirs :: [FilePath]
foreignDirs = forall {b} {a} {b}.
(b -> BuildInfo) -> [CondTree a b b] -> [FilePath]
dirHelper ForeignLib -> BuildInfo
foreignLibBuildInfo [CondTree ConfVar [Dependency] ForeignLib]
foreigns

        dirgeHelper :: f [a] -> f [a] -> f [a]
dirgeHelper f [a]
d = (forall a. [a] -> [a] -> [a]
(++) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f [a]
d forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*>)

        dirge :: [FilePath] -> [FilePath]
dirge = forall {f :: * -> *} {a}. Applicative f => f [a] -> f [a] -> f [a]
dirgeHelper [FilePath]
dir
        dirgeExe :: [FilePath] -> [FilePath]
dirgeExe = forall {f :: * -> *} {a}. Applicative f => f [a] -> f [a] -> f [a]
dirgeHelper [FilePath]
exeDir
        dirgeSub :: [FilePath] -> [FilePath]
dirgeSub = forall {f :: * -> *} {a}. Applicative f => f [a] -> f [a] -> f [a]
dirgeHelper [FilePath]
subDirs
        dirgeTest :: [FilePath] -> [FilePath]
dirgeTest = forall {f :: * -> *} {a}. Applicative f => f [a] -> f [a] -> f [a]
dirgeHelper [FilePath]
testDirs
        dirgeBench :: [FilePath] -> [FilePath]
dirgeBench = forall {f :: * -> *} {a}. Applicative f => f [a] -> f [a] -> f [a]
dirgeHelper [FilePath]
benchDirs
        dirgeForeign :: [FilePath] -> [FilePath]
dirgeForeign = forall {f :: * -> *} {a}. Applicative f => f [a] -> f [a] -> f [a]
dirgeHelper [FilePath]
foreignDirs

        h :: [FilePath] -> IO [FilePath]
h = forall (m :: * -> *) a.
Applicative m =>
(a -> m Bool) -> [a] -> m [a]
filterM FilePath -> IO Bool
doesFileExist

    [FilePath]
norms <- [FilePath] -> IO [FilePath]
h ([FilePath] -> [FilePath]
dirge [FilePath]
normalSrc)
    [FilePath]
exeFiles <- [FilePath] -> IO [FilePath]
h ([FilePath] -> [FilePath]
dirgeExe [FilePath]
exeSrc)
    [FilePath]
subFiles <- [FilePath] -> IO [FilePath]
h ([FilePath] -> [FilePath]
dirgeSub [FilePath]
subSrc)
    [FilePath]
testFiles <- [FilePath] -> IO [FilePath]
h ([FilePath] -> [FilePath]
dirgeTest [FilePath]
testSrc)
    [FilePath]
benchFiles <- [FilePath] -> IO [FilePath]
h ([FilePath] -> [FilePath]
dirgeBench [FilePath]
benchSrc)
    [FilePath]
foreignFiles <- [FilePath] -> IO [FilePath]
h ([FilePath] -> [FilePath]
dirgeForeign [FilePath]
foreignSrc)

    forall (f :: * -> *) a. Applicative f => a -> f a
pure (Version
vers, FilePath
p forall a. a -> [a] -> [a]
: [FilePath]
extraSrc forall a. [a] -> [a] -> [a]
++ [FilePath]
norms forall a. [a] -> [a] -> [a]
++ [FilePath]
exeFiles forall a. [a] -> [a] -> [a]
++ [FilePath]
subFiles forall a. [a] -> [a] -> [a]
++ [FilePath]
testFiles forall a. [a] -> [a] -> [a]
++ [FilePath]
benchFiles forall a. [a] -> [a] -> [a]
++ [FilePath]
foreignFiles)