-- ------------------------------------------------------ --
-- Copyright © 2019 Colin Woodbury <colin@fosskers.ca>
-- Copyright © 2015-2020 Lars Kuhtz <lakuhtz@gmail.com>
-- Copyright © 2014 AlephCloud Systems, Inc.
-- ------------------------------------------------------ --

{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

{-# OPTIONS_HADDOCK show-extensions #-}

-- | This module contains a @Setup.hs@ script that hooks into the cabal build
-- process at the end of the configuration phase and generates a module with
-- package information for each component of the cabal package.
--
-- The modules are created in the /autogen/ build directories where also the
-- @Path_@ modules are created by cabal's simple build setup.
--
-- = Usage as Setup Script
--
-- There are three ways how this module can be used:
--
-- 1. Copy the code of this module into a file called @Setup.hs@ in the root
--    directory of your package.
--
-- 2. If the /configuration-tools/ package is already installed in the system
--    where the build is done, following code can be used as @Setup.hs@ script:
--
--    > module Main (main) where
--    >
--    > import Configuration.Utils.Setup
--
-- 3. For usage within a more complex @Setup.hs@ script you shall import this
--    module qualified and use the 'mkPkgInfoModules' function. For example:
--
--    > module Main (main) where
--    >
--    > import qualified Configuration.Utils.Setup as ConfTools
--    >
--    > main :: IO ()
--    > main = defaultMainWithHooks (ConfTools.mkPkgInfoModules simpleUserHooks)
--    >
--
-- With all methods the field @Build-Type@ in the package description (cabal) file
-- must be set to @Custom@:
--
-- > Build-Type: Custom
--
--
-- = Integration With "Configuration.Utils"
--
-- You can integrate the information provided by the @PkgInfo@ modules with the
-- command line interface of an application by importing the respective module
-- for the component and using the
-- 'Configuration.Utils.runWithPkgInfoConfiguration' function from the module
-- "Configuration.Utils" as show in the following example:
--
-- > {-# LANGUAGE OverloadedStrings #-}
-- > {-# LANGUAGE FlexibleInstances #-}
-- >
-- > module Main
-- > ( main
-- > ) where
-- >
-- > import Configuration.Utils
-- > import PkgInfo
-- >
-- > instance FromJSON (() -> ()) where parseJSON _ = pure id
-- >
-- > mainInfo :: ProgramInfo ()
-- > mainInfo = programInfo "Hello World" (pure id) ()
-- >
-- > main :: IO ()
-- > main = runWithPkgInfoConfiguration mainInfo pkgInfo . const $ putStrLn "hello world"
--
-- With that the resulting application supports the following additional command
-- line options:
--
-- [@--version@, @-v@]
--     prints the version of the application and exits.
--
-- [@--info@, @-i@]
--     prints a short info message for the application and exits.
--
-- [@--long-info@]
--     print a detailed info message for the application and exits.
--     Beside component name, package name, version, revision, and copyright
--     the message also contain information about the compiler that
--     was used for the build, the build architecture, build flags,
--     the author, the license type, and a list of all direct and
--     indirect dependencies along with their licenses and copyrights.
--
-- [@--license@]
--     prints the text of the lincense of the application and exits.
--
module Configuration.Utils.Setup
( main
, mkPkgInfoModules
) where

import qualified Distribution.Compat.Graph as Graph
import qualified Distribution.InstalledPackageInfo as I
import Distribution.PackageDescription
import Distribution.Pretty
import Distribution.Simple
import Distribution.Simple.BuildPaths
import Distribution.Simple.LocalBuildInfo
import Distribution.Simple.PackageIndex
import Distribution.Simple.Setup
import Distribution.Text
import Distribution.Utils.Path
import Distribution.Utils.ShortText

import System.Process

import Control.Applicative
import Control.Monad

import qualified Data.ByteString as B
import Data.ByteString.Char8 (pack)
import Data.Char (isSpace)
import Data.List (intercalate)
import Data.Monoid

import Prelude hiding (readFile, writeFile)

import System.Directory
    (canonicalizePath, createDirectoryIfMissing, doesDirectoryExist,
    doesFileExist, getCurrentDirectory)
import System.Exit (ExitCode(ExitSuccess))
import System.FilePath (isDrive, takeDirectory, (</>))

-- | Include this function when your setup doesn't contain any
-- extra functionality.
--
main :: IO ()
main :: IO ()
main = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> UserHooks
mkPkgInfoModules UserHooks
simpleUserHooks)

-- | Modifies the given record of hooks by adding functionality that
-- creates a package info module for each component of the cabal package.
--
-- This function is intended for usage in more complex @Setup.hs@ scripts.
-- If your setup doesn't contain any other function you can just import
-- the 'main' function from this module.
--
-- The modules are created in the /autogen/ build directories where also the
-- @Path_@ modules are created by cabal's simple build setup.
--
mkPkgInfoModules
    :: UserHooks
    -> UserHooks
mkPkgInfoModules :: UserHooks -> UserHooks
mkPkgInfoModules UserHooks
hooks = UserHooks
hooks
    { postConf :: [String]
-> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postConf = ([String]
 -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())
-> [String]
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
mkPkgInfoModulesPostConf (UserHooks
-> [String]
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postConf UserHooks
hooks)
    }

-- -------------------------------------------------------------------------- --
-- Compat Implementations

prettyLicense :: I.InstalledPackageInfo -> String
prettyLicense :: InstalledPackageInfo -> String
prettyLicense = forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either forall a. Pretty a => a -> String
prettyShow forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> Either License License
I.license

ft :: ShortText -> String
ft :: ShortText -> String
ft = ShortText -> String
fromShortText

-- -------------------------------------------------------------------------- --
-- Cabal 2.0

mkPkgInfoModulesPostConf
    :: (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())
    -> Args
    -> ConfigFlags
    -> PackageDescription
    -> LocalBuildInfo
    -> IO ()
mkPkgInfoModulesPostConf :: ([String]
 -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())
-> [String]
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
mkPkgInfoModulesPostConf [String]
-> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
hook [String]
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
bInfo = do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> IO ()
updatePkgInfoModule PackageDescription
pkgDesc LocalBuildInfo
bInfo) forall a b. (a -> b) -> a -> b
$ forall a. Graph a -> [a]
Graph.toList forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph LocalBuildInfo
bInfo
    [String]
-> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
hook [String]
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
bInfo

updatePkgInfoModule :: PackageDescription -> LocalBuildInfo -> ComponentLocalBuildInfo -> IO ()
updatePkgInfoModule :: PackageDescription
-> LocalBuildInfo -> ComponentLocalBuildInfo -> IO ()
updatePkgInfoModule PackageDescription
pkgDesc LocalBuildInfo
bInfo ComponentLocalBuildInfo
clbInfo = do
    Bool -> String -> IO ()
createDirectoryIfMissing Bool
True String
dirName
    ByteString
moduleBytes <- String
-> Maybe String
-> PackageDescription
-> LocalBuildInfo
-> IO ByteString
pkgInfoModule String
moduleName Maybe String
cName PackageDescription
pkgDesc LocalBuildInfo
bInfo
    String -> ByteString -> IO ()
updateFile String
fileName ByteString
moduleBytes

    -- legacy module
    ByteString
legacyModuleBytes <- String
-> Maybe String
-> PackageDescription
-> LocalBuildInfo
-> IO ByteString
pkgInfoModule String
legacyModuleName Maybe String
cName PackageDescription
pkgDesc LocalBuildInfo
bInfo
    String -> ByteString -> IO ()
updateFile String
legacyFileName ByteString
legacyModuleBytes

  where
    dirName :: String
dirName = LocalBuildInfo -> ComponentLocalBuildInfo -> String
autogenComponentModulesDir LocalBuildInfo
bInfo ComponentLocalBuildInfo
clbInfo
    cName :: Maybe String
cName = UnqualComponentName -> String
unUnqualComponentName forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ComponentName -> Maybe UnqualComponentName
componentNameString (ComponentLocalBuildInfo -> ComponentName
componentLocalName ComponentLocalBuildInfo
clbInfo)

    moduleName :: String
moduleName = String
pkgInfoModuleName
    fileName :: String
fileName = String
dirName forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
moduleName forall a. [a] -> [a] -> [a]
++ String
".hs"

    legacyModuleName :: String
legacyModuleName = Maybe String -> String
legacyPkgInfoModuleName Maybe String
cName
    legacyFileName :: String
legacyFileName = String
dirName forall a. [a] -> [a] -> [a]
++ String
"/" forall a. [a] -> [a] -> [a]
++ String
legacyModuleName forall a. [a] -> [a] -> [a]
++ String
".hs"

-- -------------------------------------------------------------------------- --
-- Generate PkgInfo Module

pkgInfoModuleName :: String
pkgInfoModuleName :: String
pkgInfoModuleName = String
"PkgInfo"

updateFile :: FilePath -> B.ByteString -> IO ()
updateFile :: String -> ByteString -> IO ()
updateFile String
fileName ByteString
content = do
    Bool
x <- String -> IO Bool
doesFileExist String
fileName
    if | Bool -> Bool
not Bool
x -> IO ()
update
       | Bool
otherwise -> do
           ByteString
oldRevisionFile <- String -> IO ByteString
B.readFile String
fileName
           forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
oldRevisionFile forall a. Eq a => a -> a -> Bool
/= ByteString
content) IO ()
update
  where
    update :: IO ()
update = String -> ByteString -> IO ()
B.writeFile String
fileName ByteString
content

legacyPkgInfoModuleName :: Maybe String -> String
legacyPkgInfoModuleName :: Maybe String -> String
legacyPkgInfoModuleName Maybe String
Nothing = String
"PkgInfo"
legacyPkgInfoModuleName (Just String
cn) = String
"PkgInfo_" forall a. [a] -> [a] -> [a]
++ forall a b. (a -> b) -> [a] -> [b]
map Char -> Char
tr String
cn
  where
    tr :: Char -> Char
tr Char
'-' = Char
'_'
    tr Char
c = Char
c

trim :: String -> String
trim :: String -> String
trim = String -> String
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
  where f :: String -> String
f = forall a. [a] -> [a]
reverse forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

getVCS :: IO (Maybe KnownRepoType)
getVCS :: IO (Maybe KnownRepoType)
getVCS = IO String
getCurrentDirectory forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (Maybe KnownRepoType)
getVcsOfDir
  where
    getVcsOfDir :: String -> IO (Maybe KnownRepoType)
getVcsOfDir String
d = do
        String
canonicDir <- String -> IO String
canonicalizePath String
d
        String -> IO Bool
doesDirectoryExist (String
canonicDir String -> String -> String
</> String
".hg") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x0 -> if Bool
x0
        then forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just KnownRepoType
Mercurial)
        else String -> IO Bool
