-- ------------------------------------------------------ --
-- 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.Types.UnqualComponentName

#if MIN_VERSION_Cabal(3,2,0)
import Distribution.Utils.ShortText
#endif

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 :: Args
-> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
postConf = (Args
 -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())
-> Args
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
mkPkgInfoModulesPostConf (UserHooks
-> Args
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
postConf UserHooks
hooks)
    }

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

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

#if MIN_VERSION_Cabal(3,2,0)
ft :: ShortText -> String
ft :: ShortText -> String
ft = ShortText -> String
fromShortText
#else
ft :: String -> String
ft = id
#endif

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

mkPkgInfoModulesPostConf
    :: (Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())
    -> Args
    -> ConfigFlags
    -> PackageDescription
    -> LocalBuildInfo
    -> IO ()
mkPkgInfoModulesPostConf :: (Args
 -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ())
-> Args
-> ConfigFlags
-> PackageDescription
-> LocalBuildInfo
-> IO ()
mkPkgInfoModulesPostConf Args
-> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
hook Args
args ConfigFlags
flags PackageDescription
pkgDesc LocalBuildInfo
bInfo = do
    (ComponentLocalBuildInfo -> IO ())
-> [ComponentLocalBuildInfo] -> IO ()
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) ([ComponentLocalBuildInfo] -> IO ())
-> [ComponentLocalBuildInfo] -> IO ()
forall a b. (a -> b) -> a -> b
$ Graph ComponentLocalBuildInfo -> [ComponentLocalBuildInfo]
forall a. Graph a -> [a]
Graph.toList (Graph ComponentLocalBuildInfo -> [ComponentLocalBuildInfo])
-> Graph ComponentLocalBuildInfo -> [ComponentLocalBuildInfo]
forall a b. (a -> b) -> a -> b
$ LocalBuildInfo -> Graph ComponentLocalBuildInfo
componentGraph LocalBuildInfo
bInfo
    Args
-> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
hook Args
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 (UnqualComponentName -> String)
-> Maybe UnqualComponentName -> Maybe String
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 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
moduleName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
".hs"

    legacyModuleName :: String
legacyModuleName = Maybe String -> String
legacyPkgInfoModuleName Maybe String
cName
    legacyFileName :: String
legacyFileName = String
dirName String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"/" String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
legacyModuleName String -> String -> String
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
           Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (ByteString
oldRevisionFile ByteString -> ByteString -> Bool
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_" String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Char -> Char) -> String -> String
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 (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> String
f
  where f :: String -> String
f = String -> String
forall a. [a] -> [a]
reverse (String -> String) -> (String -> String) -> String -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Char -> Bool) -> String -> String
forall a. (a -> Bool) -> [a] -> [a]
dropWhile Char -> Bool
isSpace

#if defined (MIN_VERSION_Cabal) && MIN_VERSION_Cabal(3,4,0)
getVCS :: IO (Maybe KnownRepoType)
#else
getVCS :: IO (Maybe RepoType)
#endif
getVCS :: IO (Maybe RepoType)
getVCS = IO String
getCurrentDirectory IO String -> (String -> IO (Maybe RepoType)) -> IO (Maybe RepoType)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= String -> IO (Maybe RepoType)
getVcsOfDir
  where
    getVcsOfDir :: String -> IO (Maybe RepoType)
getVcsOfDir String
d = do
        String
canonicDir <- String -> IO String
canonicalizePath String
d
        String -> IO Bool
doesDirectoryExist (String
canonicDir String -> String -> String
</> String
".hg") IO Bool -> (Bool -> IO (Maybe RepoType)) -> IO (Maybe RepoType)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x0 -> if Bool
x0
        then Maybe RepoType -> IO (Maybe RepoType)
forall (m :: * -> *) a. Monad m => a -> m a
return (RepoType -> Maybe RepoType
forall a. a -> Maybe a
Just RepoType
Mercurial)
        else String -> IO Bool
doesDirectoryExist (String
canonicDir String -> String -> String
</> String
".git") IO Bool -> (Bool -> IO (Maybe RepoType)) -> IO (Maybe RepoType)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \Bool
x1 -> if Bool
x1
            then Maybe RepoType -> IO (Maybe RepoType)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe RepoType -> IO (Maybe RepoType))
-> Maybe RepoType -> IO (Maybe RepoType)
forall a b. (a -> b) -> a -> b
$ RepoType -> Maybe RepoType
forall a. a -> Maybe a
Just RepoType
Git
            else if String -> Bool
isDrive String
canonicDir
                then Maybe RepoType -> IO (Maybe RepoType)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe RepoType
forall a. Maybe a
Nothing
                else String -> IO (Maybe RepoType)
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 RepoType)
getVCS IO (Maybe RepoType)
-> (Maybe RepoType -> IO (String, String, String))
-> IO (String, String, String)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
        Just RepoType
Mercurial -> IO (String, String, String)
hgInfo
        Just RepoType
