module Development.Shake.Cabal ( getCabalDeps
                               , getCabalDepsV
                               , getCabalDepsA
                               , shakeVerbosityToCabalVerbosity
                               -- * Types
                               , HsCompiler (..)
                               -- * Helper functions
                               , platform
                               , hsCompiler
                               -- * Reëxports from "Distribution.Version"
                               , 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 -- ^ Compiler version
                      }
                | GHCJS { _suff :: Maybe String -- ^ Compiler version
                        }

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

-- | E.g. @x86_64-linux@
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]
extract :: CondTree a b Library -> [Library]
extract (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]

-- | 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
Quiet      = Verbosity
normal
shakeVerbosityToCabalVerbosity Verbosity
Normal     = Verbosity
normal
shakeVerbosityToCabalVerbosity Verbosity
Loud       = Verbosity
verbose
shakeVerbosityToCabalVerbosity Verbosity
Chatty     = 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 :: 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

-- | 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 :: 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)