doesDirectoryExist (String
canonicDir String -> String -> String
</> String
".git") forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x1 -> if Bool
x1
            then forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just KnownRepoType
Git
            else if String -> Bool
isDrive String
canonicDir
                then forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
                else String -> IO (Maybe KnownRepoType)
getVcsOfDir (String -> String
takeDirectory String
canonicDir)

pkgInfoModule :: String -> Maybe String -> PackageDescription -> LocalBuildInfo -> IO B.ByteString
pkgInfoModule :: String
-> Maybe String
-> PackageDescription
-> LocalBuildInfo
-> IO ByteString
pkgInfoModule String
moduleName Maybe String
cName PackageDescription
pkgDesc LocalBuildInfo
bInfo = do
    (String
tag, String
revision, String
branch) <- IO (Maybe KnownRepoType)
getVCS forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just KnownRepoType
Mercurial -> IO (String, String, String)
hgInfo
        Just KnownRepoType
Git -> IO (String, String, String)
gitInfo
        Maybe KnownRepoType
_ -> IO (String, String, String)
noVcsInfo

    let vcsBranch :: String
vcsBranch = if String
branch forall a. Eq a => a -> a -> Bool
== String
"default" Bool -> Bool -> Bool
|| String
branch forall a. Eq a => a -> a -> Bool
== String
"master" then String
"" else String
branch
        vcsVersion :: String