Git -> IO (String, String, String)
gitInfo
        Maybe RepoType
_ -> IO (String, String, String)
noVcsInfo

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

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

    ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> [ByteString] -> ByteString
B.intercalate ByteString
"\n"
            [ ByteString
"{-# LANGUAGE OverloadedStrings #-}"
            , ByteString
"{-# LANGUAGE RankNTypes #-}"
            , ByteString
""
            , ByteString
"module " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
moduleName ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
" " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
deprecatedMsg ByteString -> ByteString -> ByteString
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 = " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString -> (String -> ByteString) -> Maybe String -> ByteString
forall b a. b -> (a -> b) -> Maybe a -> b
maybe ByteString
"Nothing" (\String
x -> ByteString
"Just \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
x ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\"") Maybe String
cName
            , ByteString
""
            , ByteString
"    tag :: IsString a => a"
            , ByteString
"    tag = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
tag ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    revision :: IsString a => a"
            , ByteString
"    revision = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
revision ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    branch :: IsString a => a"
            , ByteString
"    branch = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
branch ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    branch' :: IsString a => a"
            , ByteString
"    branch' = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
vcsBranch ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    vcsVersion :: IsString a => a"
            , ByteString
"    vcsVersion = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> String -> ByteString
pack String
vcsVersion ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    compiler :: IsString a => a"
            , ByteString
"    compiler = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (LocalBuildInfo -> String) -> LocalBuildInfo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CompilerId -> String
forall a. Pretty a => a -> String
display (CompilerId -> String)
-> (LocalBuildInfo -> CompilerId) -> LocalBuildInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Compiler -> CompilerId
compilerId (Compiler -> CompilerId)
-> (LocalBuildInfo -> Compiler) -> LocalBuildInfo -> CompilerId
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Compiler
compiler) LocalBuildInfo
bInfo ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    flags :: IsString a => [a]"
            , ByteString
"    flags = " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString) -> (Args -> String) -> Args -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> String
forall a. Show a => a -> String
show) Args
flags
            , ByteString
""
            , ByteString
"    optimisation :: IsString a => a"
            , ByteString
"    optimisation = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (OptimisationLevel -> ByteString
forall p. IsString p => OptimisationLevel -> p
displayOptimisationLevel (OptimisationLevel -> ByteString)
-> (LocalBuildInfo -> OptimisationLevel)
-> LocalBuildInfo
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> OptimisationLevel
withOptimization) LocalBuildInfo
bInfo ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    arch :: IsString a => a"
            , ByteString
"    arch = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (LocalBuildInfo -> String) -> LocalBuildInfo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Platform -> String
forall a. Pretty a => a -> String
display (Platform -> String)
-> (LocalBuildInfo -> Platform) -> LocalBuildInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> Platform
hostPlatform) LocalBuildInfo
bInfo ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    license :: IsString a => a"
            , ByteString
"    license = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. License -> String
forall a. Pretty a => a -> String
prettyShow (License -> String)
-> (PackageDescription -> License) -> PackageDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> License
license) PackageDescription
pkgDesc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    licenseText :: IsString a => a"
            , ByteString
"    licenseText = " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (ByteString -> String) -> ByteString -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> String
forall a. Show a => a -> String
show) ByteString
licenseString
            , ByteString
""
            , ByteString
"    copyright :: IsString a => a"
            , ByteString
"    copyright = " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
forall a. Show a => a -> String
show (ShortText -> String)
-> (PackageDescription -> ShortText)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
copyright) PackageDescription
pkgDesc
            , ByteString
""
            , ByteString
"    author :: IsString a => a"
            , ByteString
"    author = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
ft (ShortText -> String)
-> (PackageDescription -> ShortText)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
author) PackageDescription
pkgDesc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    homepage :: IsString a => a"
            , ByteString
"    homepage = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShortText -> String
ft (ShortText -> String)
-> (PackageDescription -> ShortText)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> ShortText
homepage) PackageDescription
pkgDesc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    package :: IsString a => a"
            , ByteString
"    package = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIdentifier -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> String)
-> (PackageDescription -> PackageIdentifier)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageIdentifier
package) PackageDescription
pkgDesc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    packageName :: IsString a => a"
            , ByteString
"    packageName = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageName -> String
forall a. Pretty a => a -> String
display (PackageName -> String)
-> (PackageDescription -> PackageName)
-> PackageDescription
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> PackageName
forall pkg. Package pkg => pkg -> PackageName
packageName) PackageDescription
pkgDesc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    packageVersion :: IsString a => a"
            , ByteString
"    packageVersion = \"" ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (PackageDescription -> String)
-> PackageDescription
-> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Version -> String
forall a. Pretty a => a -> String
display (Version -> String)
-> (PackageDescription -> Version) -> PackageDescription -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageDescription -> Version
forall pkg. Package pkg => pkg -> Version
packageVersion) PackageDescription
pkgDesc ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> ByteString
"\""
            , ByteString
