Commit 43de09fd authored by ijones's avatar ijones
Browse files

initial sdist

- Moved file utilities into Utils module (big diff)
- implemented sdist for tarballs (FIX: calls out to tar)
parent c2f766a3
......@@ -53,8 +53,10 @@ import Distribution.Package()
import qualified Distribution.Setup(hunitTests)
import Distribution.Simple()
import qualified Distribution.Simple.Install(hunitTests)
import Distribution.Simple.Install()
import Distribution.Simple.Build()
import Distribution.Simple.SrcDist()
import qualified Distribution.Simple.Utils(hunitTests)
import Distribution.Simple.Configure()
import Distribution.Simple.Register()
......@@ -72,7 +74,7 @@ main = do putStrLn "compile successful"
putStrLn "-= Setup Tests =-"
setupTests <- Distribution.Setup.hunitTests
mapM runTestTT' setupTests
Distribution.Simple.Install.hunitTests >>= runTestTT'
Distribution.Simple.Utils.hunitTests >>= runTestTT'
return ()
......
......@@ -45,22 +45,16 @@ OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE. -}
module Distribution.Simple.Install (
install,
mkImportDir,
hunitTests,
) where
import Distribution.Package
import Distribution.Simple.Configure(LocalBuildInfo(..))
import Distribution.Simple.Utils(setupMessage)
import Distribution.Simple.Utils(setupMessage, moveSources)
import Control.Monad(when)
import Data.List(inits, nub, intersperse, findIndices)
import Data.Maybe(Maybe, listToMaybe, isNothing, fromJust)
import System.Cmd(system)
import System.Directory(doesDirectoryExist, createDirectory, doesFileExist)
import System.Exit
import HUnit ((~:), (~=?), Test(..))
-- |FIX: for now, only works with hugs or sdist-style
-- installation... must implement for .hi files and such... how do we
-- know which files to expect?
......@@ -81,134 +75,3 @@ mkImportDir pkg_descr lbi =
#endif
where
pkg_name = showPackageId (package pkg_descr)
-- |Put the source files into the right directory in preperation for
-- something like sdist or installHugs.
moveSources :: FilePath -- ^Target directory
-> [String] -- ^Modules
-> [String] -- ^Main modules
-> IO ()
moveSources _targetDir sources mains
= do let targetDir = maybeAddSep _targetDir
createIfNotExists True targetDir
-- Create parent directories for everything:
sourceLocs <- sequence $ map moduleToFPErr (sources ++ mains)
mapM (createIfNotExists True)
$ nub [(removeFilename $ targetDir ++ x)
| x <- sourceLocs, (removeFilename x /= "")]
-- Put sources into place:
mapM system ["cp -r " ++ x ++ " " ++ targetDir ++ x
| x <- sourceLocs]
return ()
where moduleToFPErr m
= do p <- moduleToFilePath m
when (isNothing p)
(putStrLn ("Error: Could not find module: " ++ m)
>> exitWith (ExitFailure 1))
return $ fromJust p
-- ------------------------------------------------------------
-- * utility functions
-- ------------------------------------------------------------
-- |FIX: Do we actually have to make something differnet for windows,
-- or does this work?
pathSeperator :: Char
pathSeperator = '/'
pathSeperatorStr :: String
pathSeperatorStr = [pathSeperator]
createIfNotExists :: Bool -- ^Create its parents too?
-> FilePath -- ^The path to the directory you want to make
-> IO ()
createIfNotExists parents file
= do b <- doesDirectoryExist file
case (b,parents, file) of
(_, _, "") -> return ()
(True, _, _) -> return()
(_, True, _) -> createDirectoryParents file
(_, False, _) -> createDirectory file
-- |like mkdir -p. Create this directory and its parents
createDirectoryParents :: FilePath -> IO()
createDirectoryParents file
= mapM_ (createIfNotExists False) (pathInits file)
-- |Get this path and all its parents.
pathInits :: FilePath -> [FilePath]
pathInits path
= map (concat . intersperse pathSeperatorStr)
(inits $ mySplit pathSeperator path)
-- |Give a list of lists breaking apart elements who match the given criteria
-- > mySplit '.' "foo.bar.bang" => ["foo","bar","bang"] :: [[Char]]
mySplit :: Eq a => a -> [a] -> [[a]]
mySplit a l = let (upto, rest) = break (== a) l
in if null rest
then [upto]
else upto:(mySplit a (tail rest))
-- |Find the last slash and remove it and everything after it. Turns
-- Foo/Bar.lhs into Foo
removeFilename :: FilePath -> FilePath
removeFilename path
= case findIndices (== pathSeperator) path of
[] -> path
l -> fst $ splitAt (maximum l) path
-- |If this filename doesn't end in the path separator, add it.
maybeAddSep :: FilePath -> FilePath
maybeAddSep [] = []
maybeAddSep p = if last p == pathSeperator then p else p ++ pathSeperatorStr
-- |Get the file path for this particular module. In the IO monad
-- because it looks for the actual file. Might eventually interface
-- with preprocessor libraries in order to correctly locate more
-- filenames.
-- Returns Nothing if the file doesn't exist.
moduleToFilePath :: String -- ^Module Name
-> IO (Maybe FilePath)
moduleToFilePath s
= do let possiblePaths = moduleToPossiblePaths s
matchList <- sequence $ map (\x -> do y <- doesFileExist x; return (x, y)) possiblePaths
-- sequence $ map (system . ("ls " ++)) possiblePaths
return $ listToMaybe [x | (x, True) <- matchList]
-- |Get the possible file paths based on this module name.
moduleToPossiblePaths :: String -> [FilePath]
moduleToPossiblePaths s
= let splitted = mySplit '.' s
lastElem = last splitted
possibleSuffixes = [".hs", ".lhs"]
pref = if (not $ null $ init splitted)
then concat (intersperse pathSeperatorStr (init splitted))
++ pathSeperatorStr
else ""
in [pref ++ x | x <- map (lastElem++) possibleSuffixes]
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
hunitTests :: IO Test
hunitTests
= do mp1 <- moduleToFilePath "Distribution.Simple.Build" --exists
mp2 <- moduleToFilePath "Foo.Bar" -- doesn't exist
return $ TestLabel "Install Tests" $ TestList
["moduleToPossiblePaths 1" ~: "failed" ~:
["Foo/Bar/Bang.hs","Foo/Bar/Bang.lhs"]
~=? (moduleToPossiblePaths "Foo.Bar.Bang"),
"moduleToPossiblePaths2 " ~: "failed" ~:
(moduleToPossiblePaths "Foo")
~=? ["Foo.hs", "Foo.lhs"],
"existing not found" ~: "failed" ~:
(Just "Distribution/Simple/Build.hs") ~=? mp1,
"not existing not nothing" ~: "failed" ~: Nothing ~=? mp2
]
......@@ -43,14 +43,34 @@ module Distribution.Simple.SrcDist (
sdist
) where
import Distribution.Package(PackageDescription)
import Distribution.Package(PackageDescription(..), showPackageId)
import Distribution.Simple.Configure(LocalBuildInfo)
import Distribution.Simple.Utils(setupMessage)
import Distribution.Simple.Utils(setupMessage, moveSources, pathSeperatorStr)
import System.IO
import System.Exit
import System.IO ()
import System.Exit (ExitCode(..), exitWith)
import System.Cmd (system)
-- |Create a source distribution. FIX: Calls tar directly (won't work
-- on windows).
sdist :: PackageDescription -> LocalBuildInfo -> IO ()
sdist pkg_descr _ = do
setupMessage "Building source dist for" pkg_descr
exitWith (ExitFailure 1)
moveSources (distSrc++pathSeperatorStr++nameVersion pkg_descr)
(allModules pkg_descr) (mainModules pkg_descr)
system $ "tar --directory=" ++ distSrc ++ " -zcf"
++ " dist/" ++ (tarBallName pkg_descr)
++ " " ++ (nameVersion pkg_descr)
system $ "rm -rf " ++ distSrc
putStrLn "Source tarball created."
------------------------------------------------------------
distSrc :: FilePath
distSrc = "dist/src"
-- |The file name of the tarball
tarBallName :: PackageDescription -> FilePath
tarBallName p = (nameVersion p) ++ ".tgz"
nameVersion = showPackageId . package
......@@ -46,22 +46,31 @@ module Distribution.Simple.Utils (
splitFilenameDir,
split,
isPathSeparator,
pathSeperatorStr,
setupMessage,
die,
findBinary,
rawSystemPath,
rawSystemExit,
rawSystemPathExit,
moveSources,
hunitTests
) where
import Distribution.Package
import Control.Monad(when)
import Data.List(inits, nub, intersperse, findIndices)
import Data.Maybe(Maybe, listToMaybe, isNothing, fromJust)
import System.IO
import System.Exit
import System.Cmd
import System.Environment
import System.Directory
import HUnit ((~:), (~=?), Test(..))
-- -----------------------------------------------------------------------------
-- Pathname-related utils
......@@ -157,3 +166,137 @@ rawSystemPathExit prog args = do
putStrLn (prog ++ concat (map (' ':) args))
--ToDo: make command display conditional on -v flag?
maybeExit $ rawSystemPath prog args
-- ------------------------------------------------------------
-- * File Utilities
-- ------------------------------------------------------------
-- |FIX: Do we actually have to make something differnet for windows,
-- or does this work?
pathSeperator :: Char
pathSeperator = '/'
pathSeperatorStr :: String
pathSeperatorStr = [pathSeperator]
createIfNotExists :: Bool -- ^Create its parents too?
-> FilePath -- ^The path to the directory you want to make
-> IO ()
createIfNotExists parents file
= do b <- doesDirectoryExist file
case (b,parents, file) of
(_, _, "") -> return ()
(True, _, _) -> return()
(_, True, _) -> createDirectoryParents file
(_, False, _) -> createDirectory file
-- |like mkdir -p. Create this directory and its parents
createDirectoryParents :: FilePath -> IO()
createDirectoryParents file
= mapM_ (createIfNotExists False) (pathInits file)
-- |Get this path and all its parents.
pathInits :: FilePath -> [FilePath]
pathInits path
= map (concat . intersperse pathSeperatorStr)
(inits $ mySplit pathSeperator path)
-- |Give a list of lists breaking apart elements who match the given criteria
-- > mySplit '.' "foo.bar.bang" => ["foo","bar","bang"] :: [[Char]]
mySplit :: Eq a => a -> [a] -> [[a]]
mySplit a l = let (upto, rest) = break (== a) l
in if null rest
then [upto]
else upto:(mySplit a (tail rest))
-- |Find the last slash and remove it and everything after it. Turns
-- Foo/Bar.lhs into Foo
removeFilename :: FilePath -> FilePath
removeFilename path
= case findIndices (== pathSeperator) path of
[] -> path
l -> fst $ splitAt (maximum l) path
-- |If this filename doesn't end in the path separator, add it.
maybeAddSep :: FilePath -> FilePath
maybeAddSep [] = []
maybeAddSep p = if last p == pathSeperator then p else p ++ pathSeperatorStr
-- |Get the file path for this particular module. In the IO monad
-- because it looks for the actual file. Might eventually interface
-- with preprocessor libraries in order to correctly locate more
-- filenames.
-- Returns Nothing if the file doesn't exist.
moduleToFilePath :: String -- ^Module Name
-> IO (Maybe FilePath)
moduleToFilePath s
= do let possiblePaths = moduleToPossiblePaths s
matchList <- sequence $ map (\x -> do y <- doesFileExist x; return (x, y)) possiblePaths
-- sequence $ map (system . ("ls " ++)) possiblePaths
return $ listToMaybe [x | (x, True) <- matchList]
-- |Get the possible file paths based on this module name.
moduleToPossiblePaths :: String -> [FilePath]
moduleToPossiblePaths s
= let splitted = mySplit '.' s
lastElem = last splitted
possibleSuffixes = [".hs", ".lhs"]
pref = if (not $ null $ init splitted)
then concat (intersperse pathSeperatorStr (init splitted))
++ pathSeperatorStr
else ""
in [pref ++ x | x <- map (lastElem++) possibleSuffixes]
-- |Put the source files into the right directory in preperation for
-- something like sdist or installHugs.
moveSources :: FilePath -- ^Target directory
-> [String] -- ^Modules
-> [String] -- ^Main modules
-> IO ()
moveSources _targetDir sources mains
= do let targetDir = maybeAddSep _targetDir
createIfNotExists True targetDir
-- Create parent directories for everything:
sourceLocs <- sequence $ map moduleToFPErr (sources ++ mains)
mapM (createIfNotExists True)
$ nub [(removeFilename $ targetDir ++ x)
| x <- sourceLocs, (removeFilename x /= "")]
-- Put sources into place:
mapM system ["cp -r " ++ x ++ " " ++ targetDir ++ x
| x <- sourceLocs]
return ()
where moduleToFPErr m
= do p <- moduleToFilePath m
when (isNothing p)
(putStrLn ("Error: Could not find module: " ++ m)
>> exitWith (ExitFailure 1))
return $ fromJust p
-- ------------------------------------------------------------
-- * Testing
-- ------------------------------------------------------------
hunitTests :: IO Test
hunitTests
= do mp1 <- moduleToFilePath "Distribution.Simple.Build" --exists
mp2 <- moduleToFilePath "Foo.Bar" -- doesn't exist
return $ TestLabel "Utils Tests" $ TestList
["moduleToPossiblePaths 1" ~: "failed" ~:
["Foo/Bar/Bang.hs","Foo/Bar/Bang.lhs"]
~=? (moduleToPossiblePaths "Foo.Bar.Bang"),
"moduleToPossiblePaths2 " ~: "failed" ~:
(moduleToPossiblePaths "Foo")
~=? ["Foo.hs", "Foo.lhs"],
"existing not found" ~: "failed" ~:
(Just "Distribution/Simple/Build.hs") ~=? mp1,
"not existing not nothing" ~: "failed" ~: Nothing ~=? mp2
]
......@@ -6,3 +6,5 @@ check: all
./setup configure --prefix=/tmp/foo
./setup install
ls /tmp/foo*
./setup sdist
ls dist
Supports Markdown
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