basic installation

* Implemented basic installation
** Doesn't work for ghc or nhc-style, basically can copy source files to target directory
* Some module names to filepaths, this may get changed back.

Distribution/Package.hs

@@ -77,7 +77,8 @@ data PackageDescription
 
 	-- the following are required by the simple build infrastructure only:
         buildDepends   :: [ Dependency ],
-        allModules     :: [ String ],
+        allModules     :: [ FilePath ],
+        mainModules    :: [ FilePath ],
         cSources       :: [ FilePath ],
 	exposedModules :: [ String ],
         extensions     :: [ Extension ],
@@ -97,6 +98,7 @@ emptyPackageDescription
                       stability    = "",
                       buildDepends = [],
                       allModules   = [],
+                      mainModules   = [],
 		      cSources     = [],
 		      exposedModules = [],
                       extensions   = [],

Distribution/Simple/Configure.hs

@@ -66,7 +66,7 @@ import HUnit
 
 -- |Data cached after configuration step.
 data LocalBuildInfo = LocalBuildInfo {
-  	prefix	    :: String,
+  	prefix	    :: FilePath,
 		-- ^ The installation directory (eg. @/usr/local@, or
 		-- @C:/Program Files/foo-1.2@ on Windows.
 	compiler    :: Compiler,

Distribution/Simple/Install.hs

@@ -51,14 +51,21 @@ import Distribution.Package
 import Distribution.Simple.Configure(LocalBuildInfo(..))
 import Distribution.Simple.Utils(setupMessage)
 
+import Data.List(inits, nub, intersperse, findIndices)
+import System.Cmd(system)
+import System.Directory(doesDirectoryExist, createDirectory)
 import System.Exit
 
+
+-- |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?
 install :: PackageDescription -> LocalBuildInfo -> IO ()
-install pkg_descr _ = do
+install pkg_descr lbi = do
   setupMessage "Installing" pkg_descr
+  moveSources (prefix lbi) (allModules pkg_descr) (mainModules pkg_descr)
   exitWith (ExitFailure 1)
 
-
 -- -----------------------------------------------------------------------------
 -- Installation policies
 
@@ -72,3 +79,72 @@ mkImportDir pkg_descr lbi =
   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
+            -> [FilePath] -- ^sources
+            -> [FilePath] -- ^Main modules
+            -> IO ()
+moveSources _targetDir sources mains
+    = do let targetDir = maybeAddSep _targetDir
+         createIfNotExists True targetDir
+	 -- Create parent directories for everything:
+	 mapM (createIfNotExists True)
+		  $ nub [(removeFilename $ targetDir ++ x)
+		   | x <- (sources ++ mains), (removeFilename x /= "")]
+	 -- Put sources into place:
+	 mapM system ["cp -r " ++ x ++ " " ++ targetDir ++ x
+				  | x <- sources ++ mains]
+	 return ()
+
+-- ------------------------------------------------------------
+-- * utility functions
+-- ------------------------------------------------------------
+
+-- |FIX: Do we actually have to make something differnet for windows,
+-- or does this work?
+pathSeperator = '/'
+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 p = if last p == pathSeperator then p else p ++ pathSeperatorStr

Distribution/TODO

 * Code
+** Extensions -> flags interface
+
 ** parse pkg.desc
 ** build
 ** install
+
+*** Installation for hugs-style (just copy source) is implemented.
+    also must implement for {g,n}hc style where we look for .o and .hi.
+
 ** register
 ** generate InstalledPackageInfo
 ** read & write config-droppings

test/Makefile

+all:
+	ghc -Wall --make -i../:/usr/local/src/HUnit-1.0 Setup.hs -o setup

test/Setup.hs

@@ -4,8 +4,8 @@ import Distribution.Simple
 
 pkg_descr = emptyPackageDescription {
   package = PackageIdentifier "test" (Version [1,0] []),
-  allModules     = ["A"],
-  exposedModules = ["A"]
+  allModules     = ["A.hs", "B/A.hs"],
+  exposedModules = ["A.hs"]
   }
 
 main = defaultMain pkg_descr