""
            , ByteString
"    dependencies :: IsString a => [a]"
            , ByteString
"    dependencies = " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (LocalBuildInfo -> String) -> LocalBuildInfo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> String
forall a. Show a => a -> String
show (Args -> String)
-> (LocalBuildInfo -> Args) -> LocalBuildInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo -> String) -> [InstalledPackageInfo] -> Args
forall a b. (a -> b) -> [a] -> [b]
map (PackageIdentifier -> String
forall a. Pretty a => a -> String
display (PackageIdentifier -> String)
-> (InstalledPackageInfo -> PackageIdentifier)
-> InstalledPackageInfo
-> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. InstalledPackageInfo -> PackageIdentifier
forall pkg. Package pkg => pkg -> PackageIdentifier
packageId) ([InstalledPackageInfo] -> Args)
-> (LocalBuildInfo -> [InstalledPackageInfo])
-> LocalBuildInfo
-> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIndex InstalledPackageInfo -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
allPackages (PackageIndex InstalledPackageInfo -> [InstalledPackageInfo])
-> (LocalBuildInfo -> PackageIndex InstalledPackageInfo)
-> LocalBuildInfo
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> PackageIndex InstalledPackageInfo
installedPkgs) LocalBuildInfo
bInfo
            , ByteString
""
            , ByteString
"    dependenciesWithLicenses :: IsString a => [a]"
            , ByteString
"    dependenciesWithLicenses = " ByteString -> ByteString -> ByteString
forall a. Semigroup a => a -> a -> a
<> (String -> ByteString
pack (String -> ByteString)
-> (LocalBuildInfo -> String) -> LocalBuildInfo -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Args -> String
forall a. Show a => a -> String
show (Args -> String)
-> (LocalBuildInfo -> Args) -> LocalBuildInfo -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (InstalledPackageInfo -> String) -> [InstalledPackageInfo] -> Args
forall a b. (a -> b) -> [a] -> [b]
map InstalledPackageInfo -> String
pkgIdWithLicense ([InstalledPackageInfo] -> Args)
-> (LocalBuildInfo -> [InstalledPackageInfo])
-> LocalBuildInfo
-> Args
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PackageIndex InstalledPackageInfo -> [InstalledPackageInfo]
forall a. PackageIndex a -> [a]
allPackages (PackageIndex InstalledPackageInfo -> [InstalledPackageInfo])
-> (LocalBuildInfo -> PackageIndex InstalledPackageInfo)
-> LocalBuildInfo
-> [InstalledPackageInfo]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LocalBuildInfo -> PackageIndex InstalledPackageInfo
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 -> p
displayOptimisationLevel OptimisationLevel
NoOptimisation = p
"none"
    displayOptimisationLevel OptimisationLevel
NormalOptimisation = p
"normal"
    displayOptimisationLevel OptimisationLevel
MaximumOptimisation = p
"maximum"

    deprecatedMsg :: ByteString
deprecatedMsg = if String
moduleName String -> String -> Bool
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" ([ByteString] -> ByteString) -> IO [ByteString] -> IO ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (String -> IO ByteString) -> Args -> IO [ByteString]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM String -> IO ByteString
fileText
        (PackageDescription -> Args
licenseFiles PackageDescription
pkgDesc)
  where
    fileText :: String -> IO ByteString
fileText String
file = String -> IO Bool
doesFileExist String
file IO Bool -> (Bool -> IO ByteString) -> IO ByteString
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 ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
""

hgInfo :: IO (String, String, String)
hgInfo :: IO (String, String, String)
hgInfo = do
    String
tag <- String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Args -> String -> IO String
readProcess String
"hg" [String
"id", String
"-r", String
"max(ancestors(\".\") and tag())", String
"-t"] String
""
    String
rev <- String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Args -> String -> IO String
readProcess String
"hg" [String
"id", String
"-i"] String
""
    String
branch <- String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Args -> String -> IO String
readProcess String
"hg" [String
"id", String
"-b"] String
""
    (String, String, String) -> IO (String, String, 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 -> Args -> 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 -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> IO String) -> String -> IO String
forall a b. (a -> b) -> a -> b
$ String -> String
trim String
out
            ExitCode
_ -> String -> IO String
forall (m :: * -> *) a. Monad m => a -> m a
return String
""
    String
rev <- String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Args -> String -> IO String
readProcess String
"git" [String
"rev-parse", String
"--short", String
"HEAD"] String
""
    String
branch <- String -> String
trim (String -> String) -> IO String -> IO String
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> String -> Args -> String -> IO String
readProcess String
"git" [String
"rev-parse", String
"--abbrev-ref", String
"HEAD"] String
""
    (String, String, String) -> IO (String, String, 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 = (String, String, String) -> IO (String, String, String)
forall (m :: * -> *) a. Monad m => a -> m a
return (String
"", String
"", String
"")

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