vcsVersion = forall a. [a] -> [[a]] -> [a]
intercalate String
"-" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter (forall a. Eq a => a -> a -> Bool
/= String
"") forall a b. (a -> b) -> a -> b
$ [String
tag, String
revision, String
vcsBranch]
        flags :: [String]
flags = forall a b. (a -> b) -> [a] -> [b]
map (FlagName -> String
unFlagName forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. (a -> Bool) -> [a] -> [a]
filter forall a b. (a, b) -> b
snd forall b c a. (b -> c) -> (a -> b) -> a -> c
. FlagAssignment -> [(FlagName, Bool)]
unFlagAssignment forall b c a. (b -> c) -> (a -> b) -> a -> c
. ConfigFlags -> FlagAssignment
configConfigurationsFlags forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> ConfigFlags
configFlags forall a b. (a -> b) -> a -> b
$ LocalBuildInfo
bInfo

    ByteString
licenseString <- PackageDescription -> IO ByteString
licenseFilesText PackageDescription
pkgDesc

    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\n"
            [ ByteString
"{-# LANGUAGE OverloadedStrings #-}"
            , ByteString
"{-# LANGUAGE RankNTypes #-}"
            , ByteString
""
            , ByteString
"module " forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
moduleName forall a. Semigroup a => a -> a -> a
<> ByteString
" " forall a. Semigroup a => a -> a -> a
<> ByteString
deprecatedMsg forall a. Semigroup a => a -> a -> a
<> ByteString
" where"
            , ByteString
""
            , ByteString
"    import Data.String (IsString)"
            , ByteString
"    import Data.Monoid"
            , ByteString
"    import Prelude hiding ((<>))"
            , ByteString
""
            , ByteString
"    name :: IsString a => Maybe a"
            , ByteString
"    name = " forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"Nothing" (\String
x -> ByteString
"Just \"" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
x forall a. Semigroup a => a -> a -> a
<> ByteString
"\"") Maybe String
cName
            , ByteString
""
            , ByteString
"    tag :: IsString a => a"
            , ByteString
"    tag = \"" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
tag forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    revision :: IsString a => a"
            , ByteString
"    revision = \"" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
revision forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    branch :: IsString a => a"
            , ByteString
"    branch = \"" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
branch forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    branch' :: IsString a => a"
            , ByteString
"    branch' = \"" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
vcsBranch forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    vcsVersion :: IsString a => a"
            , ByteString
"    vcsVersion = \"" forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
vcsVersion forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    compiler :: IsString a => a"
            , ByteString
"    compiler = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> CompilerId
compilerId forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler) LocalBuildInfo
bInfo forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    flags :: IsString a => [a]"
            , ByteString
"    flags = " forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [String]
flags
            , ByteString
""
            , ByteString
"    optimisation :: IsString a => a"
            , ByteString
"    optimisation = \"" forall a. Semigroup a => a -> a -> a
<> (forall {a}. IsString a => OptimisationLevel -> a
displayOptimisationLevel forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> OptimisationLevel
withOptimization) LocalBuildInfo
bInfo forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    arch :: IsString a => a"
            , ByteString
"    arch = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Platform
hostPlatform) LocalBuildInfo
bInfo forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    license :: IsString a => a"
            , ByteString
