module Distribution.C2Hs ( defaultMainC2Hs
                         , c2hsBuildHooks
                         , c2hsHaddockHooks
                         , c2hsReplHooks
                         ) where

import           Distribution.C2Hs.TopSort
import           Distribution.ModuleName               (ModuleName)
import           Distribution.Simple                   (UserHooks (buildHook, haddockHook, replHook),
                                                        defaultMainWithHooks,
                                                        simpleUserHooks)
import           Distribution.Simple.LocalBuildInfo    (LocalBuildInfo)
import           Distribution.Simple.Setup             (BuildFlags (BuildFlags, buildVerbosity),
                                                        HaddockFlags (HaddockFlags, haddockVerbosity),
                                                        ReplFlags (ReplFlags, replVerbosity),
                                                        fromFlagOrDefault)
import           Distribution.Types.Benchmark
import           Distribution.Types.BuildInfo
import           Distribution.Types.Executable
import           Distribution.Types.ForeignLib
import           Distribution.Types.Library
import           Distribution.Types.PackageDescription
import           Distribution.Types.TestSuite
import           Distribution.Verbosity                (Verbosity, normal)

defaultMainC2Hs :: IO ()
defaultMainC2Hs = defaultMainWithHooks
    simpleUserHooks { buildHook = c2hsBuildHooks
                    , haddockHook = c2hsHaddockHooks
                    , replHook = c2hsReplHooks
                    }

-- | Custom build hooks to be used with @.chs@ files which @\{#import#\}@ one
-- another.
c2hsBuildHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> BuildFlags -> IO ()
c2hsBuildHooks = \pd lbi hooks bf -> do
    let v = getVerbosity bf
    pd' <- mapPackageDescription (reorderC2Hs v) pd
    buildHook simpleUserHooks pd' lbi hooks bf

c2hsHaddockHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> HaddockFlags -> IO ()
c2hsHaddockHooks = \pd lbi hooks hf -> do
    let v = getHaddockVerbosity hf
    pd' <- mapPackageDescription (reorderC2Hs v) pd
    haddockHook simpleUserHooks pd' lbi hooks hf

c2hsReplHooks :: PackageDescription -> LocalBuildInfo -> UserHooks -> ReplFlags -> [String] -> IO ()
c2hsReplHooks = \pd lbi hooks rf ss -> do
    let v = getReplVerbosity rf
    pd' <- mapPackageDescription (reorderC2Hs v) pd
    replHook simpleUserHooks pd' lbi hooks rf ss

getHaddockVerbosity :: HaddockFlags -> Verbosity
getHaddockVerbosity HaddockFlags { haddockVerbosity = v } = fromFlagOrDefault normal v

getVerbosity :: BuildFlags -> Verbosity
getVerbosity BuildFlags { buildVerbosity = v } = fromFlagOrDefault normal v

getReplVerbosity :: ReplFlags -> Verbosity
getReplVerbosity ReplFlags { replVerbosity = v } = fromFlagOrDefault normal v

mapPackageDescription :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> PackageDescription -> IO PackageDescription
mapPackageDescription f p@PackageDescription { library = ml
                                             , subLibraries = ls
                                             , executables = es
                                             , foreignLibs = fs
                                             , testSuites = ts
                                             , benchmarks = bs
                                             } = do
    ml' <- traverse (mapLibrary f) ml
    ls' <- traverse (mapLibrary f) ls
    es' <- traverse (mapExecutable f) es
    fs' <- traverse (mapForeignLibrary f) fs
    ts' <- traverse (mapTestSuite f) ts
    bs' <- traverse (mapBenchmark f) bs
    pure $ p { library = ml'
             , subLibraries = ls'
             , executables = es'
             , foreignLibs = fs'
             , testSuites = ts'
             , benchmarks = bs'
             }

mapLibrary :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> Library -> IO Library
mapLibrary f lib@Library { exposedModules = es, libBuildInfo = bi } = do
    let dirs = hsSourceDirs bi
        om = otherModules bi
        isOther = (`notElem` es)
    newMods <- f dirs (es ++ om)
    let om' = filter isOther newMods
        bi' = bi { otherModules = om' }
        -- This is stupid, but I've tested it and it seems to not do anything
        -- egregious
    pure $ lib { exposedModules = newMods, libBuildInfo = bi' }

mapBenchmark :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> Benchmark -> IO Benchmark
mapBenchmark f b@Benchmark { benchmarkBuildInfo = bi } = do
    bi' <- mapBuildInfo f bi
    pure $ b { benchmarkBuildInfo = bi' }

mapExecutable :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> Executable -> IO Executable
mapExecutable f e@Executable { buildInfo = bi } = do
    bi' <- mapBuildInfo f bi
    pure $ e { buildInfo = bi' }

mapForeignLibrary :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> ForeignLib -> IO ForeignLib
mapForeignLibrary f fl@ForeignLib { foreignLibBuildInfo = bi } = do
    bi' <- mapBuildInfo f bi
    pure $ fl { foreignLibBuildInfo = bi' }

mapTestSuite :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> TestSuite -> IO TestSuite
mapTestSuite f t@TestSuite { testBuildInfo = bi } = do
    bi' <- mapBuildInfo f bi
    pure $ t { testBuildInfo = bi' }

mapBuildInfo :: ([FilePath] -> [ModuleName] -> IO [ModuleName]) -> BuildInfo -> IO BuildInfo
mapBuildInfo f bi@BuildInfo { otherModules = om, hsSourceDirs = dirs } = do
    om' <- f dirs om
    pure $ bi { otherModules = om' }