content: {-# Language CPP #-}
  {-|
  Module      : Main
  Description : Custom setup script
  Copyright   : (c) Eric Mertens, 2016
  License     : ISC
  Maintainer  : emertens@gmail.com
  
  This is a default setup script except that it checks that all
  transitive dependencies of this package use free licenses and
  generates a Build module detailing the versions of build tools
  and transitive library dependencies.
  
  -}
  
  module Main (main) where
  
  import           Control.Monad (unless)
  import           Data.Char (isAlphaNum)
  import           Distribution.InstalledPackageInfo (InstalledPackageInfo, sourcePackageId, license)
  import           Distribution.PackageDescription hiding (license)
  import           Distribution.Simple
  import           Distribution.Simple.LocalBuildInfo (LocalBuildInfo, installedPkgs, withLibLBI)
  import           Distribution.Simple.PackageIndex (allPackages)
  import           Distribution.Simple.Setup (configVerbosity, fromFlag)
  import           Distribution.Verbosity (Verbosity)
  import           System.FilePath ((</>), (<.>))
  
  #if MIN_VERSION_Cabal(3,14,0)
  import           Distribution.Simple.Build (AutogenFile(AutogenModule), writeAutogenFiles)
  import           Distribution.Simple.Utils (Suffix(..))
  import qualified Data.ByteString.Lazy.Char8 as B
  import qualified Data.Map as Map
  import qualified Distribution.ModuleName as M
  #else
  import           Distribution.Simple.BuildPaths (autogenComponentModulesDir)
  import           Distribution.Simple.Utils (createDirectoryIfMissingVerbose, rewriteFileEx)
  #endif
  
  
  -- | Default Setup main extended to generate a Build module and to validate
  -- the licenses of transitive dependencies.
  main :: IO ()
  main = defaultMainWithHooks simpleUserHooks
  
    { postConf = \args flags pkg lbi ->
        do let pkgs = allPackages (installedPkgs lbi)
           validateLicenses pkgs
           generateBuildModule (fromFlag (configVerbosity flags)) pkg lbi pkgs
           postConf simpleUserHooks args flags pkg lbi
    }
  
  
  -- | Compute the name of the Build module for a given package
  buildModuleName ::
    PackageDescription {- ^ package description -} ->
    String             {- ^ module name         -}
  buildModuleName pkg = "Build_" ++ map clean (unPackageName (pkgName (package pkg)))
    where
      clean x | isAlphaNum x = x
              | otherwise    = '_'
  
  
  -- | Generate the Build_package module for the given package information.
  --
  -- This module will export `deps :: [(String,[Int])]`
  generateBuildModule ::
    Verbosity              {- ^ build verbosity                 -} ->
    PackageDescription     {- ^ package description             -} ->
    LocalBuildInfo         {- ^ local build information         -} ->
    [InstalledPackageInfo] {- ^ transitive package dependencies -} ->
    IO ()
  generateBuildModule verbosity pkg lbi pkgs =
    withLibLBI pkg lbi $ \_lib clbi ->
    do let modname = buildModuleName pkg
  
  #if MIN_VERSION_Cabal(3,14,0)
       writeAutogenFiles verbosity lbi clbi $
         Map.singleton (AutogenModule (M.fromString modname) (Suffix "hs")) $
         B.pack $
  #else
       let dir = autogenComponentModulesDir lbi clbi
           file    = dir </> modname <.> "hs"
       createDirectoryIfMissingVerbose verbosity True dir
       rewriteFileEx verbosity file $
  #endif
         unlines
               [ "{-|"
               , "Module      : " ++ modname
               , "Description : Dynamically generated configuration module"
               , "-}"
               , "module " ++ modname ++ " (deps) where"
               , ""
               , "-- | Transitive dependencies for this package computed at configure-time"
               , "deps :: [(String,[Int])] -- ^ package name, version number"
               , "deps = " ++ renderDeps pkgs
               ]
  
  
  -- | Render the transitive package dependencies as a Haskell expression
  renderDeps ::
    [InstalledPackageInfo] {- ^ transitive package dependencies -} ->
    String                 {- ^ haskell syntax                  -}
  renderDeps pkgs =
    show [ (unPackageName (pkgName p), versionNumbers (pkgVersion p))
         | p <- sourcePackageId <$> pkgs
         ]
  
  -- | Check that all transitive dependencies are available under an acceptable
  -- license. Raises a user-error on failure.
  validateLicenses ::
    [InstalledPackageInfo] {- ^ transitive package dependencies -} ->
    IO ()
  validateLicenses pkgs =
    do let toLicense = either licenseFromSPDX id
           isBad pkg = toLicense (license pkg) `notElem` freeLicenses
                    && pkgName (sourcePackageId pkg) `notElem` exemptions
           badPkgs   = filter isBad pkgs
           exemptions = [mkPackageName "system-cxx-std-lib"]
  
       unless (null badPkgs) $
         do mapM_ print [ (sourcePackageId pkg, toLicense (license pkg)) | pkg <- badPkgs ]
            fail "BAD LICENSE"
  
  
  -- | The set of permissive licenses that are acceptable for transitive dependencies
  -- of this package: BSD2, BSD3, ISC, MIT, PublicDomain
  freeLicenses :: [License]
  freeLicenses = [BSD2, BSD3, ISC, MIT, PublicDomain, UnknownLicense "LicenseRefPublicDomain"]
  