"    license = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
prettyShow forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> License
license) PackageDescription
pkgDesc forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    licenseText :: IsString a => a"
            , ByteString
"    licenseText = " forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) ByteString
licenseString
            , ByteString
""
            , ByteString
"    copyright :: IsString a => a"
            , ByteString
"    copyright = " forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
copyright) PackageDescription
pkgDesc
            , ByteString
""
            , ByteString
"    author :: IsString a => a"
            , ByteString
"    author = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
ft forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
author) PackageDescription
pkgDesc forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    homepage :: IsString a => a"
            , ByteString
"    homepage = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
ft forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
homepage) PackageDescription
pkgDesc forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    package :: IsString a => a"
            , ByteString
"    package = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package) PackageDescription
pkgDesc forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    packageName :: IsString a => a"
            , ByteString
"    packageName = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageName
packageName) PackageDescription
pkgDesc forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    packageVersion :: IsString a => a"
            , ByteString
"    packageVersion = \"" forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> Version
packageVersion) PackageDescription
pkgDesc forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    dependencies :: IsString a => [a]"
            , ByteString
"    dependencies = " forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map (forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PackageIndex a -> [a]
allPackages forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> InstalledPackageIndex
installedPkgs) LocalBuildInfo
bInfo
            , ByteString
""
            , ByteString
"    dependenciesWithLicenses :: IsString a => [a]"
            , ByteString
"    dependenciesWithLicenses = " forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> String
pkgIdWithLicense forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. PackageIndex a -> [a]
allPackages forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> InstalledPackageIndex
installedPkgs) LocalBuildInfo
bInfo
            , ByteString
""
            , ByteString
"    versionString :: (Monoid a, IsString a) => a"
            , ByteString
"    versionString = case name of"
            , ByteString
"        Nothing -> package <> \" (revision \" <> vcsVersion <> \")\""
            , ByteString
"        Just n -> n <> \"-\" <> packageVersion <> \" (package \" <> package <> \" revision \" <> vcsVersion <> \")\""
            , ByteString
""
            , ByteString
"    info :: (Monoid a, IsString a) => a"
            , ByteString
"    info = versionString <> \"\\n\" <> copyright"
            , ByteString
""
            , ByteString
"    longInfo :: (Monoid a, IsString a) => a"
            , ByteString
"    longInfo = info <> \"\\n\\n\""
            , ByteString
"        <> \"Author: \" <> author <> \"\\n\""
            , ByteString
"        <> \"License: \" <> license <> \"\\n\""
            , ByteString
"        <> \"Homepage: \" <> homepage <> \"\\n\""
            , ByteString
"        <> \"Build with: \" <> compiler <> \" (\" <> arch <> \")\" <> \"\\n\""
            , ByteString
"        <> \"Build flags: \" <> mconcat (map (\\x -> \" \" <> x) flags) <> \"\\n\""
            , ByteString
"        <> \"Optimisation: \" <> optimisation <> \"\\n\\n\""
            , ByteString
