[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 5338f156f2c4e44a4cc35a19304cea6eadcef5cd
Author: John Goerzen <jgoerzen at complete.org>
Date:   Tue Oct 11 02:05:01 2005 +0100

    Basic tar header parsing written

diff --git a/MissingH/FileArchive/Tar.hs b/MissingH/FileArchive/Tar.hs
index 74e925b..093f516 100644
--- a/MissingH/FileArchive/Tar.hs
+++ b/MissingH/FileArchive/Tar.hs
@@ -59,51 +59,3 @@ instance Error GZipError where
     noMsg = UnknownError ""
     strMsg = UnknownError
 
-{- | The data structure representing the Tar header.  This occurs
-at the beginning of each 'Section'. -}
-data Header = 
-    UStar {
-           name :: String,
-           mode :: Int,
-           uid :: Int,
-           gid :: Int,
-           size :: Integer,
-           mtime :: Integer,
-           chksum :: Word32,
-           typeflag :: Char,
-           linkname :: String,
-           magic :: String,
-           version :: String,
-           uname :: String,
-           gname :: String,
-           devmajor :: Integer,
-           devminor :: Integer,
-           prefix :: String}
-    deriving (Eq, Show)
-
-parseHeader :: String -> (String, String)
-parseHeader = 
-    runState $
-       do name <- (grab 100 >>= rchopstr)
-          mode <- (grab 8 >>= rreadoct)
-          uid <- (grab 8 >>= rreadoct)
-          gid <- (grab 8 >>= rreadoct)
-          size <- (grab 8 >>= rreadoct)
-          mtime <- (grab 12 >>= rreadoct)
-          chksum <- (grab 8 >>= rreadoct)
-          typeflag <- grab 1
-          linkname <- (grab 100 >>= rchopstr)
-          magic <- (grab 6 >>= rchopstr)
-          version <- grab 2
-          uname <- (grab 32 >>= rchopstr)
-          gname <- (grab 32 >>= rchopstr)
-          devmajor <- (grab 8 >>= rreadoct)
-          devminor <- (grab 8 >>= rreadoct)
-          prefix <- (grab 155 >>= rchopstr)
-          return "foo"
-          
-    where chopstr = takeWhile (\c -> c /= '\0')
-          rchopstr = return . chopstr
-          chopsstr = takeWhile (\c -> c /= ' ') . chopstr
-          readoct = fst . head . readOct . chopsstr
-          rreadoct = return . readoct
\ No newline at end of file
diff --git a/MissingH/FileArchive/Tar/HeaderParser.hs b/MissingH/FileArchive/Tar/HeaderParser.hs
index 3900d6b..67f601e 100644
--- a/MissingH/FileArchive/Tar/HeaderParser.hs
+++ b/MissingH/FileArchive/Tar/HeaderParser.hs
@@ -63,14 +63,36 @@ data Header =
            prefix :: String}
     deriving (Eq, Show)
 
-parseHeader :: CharParser st ()
-parseHeader =
-    do name <- (slurp 100 >>= rchopstr)
-       return ()
-    where slurp n = count n anyChar
+parseUStarHeader :: CharParser st Header
+parseUStarHeader =
+    do name <- (grab 100 >>= rchopstr)
+       mode <- (grab 8 >>= rreadoct)
+       uid <- (grab 8 >>= rreadoct)
+       gid <- (grab 8 >>= rreadoct)
+       size <- (grab 8 >>= rreadoct)
+       mtime <- (grab 12 >>= rreadoct)
+       chksum <- (grab 8 >>= rreadoct)
+       typeflag <- anyChar
+       linkname <- (grab 100 >>= rchopstr)
+       string "ustar\0"         -- Magic
+       string "00"              -- Version
+       uname <- (grab 32 >>= rchopstr)
+       gname <- (grab 32 >>= rchopstr)
+       devmajor <- (grab 8 >>= rreadoct)
+       devminor <- (grab 8 >>= rreadoct)
+       prefix <- (grab 155 >>= rchopstr)
+
+       return $ UStar  {name = name, mode = mode, uid = uid, gid = gid,
+                        size = size, mtime = mtime, chksum = chksum,
+                        typeflag = typeflag, linkname = linkname,
+                        magic = "", version = "",
+                        uname = uname, gname = gname, devmajor = devmajor,
+                        devminor = devminor, prefix = prefix}
+    where grab n = count n anyChar
           chopstr = takeWhile (\c -> c /= '\0')
           rchopstr = return . chopstr
           chopsstr = takeWhile (\c -> c /= ' ') . chopstr
-
---          readoct = fst . head . readOct . chopsstr
---         rreadoct = return . readoct
\ No newline at end of file
+          readoct :: (Num a) => String -> a
+          readoct = fst . head . readOct . chopsstr
+          rreadoct :: (Num a, Monad m) => String -> m a
+          rreadoct = return . readoct
\ No newline at end of file

-- 
haskell-testpack