[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 5599fbad64a0e31a04c0c200d491acec7a2447f9
Author: John Goerzen <jgoerzen at complete.org>
Date:   Fri Dec 24 00:48:25 2004 +0100

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

diff --git a/ChangeLog b/ChangeLog
index acc5313..dffe768 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 17:48:25 GMT	John Goerzen <jgoerzen at complete.org>	patch-158
+
+    Summary:
+      Checkpointing lsl
+    Revision:
+      missingh--head--0.7--patch-158
+
+
+    modified files:
+     ChangeLog libsrc/MissingH/IO/HVFS/Utils.hs
+
+
 2004-12-23 17:37:25 GMT	John Goerzen <jgoerzen at complete.org>	patch-157
 
     Summary:
diff --git a/libsrc/MissingH/IO/HVFS/Utils.hs b/libsrc/MissingH/IO/HVFS/Utils.hs
index adccd66..6bd0a0b 100644
--- a/libsrc/MissingH/IO/HVFS/Utils.hs
+++ b/libsrc/MissingH/IO/HVFS/Utils.hs
@@ -38,6 +38,7 @@ first parameter to these functions.
 module MissingH.IO.HVFS.Utils (recurseDir,
                                recurseDirStat,
                                recursiveRemove,
+                               lsl,
                                SystemFS(..)
                               )
 where
@@ -86,3 +87,27 @@ recursiveRemove h fn =
         in
         recurseDirStat h fn >>= worker
 
+{- | Provide a result similar to the command ls -l over a directory.
+-}
+lsl :: HVFS a => a -> FilePath -> IO String
+lsl fs fp =
+    let showentry (state, fp) = 
+            case state of
+              HVFSStatEncap se -> 
+               let typechar = 
+                    if vIsDirectory se then 'd'
+                       else if vIsSymbolicLink se then 'l'
+                       else if vIsBlockDevice se then 'b'
+                       else if vIsCharacterDevice se then 'c'
+                       else if vIsSocket se then 's'
+                       else if vIsNamedPipe se then 's'
+                       else '-'
+                   in [typechar]
+                                           
+        in do c <- vGetDirectoryContents fs fp
+              pairs <- mapM (\x -> do ss <- vGetSymbolicLinkStatus fs x
+                                      return (ss, x)) c
+              let linedata = map showentry pairs
+              return $ unlines linedata
+                  
+            
\ No newline at end of file

-- 
haskell-testpack