"        <> \"Dependencies:\\n\" <> mconcat (map (\\x -> \"    \" <> x <> \"\\n\") dependenciesWithLicenses)"
            , ByteString
""
            , ByteString
"    pkgInfo :: (Monoid a, IsString a) => (a, a, a, a)"
            , ByteString
"    pkgInfo ="
            , ByteString
"        ( info"
            , ByteString
"        , longInfo"
            , ByteString
"        , versionString"
            , ByteString
"        , licenseText"
            , ByteString
"        )"
            , ByteString
""
            ]
  where
    displayOptimisationLevel :: OptimisationLevel -> a
displayOptimisationLevel OptimisationLevel
NoOptimisation = a
"none"
    displayOptimisationLevel OptimisationLevel
NormalOptimisation = a
"normal"
    displayOptimisationLevel OptimisationLevel
MaximumOptimisation = a
"maximum"

    deprecatedMsg :: ByteString
deprecatedMsg = if String
moduleName forall a. Eq a => a -> a -> Bool
/= String
pkgInfoModuleName
        then ByteString
"{-# DEPRECATED \"Update to Cabal 2.0 or later and use just PkgInfo as module name.\" #-}"
        else ByteString
""

licenseFilesText :: PackageDescription -> IO B.ByteString
licenseFilesText :: PackageDescription -> IO ByteString
licenseFilesText PackageDescription
pkgDesc =
    ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\n------------------------------------------------------------\n" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM forall {from} {to}. SymbolicPath from to -> IO ByteString
fileTextStr
        (PackageDescription -> [SymbolicPath PackageDir LicenseFile]
licenseFiles PackageDescription
pkgDesc)
  where
    fileText :: String -> IO ByteString
fileText String
file = String -> IO Bool
doesFileExist String
file forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x -> if Bool
x
        then String -> IO ByteString
B.readFile String
file
        else forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""
    fileTextStr :: SymbolicPath from to -> IO ByteString
fileTextStr = String -> IO ByteString
fileText forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall from to. SymbolicPath from to -> String
getSymbolicPath


hgInfo :: IO (String, String, String)
hgInfo :: IO (String, String, String)
hgInfo = do
    String
tag <- String -> String
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"hg" [String
"id", String
"-r", String
"max(ancestors(\".\") and tag())", String
"-t"] String
""
    String
rev <- String -> String
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"hg" [String
"id", String
"-i"] String
""
    String
branch <- String -> String
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"hg" [String
"id", String
"-b"] String
""
    forall (m :: * -> *) a. Monad m => a -> m a
return (String
tag, String
rev, String
branch)

gitInfo :: IO (String, String, String)
gitInfo :: IO (String, String, String)
gitInfo = do
    String
tag <- do
        (ExitCode
exitCode, String
out, String
_err) <- String -> [String] -> String -> IO (ExitCode, String, String)
readProcessWithExitCode String
"git" [String
"describe", String
"--exact-match", String
"--tags", String
"--abbrev=0"] String
""
        case ExitCode
exitCode of
            ExitCode
ExitSuccess -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ String -> String
trim String
out
            ExitCode
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    String
rev <- String -> String
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"git" [String
"rev-parse", String
"--short", String
"HEAD"] String
""
    String
branch <- String -> String
trim forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> [String] -> String -> IO String
readProcess String
"git" [String
"rev-parse", String
"--abbrev-ref", String
"HEAD"] String
""
    forall (m :: * -> *) a. Monad m => a -> m a
return (String
tag, String
rev, String
branch)

noVcsInfo :: IO (String, String, String)
noVcsInfo :: IO (String, String, String)
noVcsInfo = forall (m :: * -> *) a. Monad m => a -> m a
return (String
"", String
"", String
"")

pkgIdWithLicense :: I.InstalledPackageInfo -> String
pkgIdWithLicense :: InstalledPackageInfo -> String
pkgIdWithLicense InstalledPackageInfo
a = (forall a. Pretty a => a -> String
display forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) InstalledPackageInfo
a
    forall a. [a] -> [a] -> [a]
++ String
" ["
    forall a. [a] -> [a] -> [a]
++ InstalledPackageInfo -> String
prettyLicense InstalledPackageInfo
a
    forall a. [a] -> [a] -> [a]
++ (if String
cr forall a. Eq a => a -> a -> Bool
/= String
"" then String
", " forall a. [a] -> [a] -> [a]
++ String
cr else String
"")
    forall a. [a] -> [a] -> [a]
++ String
"]"
  where
    cr :: String
cr = ([String] -> String
unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> [String]
words forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
ft forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> ShortText
I.copyright) InstalledPackageInfo
a