{-# LANGUAGE CPP #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiWayIf #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# OPTIONS_HADDOCK show-extensions #-}
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, (</>))
main :: IO ()
main :: IO ()
main = UserHooks -> IO ()
defaultMainWithHooks (UserHooks -> UserHooks
mkPkgInfoModules UserHooks
simpleUserHooks)
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)
}
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
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
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"
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