Skip to content
GitLab
Projects
Groups
Snippets
Help
Loading...
Help
Help
Support
Community forum
Keyboard shortcuts
?
Submit feedback
Sign in / Register
Toggle navigation
Glasgow Haskell Compiler
Project overview
Project overview
Details
Activity
Releases
Repository
Repository
Files
Commits
Branches
Tags
Contributors
Graph
Compare
Locked Files
Issues
0
Issues
0
List
Boards
Labels
Service Desk
Milestones
Iterations
Merge Requests
0
Merge Requests
0
Requirements
Requirements
List
CI / CD
CI / CD
Pipelines
Jobs
Schedules
Security & Compliance
Security & Compliance
Dependency List
License Compliance
Operations
Operations
Incidents
Environments
Packages & Registries
Packages & Registries
Package Registry
Container Registry
Analytics
Analytics
CI / CD
Code Review
Insights
Issue
Repository
Value Stream
Wiki
Wiki
Snippets
Snippets
Members
Members
Collapse sidebar
Close sidebar
Activity
Graph
Create a new issue
Jobs
Commits
Issue Boards
Open sidebar
Shayne Fletcher
Glasgow Haskell Compiler
Commits
69e55e74
Commit
69e55e74
authored
Sep 13, 2002
by
simonpj
Browse files
Options
Browse Files
Download
Email Patches
Plain Diff
[project @ 2002-09-13 15:01:40 by simonpj]
Make ghc-pkg independent of hslibs
parent
7e2009cf
Changes
1
Hide whitespace changes
Inline
Side-by-side
Showing
1 changed file
with
38 additions
and
7 deletions
+38
-7
ghc/utils/ghc-pkg/Main.hs
ghc/utils/ghc-pkg/Main.hs
+38
-7
No files found.
ghc/utils/ghc-pkg/Main.hs
View file @
69e55e74
{-# OPTIONS -fglasgow-exts #-}
-----------------------------------------------------------------------------
-- $Id: Main.hs,v 1.2
7 2002/09/09 11:32:37 simonmar
Exp $
-- $Id: Main.hs,v 1.2
8 2002/09/13 15:01:40 simonpj
Exp $
--
-- Package management tool
-----------------------------------------------------------------------------
...
...
@@ -32,7 +34,8 @@ import ParsePkgConfLite
#
include
"../../includes/config.h"
#
ifdef
mingw32_HOST_OS
import
Win32DLL
import
CString
import
Foreign
#
endif
main
=
do
...
...
@@ -90,15 +93,17 @@ unDosifyPath xs = subst '\\' '/' xs
#
endif
runit
clis
=
do
let
err_msg
=
"missing -f option, location of package.conf unknown"
conf_file
<-
case
[
f
|
Config
f
<-
clis
]
of
fs
@
(
_
:
_
)
->
return
(
last
fs
)
#
ifndef
mingw32_HOST_OS
[]
->
die
"missing -f option, location of package.conf unknown"
[]
->
die
err_msg
#
else
[]
->
do
h
<-
getModuleHandle
Nothing
n
<-
getModuleFileName
h
return
(
reverse
(
drop
(
length
"/bin/ghc-pkg.exe"
)
(
reverse
(
unDosifyPath
n
)))
++
"/package.conf"
)
[]
->
do
mb_dir
<-
getExecDir
"/bin/ghc-pkg.exe"
case
mb_dir
of
Nothing
->
die
err_msg
Just
dir
->
return
(
dir
++
"/package.conf"
)
#
endif
let
toField
"import_dirs"
=
return
import_dirs
...
...
@@ -150,7 +155,7 @@ showPackage packages pkgconf pkg_name fields =
[]
->
die
(
"can't find package `"
++
pkg_name
++
"'"
)
[
pkg
]
|
null
fields
->
hPutStrLn
stdout
(
render
(
dumpPkgGuts
pkg
))
|
otherwise
->
hPutStrLn
stdout
(
render
(
vcat
(
map
(
vcat
.
map
text
)
(
map
(
$
pkg
)
fields
))))
(
map
(
vcat
.
map
text
)
(
map
(
$
pkg
)
fields
))))
_
->
die
"showPackage: internal error"
addPackage
::
[
PackageConfig
]
->
FilePath
->
FilePath
...
...
@@ -399,3 +404,29 @@ my_catch = Exception.catchAllIO
#
endif
#
endif
-----------------------------------------
-- Cut and pasted from ghc/compiler/SysTools
#
if
defined
(
mingw32_HOST_OS
)
getExecDir
::
String
->
IO
(
Maybe
String
)
-- (getExecDir cmd) returns the directory in which the current
-- executable, which should be called 'cmd', is running
-- So if the full path is /a/b/c/d/e, and you pass "d/e" as cmd,
-- you'll get "/a/b/c" back as the result
getExecDir
cmd
=
allocaArray
len
$
\
buf
->
do
ret
<-
getModuleFileName
nullPtr
buf
len
if
ret
==
0
then
return
Nothing
else
do
s
<-
peekCString
buf
return
(
Just
(
reverse
(
drop
(
length
cmd
)
(
reverse
(
unDosifyPath
s
)))))
where
len
=
2048
::
Int
-- Plenty, PATH_MAX is 512 under Win32.
foreign
import
stdcall
"GetModuleFileNameA"
unsafe
getModuleFileName
::
Ptr
()
->
CString
->
Int
->
IO
Int32
#
else
getExecDir
::
String
->
IO
(
Maybe
String
)
getExecDir
s
=
do
return
Nothing
#
endif
Write
Preview
Markdown
is supported
0%
Try again
or
attach a new file
.
Attach a file
Cancel
You are about to add
0
people
to the discussion. Proceed with caution.
Finish editing this message first!
Cancel
Please
register
or
sign in
to comment