[Pkg-haskell-commits] [SCM] haskell-testpack branch, master, updated. debian/1.0.2-1-4-gb0d6b36

[John Goerzen]

The following commit has been merged in the master branch:
commit e994333096be7485edb80e52224c6f0055a217f0
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Dec 24 06:49:50 2004 +0100

    Checkpointing lsl
    
    Keywords:
    
    
    (jgoerzen at complete.org--projects/missingh--head--0.7--patch-163)

diff --git a/ChangeLog b/ChangeLog
index a570ed8..68fbba6 100644
--- a/ChangeLog
+++ b/ChangeLog
@@ -2,6 +2,18 @@
 # arch-tag: automatic-ChangeLog--jgoerzen at complete.org--projects/missingh--head--0.7
 #
 
+2004-12-23 23:49:50 GMT	John Goerzen <jgoerzen at complete.org>	patch-163
+
+    Summary:
+      Checkpointing lsl
+    Revision:
+      missingh--head--0.7--patch-163
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS/Utils.hs
+
+
 2004-12-23 18:03:30 GMT	John Goerzen <jgoerzen at complete.org>	patch-162
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS/Utils.hs b/libsrc/MissingH/IO/HVFS/Utils.hs
index 65eaf0c..db8e31b 100644
--- a/libsrc/MissingH/IO/HVFS/Utils.hs
+++ b/libsrc/MissingH/IO/HVFS/Utils.hs
@@ -46,6 +46,8 @@ where
 import MissingH.IO.HVFS
 import System.Posix.Files
 import MissingH.Printf
+import System.Time
+import System.Locale
 
 {- | Obtain a recursive listing of all files\/directories beneath 
 the specified directory.  The traversal is depth-first and the original
@@ -109,7 +111,7 @@ lsl fs fp =
                 (if i otherReadMode then 'r' else '-') :
                 (if i otherWriteMode then 'w' else '-') :
                 (if i otherExecuteMode then 'x' else '-') : []
-        showentry (state, fp) = 
+        showentry origdir fh (state, fp) = 
             case state of
               HVFSStatEncap se -> 
                let typechar = 
@@ -120,17 +122,29 @@ lsl fs fp =
                        else if vIsSocket se then 's'
                        else if vIsNamedPipe se then 's'
                        else '-'
-                   in vsprintf "%c%s  1 %-8d %-8d %-9d" 
-                               typechar
-                               (showmodes (vFileMode se))
-                               (toInteger $ vFileOwner se)
-                               (toInteger $ vFileGroup se)
-                               (toInteger $ vFileSize se)
-                                           
+                   clocktime = TOD (fromIntegral (vModificationTime se)) 0
+                   datestr c= formatCalendarTime defaultTimeLocale "%b %e  %Y" 
+                               c
+                    in do c <- toCalendarTime clocktime
+                          linkstr <- case vIsSymbolicLink se of
+                                       False -> return ""
+                                       True -> do sl <- vReadSymbolicLink fh 
+                                                           (origdir ++ "/" ++ fp)
+                                                  return $ " -> " ++ sl
+                          return $ vsprintf "%c%s  1 %-8d %-8d %-9d %s %s%s" 
+                                     typechar
+                                     (showmodes (vFileMode se))
+                                     (toInteger $ vFileOwner se)
+                                     (toInteger $ vFileGroup se)
+                                     (toInteger $ vFileSize se)
+                                     (datestr c)
+                                     fp
+                                     linkstr
         in do c <- vGetDirectoryContents fs fp
-              pairs <- mapM (\x -> do ss <- vGetSymbolicLinkStatus fs x
-                                      return (ss, x)) c
-              let linedata = map showentry pairs
+              pairs <- mapM (\x -> do ss <- vGetSymbolicLinkStatus fs (fp ++ "/" ++ x)
+                                      return (ss, x) 
+                            ) c
+              linedata <- mapM (showentry fp fs) pairs
               return $ unlines linedata
                   
             
\ No newline at end of file

-- 
haskell-testpack