Skip to content
Browse files

initial import, 0.1.0.1

  • Loading branch information...
0 parents commit 433eb7f0f55ca5b2308746300de6d6f860e21ecf @simonmar committed Jun 23, 2008
Showing with 132 additions and 0 deletions.
  1. +13 −0 GHC/Paths.hs
  2. +29 −0 LICENSE
  3. +74 −0 Setup.hs
  4. +16 −0 ghc-paths.cabal
13 GHC/Paths.hs
@@ -0,0 +1,13 @@
+{-# LANGUAGE CPP #-}
+
+module GHC.Paths (
+ ghc, ghc_pkg, libdir, docdir
+ ) where
+
+libdir, docdir, ghc, ghc_pkg :: FilePath
+
+libdir = GHC_PATHS_LIBDIR
+docdir = GHC_PATHS_DOCDIR
+
+ghc = GHC_PATHS_GHC
+ghc_pkg = GHC_PATHS_GHC_PKG
29 LICENSE
@@ -0,0 +1,29 @@
+Copyright 2008, Simon Marlow
+All rights reserved.
+
+Redistribution and use in source and binary forms, with or without
+modification, are permitted provided that the following conditions are met:
+
+- Redistributions of source code must retain the above copyright notice,
+this list of conditions and the following disclaimer.
+
+- Redistributions in binary form must reproduce the above copyright notice,
+this list of conditions and the following disclaimer in the documentation
+and/or other materials provided with the distribution.
+
+- Neither name of the author nor the names of its contributors may be
+used to endorse or promote products derived from this software without
+specific prior written permission.
+
+THIS SOFTWARE IS PROVIDED BY THE AUTHOR(S) AND THE CONTRIBUTORS "AS
+IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED
+TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A
+PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE UNIVERSITY
+COURT OF THE UNIVERSITY OF GLASGOW OR THE CONTRIBUTORS BE LIABLE FOR
+ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL
+DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE
+GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS
+INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER
+IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR
+OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF
+ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
74 Setup.hs
@@ -0,0 +1,74 @@
+import Distribution.Simple
+import Distribution.Simple.Setup
+import Distribution.PackageDescription
+import Distribution.Simple.LocalBuildInfo
+import Distribution.InstalledPackageInfo
+import Distribution.Simple.Program
+import Distribution.Simple.PackageIndex as Pkg
+
+import System.Exit
+import System.IO
+import Data.IORef
+import Data.Char
+import Data.List
+import Data.Maybe
+
+main = defaultMainWithHooks simpleUserHooks {
+ postConf = defaultPostConf,
+ preBuild = readHook,
+ preMakefile = readHook,
+ preClean = readHook,
+ preCopy = readHook,
+ preInst = readHook,
+ preHscolour = readHook,
+ preHaddock = readHook,
+ preReg = readHook,
+ preUnreg = readHook
+ }
+ where
+ defaultPostConf :: Args -> ConfigFlags -> PackageDescription -> LocalBuildInfo -> IO ()
+ defaultPostConf args flags pkgdescr lbi = do
+ libdir_ <- rawSystemProgramStdoutConf (fromFlag (configVerbosity flags))
+ ghcProgram (withPrograms lbi) ["--print-libdir"]
+ let libdir = reverse $ dropWhile isSpace $ reverse libdir_
+
+ ghc_pkg = case lookupProgram ghcPkgProgram (withPrograms lbi) of
+ Just p -> programPath p
+ Nothing -> error "ghc-pkg was not found"
+ ghc = case lookupProgram ghcProgram (withPrograms lbi) of
+ Just p -> programPath p
+ Nothing -> error "ghc was not found"
+
+ -- figure out docdir from base's haddock-html field
+ base_pkg = case searchByName (installedPkgs lbi) "base" of
+ None -> error "no base package"
+ Unambiguous (x:_) -> x
+ _ -> error "base ambiguous"
+ base_html = case haddockHTMLs base_pkg of
+ [] -> ""
+ (x:_) -> x
+ docdir = fromMaybe base_html $
+ fmap reverse (stripPrefix (reverse "/libraries/base")
+ (reverse base_html))
+
+ let buildinfo = emptyBuildInfo{
+ cppOptions = ["-DGHC_PATHS_GHC_PKG=\"" ++ ghc_pkg ++ "\"",
+ "-DGHC_PATHS_GHC=\"" ++ ghc ++ "\"",
+ "-DGHC_PATHS_LIBDIR=\"" ++ libdir ++ "\"",
+ "-DGHC_PATHS_DOCDIR=\"" ++ docdir ++ "\"" ]
+ }
+ writeFile file (show buildinfo)
+
+ readHook :: Args -> a -> IO HookedBuildInfo
+ readHook _ _ = do
+ str <- readFile file
+ return (Just (read str), [])
+
+file = "ghc-paths.buildinfo"
+
+die :: String -> IO a
+die msg = do
+ hFlush stdout
+ hPutStr stderr msg
+ exitWith (ExitFailure 1)
+
16 ghc-paths.cabal
@@ -0,0 +1,16 @@
+name: ghc-paths
+version: 0.1.0.1
+license: BSD3
+license-file: LICENSE
+copyright: (c) Simon Marlow
+author: Simon Marlow
+maintainer: Simon Marlow <marlowsd@gmail.com>
+stability: stable
+synopsis: Knowledge of GHC's installation directories
+description: Knowledge of GHC's installation directories
+category: Development
+cabal-version: >= 1.2
+build-depends: base
+build-type: Custom
+
+exposed-modules: GHC.Paths

0 comments on commit 433eb7f

Please sign in to comment.
Something went wrong with that request. Please try again.