Commit 72bf4b18 authored by Andrey Mokhov's avatar Andrey Mokhov
Browse files

Minor revision

parent da27a1fe
......@@ -17,15 +17,13 @@ module Base (
configPath, configFile, sourcePath,
-- * Miscellaneous utilities
unifyPath, quote, (-/-), matchVersionedFilePath, matchGhcVersionedFilePath,
putColoured
unifyPath, quote, (-/-), putColoured
) where
import Control.Applicative
import Control.Monad.Extra
import Control.Monad.Reader
import Data.Bifunctor
import Data.Char
import Data.Function
import Data.List.Extra
import Data.Maybe
......@@ -58,30 +56,7 @@ configFile = configPath -/- "system.config"
sourcePath :: FilePath
sourcePath = hadrianPath -/- "src"
-- | Given a @prefix@ and a @suffix@ check whether a @filePath@ matches the
-- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
-- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
--
--- * @'matchVersionedFilePath' "foo/bar" ".a" "foo/bar.a" '==' 'True'@
--- * @'matchVersionedFilePath' "foo/bar" ".a" "foo\bar.a" '==' 'False'@
--- * @'matchVersionedFilePath' "foo/bar" "a" "foo/bar.a" '==' 'True'@
--- * @'matchVersionedFilePath' "foo/bar" "" "foo/bar.a" '==' 'False'@
--- * @'matchVersionedFilePath' "foo/bar" "a" "foo/bar-0.1.a" '==' 'True'@
--- * @'matchVersionedFilePath' "foo/bar-" "a" "foo/bar-0.1.a" '==' 'True'@
--- * @'matchVersionedFilePath' "foo/bar/" "a" "foo/bar-0.1.a" '==' 'False'@
matchVersionedFilePath :: String -> String -> FilePath -> Bool
matchVersionedFilePath prefix suffix filePath =
case stripPrefix prefix filePath >>= stripSuffix suffix of
Nothing -> False
Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
matchGhcVersionedFilePath :: String -> String -> FilePath -> Bool
matchGhcVersionedFilePath prefix ext filePath =
case stripPrefix prefix filePath >>= stripSuffix ext of
Nothing -> False
Just _ -> True
-- | A more colourful version of Shake's putNormal.
-- | A more colourful version of Shake's 'putNormal'.
putColoured :: ColorIntensity -> Color -> String -> Action ()
putColoured intensity colour msg = do
c <- useColour
......
......@@ -7,9 +7,11 @@ module Hadrian.Utilities (
quote, yesNo,
-- * FilePath manipulation
unifyPath, (-/-)
unifyPath, (-/-), matchVersionedFilePath
) where
import Data.Char
import Data.List.Extra
import Development.Shake.FilePath
-- | Extract a value from a singleton list, or terminate with an error message
......@@ -79,3 +81,22 @@ a -/- b
| otherwise = a ++ '/' : b
infixr 6 -/-
-- | Given a @prefix@ and a @suffix@ check whether a 'FilePath' matches the
-- template @prefix ++ version ++ suffix@ where @version@ is an arbitrary string
-- comprising digits (@0-9@), dashes (@-@), and dots (@.@). Examples:
--
-- @
-- 'matchVersionedFilePath' "foo/bar" ".a" "foo/bar.a" '==' 'True'
-- 'matchVersionedFilePath' "foo/bar" ".a" "foo\bar.a" '==' 'False'
-- 'matchVersionedFilePath' "foo/bar" "a" "foo/bar.a" '==' 'True'
-- 'matchVersionedFilePath' "foo/bar" "" "foo/bar.a" '==' 'False'
-- 'matchVersionedFilePath' "foo/bar" "a" "foo/bar-0.1.a" '==' 'True'
-- 'matchVersionedFilePath' "foo/bar-" "a" "foo/bar-0.1.a" '==' 'True'
-- 'matchVersionedFilePath' "foo/bar/" "a" "foo/bar-0.1.a" '==' 'False'
-- @
matchVersionedFilePath :: String -> String -> FilePath -> Bool
matchVersionedFilePath prefix suffix filePath =
case stripPrefix prefix filePath >>= stripSuffix suffix of
Nothing -> False
Just version -> all (\c -> isDigit c || c == '-' || c == '.') version
......@@ -3,6 +3,7 @@ module Rules.Library (
) where
import Data.Char
import Hadrian.Utilities
import qualified System.Directory as IO
import Base
......@@ -38,24 +39,22 @@ libraryObjects context@Context{..} = do
buildDynamicLib :: Context -> Rules ()
buildDynamicLib context@Context{..} = do
let path = buildPath context
libPrefix = path -/- "libHS" ++ pkgNameString package
let libPrefix = buildPath context -/- "libHS" ++ pkgNameString package
-- OS X
matchGhcVersionedFilePath libPrefix "dylib" ?> buildDynamicLibUnix
libPrefix ++ "*.dylib" %> buildDynamicLibUnix
-- Linux
matchGhcVersionedFilePath libPrefix "so" ?> buildDynamicLibUnix
libPrefix ++ "*.so" %> buildDynamicLibUnix
-- TODO: Windows
where
buildDynamicLibUnix so = do
buildDynamicLibUnix lib = do
deps <- contextDependencies context
need =<< mapM pkgLibraryFile deps
objs <- libraryObjects context
build $ target context (Ghc LinkHs stage) objs [so]
build $ target context (Ghc LinkHs stage) objs [lib]
buildPackageLibrary :: Context -> Rules ()
buildPackageLibrary context@Context {..} = do
let path = buildPath context
libPrefix = path -/- "libHS" ++ pkgNameString package
let libPrefix = buildPath context -/- "libHS" ++ pkgNameString package
matchVersionedFilePath libPrefix (waySuffix way <.> "a") ?> \a -> do
objs <- libraryObjects context
asuf <- libsuf way
......
......@@ -16,7 +16,7 @@ registerPackage rs context@Context {..} = when (stage <= Stage1) $ do
let confIn = pkgInplaceConfig context
dir = inplacePackageDbDirectory stage
matchVersionedFilePath (dir -/- pkgNameString package) "conf" ?> \conf -> do
dir -/- pkgNameString package ++ "*.conf" %> \conf -> do
need [confIn]
buildWithResources rs $
target context (GhcPkg Update stage) [confIn] [conf]
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment