The awakening!
authorSergei Trofimovich <slyfox@inbox.ru>
Fri, 24 Apr 2009 18:51:26 +0000 (24 21:51 +0300)
committerSergei Trofimovich <slyfox@inbox.ru>
Fri, 24 Apr 2009 18:51:26 +0000 (24 21:51 +0300)
This commit brings us:
 * Build fixes (at least against ghc-6.10.2)
 * Warning (-Wall) fixes (sorry, it adds many trashy changes into sources)
 * Fixed newer portage dependencies parsing (in package[useflag] form)
 * Fixed death when there is non-directories in /var/db/pkg (there is world symlink for me)
 * Fixed parse error of compund '||' statements and double brackets behind
   Ex: '( || ( ( x11-libs/qt-core:4 x11-libs/qt-gui:4 x11-libs/qt-test:4 ) =x11-libs/qt-4.3* ) )'

Signed-off-by: Sergei Trofimovich <slyfox@inbox.ru>
15 files changed:
.gitignore [new file with mode: 0644]
Adelie/Contents.hs
Adelie/Depend.hs
Adelie/Portage.hs
Adelie/QChangelog.hs
Adelie/QCheck.hs
Adelie/QDepend.hs
Adelie/QList.hs
Adelie/QOwn.hs
Adelie/QSize.hs
Adelie/QUse.hs
Adelie/UseDesc.hs
Main.hs
TODO [new file with mode: 0644]
fquery.cabal

diff --git a/.gitignore b/.gitignore
new file mode 100644 (file)
index 0000000..3d64674
--- /dev/null
@@ -0,0 +1,2 @@
+Adelie/Config.hs
+dist
\ No newline at end of file
index 4fa4459..08495bb 100644 (file)
@@ -33,14 +33,15 @@ contentsFromCatName (cat, name) = concatPath [portageDB,cat,name,"CONTENTS"]
 
 readContents :: (Contents -> a -> IO (Bool, a)) -> FilePath -> a -> IO a
 readContents f fn a = do
-  r <- try read
+  r <- try read'
   case r of
     Left  _  -> return a
     Right a' -> return a'
   where
-    read = (bracket (openFile fn ReadMode)
-                    hClose
-                    (readContents' f a))
+    read' =
+      bracket (openFile fn ReadMode)
+              hClose
+              (readContents' f a)
 
 readContents' :: (Contents -> a -> IO (Bool, a)) -> a -> Handle -> IO a
 readContents' f a fp = do
@@ -84,7 +85,10 @@ contentsParser ('s':'y':'m':' ':ln0) = (Sym link target time)
         (time', target') = break2 (not.isDigit) ln2
         target = reverse target'
         time = digitsToInt (reverse time')
+contentsParser cont = error $ "contentsParser: 'dir: /obj: /sym: ' not found in " ++ show cont
 
+breakLink :: String -> (String, String)
 breakLink (' ':'-':'>':' ':xs) = ([], xs)
 breakLink (x:xs) = (x:as, bs)
   where (as, bs) = breakLink xs
+breakLink [] = error "breakLink: ' -> ' not found"
index eab3c34..525533f 100644 (file)
@@ -12,8 +12,8 @@ module Adelie.Depend (
   putDependency
 ) where
 
-import Char (isSpace)
-import List (nub)
+import Data.Char (isSpace)
+import Data.List (nub)
 import Text.ParserCombinators.Parsec
 import Text.ParserCombinators.Parsec.Language
 import Text.ParserCombinators.Parsec.Token
@@ -58,8 +58,9 @@ putDependency (Any p)            = putStr p
 
 dependParser :: [String] -> Parser [Dependency]
 dependParser iUse = do
-  skip <- spaces
+  _skip <- spaces
   packages <- many (dependParser' iUse)
+  eof
   return $ concat packages
 
 dependParser' :: [String] -> Parser [Dependency]
@@ -73,6 +74,8 @@ parseOr iUse = do { string "||"
                   ; spaces
                   ; parseBrackets iUse
                   }
+             <|>
+                parseBrackets iUse
 
 parsePackageOrUse :: [String] -> Parser [Dependency]
 parsePackageOrUse iUse =
@@ -90,10 +93,21 @@ parsePackageOrUse iUse =
      }
 
 parsePackageOrUseWord :: Parser String
-parsePackageOrUseWord = many1 (satisfy cond)
+parsePackageOrUseWord = do { result <- many1 (satisfy cond)
+                           -- skip[use]
+                           -- TODO: add it to output
+                           ; optionMaybe (do { char '['
+                                             ; _use <- many1 (satisfy (/= ']'))
+                                             ; char ']'
+                                             -- ; return use
+                                             ; return ()
+                                             })
+                           ; return result
+                           }
   where
     cond '?' = False
     cond ')' = False
+    cond '[' = False
     cond x = not $ isSpace x
 
 parseBrackets :: [String] -> Parser [Dependency]
index b998dad..754721e 100644 (file)
@@ -15,14 +15,22 @@ module Adelie.Portage (
   findInstalledPackages
 ) where
 
-import Char       (isDigit)
-import Directory  (getDirectoryContents)
-import List       (intersperse, sort)
-import Monad      (liftM)
+import Data.Char         (isDigit)
+import System.Directory  (getDirectoryContents, doesDirectoryExist)
+import Data.List         (intersperse, sort)
+import Control.Monad     (liftM)
 
 import Adelie.ListEx
 import Adelie.Config
 
+-- Skips non-directory entries from returned list
+-- (symlinks to world file in our case)
+-- racy actually
+safeGetDirectoryContents :: FilePath -> IO [FilePath]
+safeGetDirectoryContents dir =
+    do yet <- doesDirectoryExist dir
+       if yet then getDirectoryContents dir
+              else return []
 
 portageProfiles :: String
 portageProfiles = portageTree ++ "/profiles"
@@ -54,12 +62,12 @@ fullnameFromCatName (cat, name) = cat ++ '/':name
 
 allInstalledPackages :: IO [(String, String)]
 allInstalledPackages = do
-  cats <- liftM (sort.filter filterHidden) (getDirectoryContents portageDB)
+  cats <- liftM (sort.filter filterHidden) (safeGetDirectoryContents portageDB)
   concatMapM allInstalledPackagesInCategory cats
 
 allInstalledPackagesInCategory :: String -> IO [(String, String)]
 allInstalledPackagesInCategory cat = do
-  names <- liftM (sort.filter filterHidden) (getDirectoryContents path)
+  names <- liftM (sort.filter filterHidden) (safeGetDirectoryContents path)
   return $ map (\ a -> (cat, a)) names
   where path = portageDB ++ '/':cat
 
@@ -75,18 +83,20 @@ findInstPackages name =
     else findInstPackagesInCategory a b
   where (a, b) = break2 (== '/') name
 
+findInstPackages' :: String -> IO [(String, String)]
 findInstPackages' pack = do
-  cats  <- liftM (sort.filter filterHidden) (getDirectoryContents portageDB)
+  cats  <- liftM (sort.filter filterHidden) (safeGetDirectoryContents portageDB)
   concatMapM (flip findInstPackagesInCategory pack) cats
 
+findInstPackagesInCategory :: String -> String -> IO [(String, String)]
 findInstPackagesInCategory cat pack = do
-  packs <- liftM (sort.filter cond) (getDirectoryContents (portageDB++'/':cat))
+  packs <- liftM (sort.filter cond) (safeGetDirectoryContents (portageDB++'/':cat))
   return (zip (repeat cat) packs)
   where
     cond ('.':_) = False
     cond p = (pack == p) || (pack == dropVersion p)
 
 ----------------------------------------------------------------
-
+filterHidden :: String -> Bool
 filterHidden ('.':_) = False
 filterHidden _ = True
index cccb938..ac5219b 100644 (file)
@@ -7,7 +7,7 @@ module Adelie.QChangelog (
   qLogFile
 ) where
 
-import Char   (isAlpha, isDigit, isSpace)
+import Char   (isDigit, isSpace)
 import Monad  (unless)
 
 import Adelie.Colour
@@ -35,8 +35,8 @@ qChangelog (x:y:_)  = mapM_ (changelog (Just y)) =<< findInstalledPackages [x]
 changelog :: Maybe String -> (String, String) -> IO ()
 changelog end catname@(_, name) = do
   putStr "ChangeLog since " >> putCatNameLn catname
-  log <- readFile (logFile catname)
-  puts name end log
+  log' <- readFile (logFile catname)
+  puts name end log'
 
 ----------------------------------------------------------------
 
@@ -48,9 +48,9 @@ puts inst end ('#':l) = puts inst end (dropUntilAfter isNewLine l)
 puts inst end ('*':l0) = do
   case maybeCompareVersion package end of
     GT -> puts inst end next
-    otherwise -> case compareVersion inst package of
+     -> case compareVersion inst package of
       LT -> putSection package date >> putDesc ls >> puts inst end next
-      otherwise -> puts inst end next
+       -> puts inst end next
   where (section, next) = breakSection l0
         (line, ls) = break2 isNewLine section
         (l1, l2) = break2 ('(' ==) line
@@ -96,8 +96,7 @@ putDesc' str = do
       putBody body
     else
       putBody str
-  where str1 = dropWhile isSpace str
-        (header, body) = break2 (':' ==) str
+  where (header, body) = break2 (':' ==) str
 
 doublelines :: String -> [String]
 doublelines str =
@@ -111,7 +110,7 @@ doublelines str =
 beginsWithDate :: String -> Bool
 beginsWithDate []   = False
 beginsWithDate [_]  = False
-beginsWithDate (x:y:xs)
+beginsWithDate (x:y:_)
   | not (isDigit x)         = False
   | not (isDigitOrSpace y)  = False
   | otherwise = True
@@ -133,9 +132,9 @@ putHeader str0 = do
 
 putFiles :: Int -> [String] -> IO ()
 putFiles _ [] = putChar '\n'
-putFiles rem (";":files) = putFiles rem files
-putFiles rem (f:files) =
-  if rem < len
+putFiles rem' (";":files) = putFiles rem' files
+putFiles rem' (f:files) =
+  if rem' < len
     then do
       putChar '\n' >> putStr "    "
       putFiles 76 (f:files)
@@ -144,7 +143,7 @@ putFiles rem (f:files) =
       if (last f == ',')
         then putStr (dropTail 1 f) >> off >> putStr ", "
         else putStr f >> off >> putChar ' '
-      putFiles (rem-len-1) files
+      putFiles (rem' - len - 1) files
   where len = length f
 
 ----------------------------------------------------------------
@@ -155,7 +154,7 @@ putBody [] = putChar '\n'
 putBody ('#':c0) =
   case bug of
     [] -> putChar '#' >> putBody cs
-    otherwise -> inMagenta (putStr ('#':bug)) >> putBody cs
+     -> inMagenta (putStr ('#':bug)) >> putBody cs
   where (bug, cs) = span (isDigitOrSpace) c0
 
 putBody (c:cs) = putChar c >> putBody cs
index 9b4803a..12d34b8 100644 (file)
@@ -6,9 +6,8 @@ module Adelie.QCheck (qCheck) where
 
 import Char               (isHexDigit)
 import IO
-import Monad              (unless)
-import System
-import System.Process     (runProcess, waitForProcess)
+
+import System.Process     (runProcess, waitForProcess, ProcessHandle)
 import System.Posix.Files (getFileStatus)
 import System.Posix.IO    (createPipe, fdToHandle)
 
@@ -40,10 +39,10 @@ check' (Dir _) (g, b) = return (False, (g+1, b))
 check' (Obj o m _) (g, b) = do
   r <- try (getFileStatus o)
   case r of
-    Left e -> do
+    Left _e -> do
       inRed (putStr "!!! ") >> putStr o >> putStrLn " does not exist"
       return (False, (g, b+1))
-    Right stat -> do
+    Right _stat -> do
       (rd, wr) <- createPipeHandle
       runMD5sum o (Just wr) >>= waitForProcess
       ln <- hGetLine rd
@@ -59,17 +58,19 @@ check' (Sym _ _ _) (g, b) = return (False, (g+1, b))
 
 createPipeHandle :: IO (Handle, Handle)
 createPipeHandle = do
-  (read, write) <- createPipe
-  hRead  <- fdToHandle read
+  (read', write) <- createPipe
+  hRead  <- fdToHandle read'
   hWrite <- fdToHandle write
   return (hRead, hWrite)
 
 ----------------------------------------------------------------
-
-runMD5sum f stdout = runProcess md5sum [f] Nothing Nothing stdin stdout stderr
+runMD5sum :: String
+             -> Maybe Handle
+             -> IO ProcessHandle
+runMD5sum f stdout' = runProcess md5sum [f] Nothing Nothing stdin' stdout' stderr'
   where md5sum = "/usr/bin/md5sum"
-        stdin  = Nothing
-        stderr = Nothing
+        stdin'  = Nothing
+        stderr' = Nothing
 
 putMD5error :: String -> IO ()
 putMD5error file =
index b26ac8a..1d64a88 100644 (file)
@@ -41,9 +41,9 @@ dep' provided fullname =
         fnIUse = concatPath [portageDB,fullname,"USE"]
 
 puts :: String -> [String] -> [Dependency] -> IO ()
-puts str provided iWant = mapM_ print perms
+puts str provided iWant = mapM_ print' perms
   where perms = [ (p, w) | p <- provided, w <- iWant, w `satisfiedBy` p ]
-        print (p, w) =
+        print' (_p, w) =
           white >> putStr (pad 32 ' ' str) >> off >>
           putStr "\t( " >> putDependency w >> putStrLn " )"
 
index c66b5a5..a63afed 100644 (file)
@@ -28,8 +28,11 @@ qList types args = mapM_ (list puts) =<< findInstalledPackages args
       ListDirs  -> putsD
       ListFiles -> putsF
       ListLinks -> putsL
-      otherwise -> putsA
+      _         -> putsA
 
+list :: (Contents -> () -> IO (Bool, ()))
+        -> (String, String)
+        -> IO ()
 list puts catname = do
   putStr "Contents of " >> putCatNameLn catname
   readContents puts contents ()
@@ -43,7 +46,7 @@ putsA, putsD, putsF, putsL :: Contents -> () -> IO (Bool, ())
 putsA (Obj o _ _) _ = putStrLn o      >> return (False, ())
 putsA c _           = putContentsLn c >> return (False, ())
 
-putsD c@(Dir d) _   = putContentsLn c >> return (False, ())
+putsD c@(Dir _) _   = putContentsLn c >> return (False, ())
 putsD _ _           = return (False, ())
 
 putsF (Obj o _ _) _ = putStrLn o >> return (False, ())
index db301c9..9bb776f 100644 (file)
@@ -11,7 +11,6 @@ import List       (delete)
 import Monad      (when)
 import Text.Regex (Regex, matchRegex, mkRegex)
 
-import Adelie.Colour
 import Adelie.Contents
 import Adelie.ListEx
 import Adelie.Portage
@@ -76,5 +75,5 @@ mapMaybeOnce :: (a -> Maybe b) -> [a] -> Bool
 mapMaybeOnce _ [] = False
 mapMaybeOnce f (x:xs) =
   case f x of 
-    Just a  -> True
+    Just _a  -> True
     Nothing -> mapMaybeOnce f xs
index 480c2fc..9f7d383 100644 (file)
@@ -5,7 +5,7 @@
 module Adelie.QSize (qSize) where
 
 import Directory            (doesDirectoryExist)
-import IO                   (isDoesNotExistError, try)
+import IO                   (try)
 import Monad                (mapM_, when)
 import System.Posix.Files   (fileSize, getFileStatus)
 import System.Posix.Types   (FileOffset)
@@ -26,14 +26,14 @@ qSize args = mapM_ size =<< findInstalledPackages args
 size :: (String, String) -> IO ()
 size catname = do
   putStr "Size of " >> putCatNameLn catname
-  (size, dir, obj, sym, err) <- readContents count contents (0, 0, 0, 0, 0)
+  (size', dir, obj, sym, err) <- readContents count contents (0, 0, 0, 0, 0)
   putStr "    Directories: " >> putNumLn dir
   putStr "          Files: " >> putNumLn obj
 
   when (sym > 0) (putStr "          Links: " >> putNumLn sym)
   when (err > 0) (putStr "   Inaccessible: " >> putNumLn err)
 
-  putStr "     Total size: " >> putSizeLn size
+  putStr "     Total size: " >> putSizeLn size'
   putChar '\n'
   where contents = contentsFromCatName catname
 
@@ -41,16 +41,16 @@ size catname = do
 
 count :: Contents -> Count -> IO (Bool, Count)
 
-count c@(Dir d) (s,w,x,y,z) = do
+count (Dir d) (s,w,x,y,z) = do
   r <- doesDirectoryExist d
   if r
     then return (False, (s,w+1,x,y,z))
     else return (False, (s,w,x,y,z+1)) 
 
-count c@(Obj o _ _) (s,w,x,y,z) = do
+count (Obj o _ _) (s,w,x,y,z) = do
   r <- try (getFileStatus o)
   case r of
-    Left err -> return (False, (s, w, x, y, z+1))
+    Left _err -> return (False, (s, w, x, y, z+1))
     Right st -> return (False, (s+fileSize st, w, x+1, y, z))
 
 count (Sym _ _ _) (s,w,x,y,z) = return (False, (s,w,x,y+1,z))
index 8701746..55e738b 100644 (file)
@@ -22,18 +22,18 @@ qUse args = qUse' =<< findInstalledPackages args
 qUse' :: [(String, String)] -> IO ()
 qUse' [] = return ()
 qUse' catnames = do
-  useDesc <- readUseDesc
-  useDescPackage <- readUseDescPackage min max
-  mapM_ (use useDesc useDescPackage) catnames
-  where min = dropVersion $ fullnameFromCatName $ minimum catnames
-        max = dropVersion $ fullnameFromCatName $ maximum catnames
+  useDesc' <- readUseDesc
+  useDescPackage' <- readUseDescPackage min' max'
+  mapM_ (use useDesc' useDescPackage') catnames
+  where min' = dropVersion $ fullnameFromCatName $ minimum catnames
+        max' = dropVersion $ fullnameFromCatName $ maximum catnames
 
 use :: UseDescriptions -> UseDescriptions -> (String, String) -> IO ()
-use useDesc useDescPackage catname = do
+use useDesc' useDescPackage' catname = do
   iUse <- readIUse fnIUse
   pUse <- readUse  fnPUse
   let len = maximum $ map length iUse
-  use' catname len useDesc useDescPackage iUse pUse
+  use' catname len useDesc' useDescPackage' iUse pUse
   where fnIUse = iUseFromCatName catname
         fnPUse = useFromCatName catname
 
@@ -41,9 +41,9 @@ use' :: (String, String) -> Int -> UseDescriptions -> UseDescriptions ->
         [String] -> [String] -> IO ()
 
 use' catname _ _ _ [] _ = putStr "No USE flags for " >> putCatNameLn catname
-use' catname len useDesc useDescPackage iUse pUse = do
+use' catname len useDesc' useDescPackage' iUse pUse = do
   putStr "USE flags for " >> putCatNameLn catname
-  mapM_ (format len useDesc useDescPackage pUse) iUse
+  mapM_ (format len useDesc' useDescPackage' pUse) iUse
   putChar '\n'
 
 ----------------------------------------------------------------
@@ -51,7 +51,7 @@ use' catname len useDesc useDescPackage iUse pUse = do
 format :: Int -> UseDescriptions -> UseDescriptions ->
           [String] -> String -> IO ()
 
-format len useDesc useDescPackage pUse iUse =
+format len useDesc' useDescPackage' pUse iUse =
   inst >> putStr (pad len ' ' iUse) >> off >> putStr " : " >> desc
   where
     inst = if iUse `elem` pUse
@@ -59,10 +59,10 @@ format len useDesc useDescPackage pUse iUse =
             else putStr "   " >> blue
 
     desc = do
-      end <- desc' useDescPackage
+      end <- desc' useDescPackage'
       unless end (do
-        end <- desc' useDesc
-        unless end (putStrLn "<< no description >>"))
+        end' <- desc' useDesc'
+        unless end' (putStrLn "<< no description >>"))
 
     desc' descs = do
       r <- HashTable.lookup descs iUse 
index 4afb726..1e1bb4a 100644 (file)
@@ -15,7 +15,6 @@ import Monad (when)
 import Adelie.ListEx
 import Adelie.Portage
 
-type UseDesc = (String, String)
 type UseDescriptions = HashTable String String
 
 ----------------------------------------------------------------
@@ -56,7 +55,7 @@ mapMUntil_ f (x:xs) = do
 useParser2 :: UseDescriptions -> String -> String -> String -> IO Bool
 useParser2 _ _ _ [] = return True
 useParser2 _ _ _ ('#':_) = return True
-useParser2 table start end str@(c:_) = do
+useParser2 table start end str = do
   case mid start catname end of
       LT -> return True
       EQ -> insert table use desc >> return True
diff --git a/Main.hs b/Main.hs
index f5f04a8..d64ce55 100755 (executable)
--- a/Main.hs
+++ b/Main.hs
@@ -24,6 +24,7 @@ data Command
   = Short String String CommandProc
   | Long  String String String CommandProc
 
+logCommands :: [Command]
 logCommands = [
   (Long   "c" "changes"
           "list changes since the installed version"
@@ -33,6 +34,7 @@ logCommands = [
           qLogFile)
   ]
 
+listCommands :: [Command]
 listCommands = [
   (Long   "f" "files"
           "list the contents of a package"
@@ -48,6 +50,7 @@ listCommands = [
           (qList ListLinks))
   ]
 
+ownCommands :: [Command]
 ownCommands = [
   (Long   "b" "belongs"
           "find the package(s) owning a file"
@@ -63,6 +66,7 @@ ownCommands = [
           qCheck)
   ]
 
+dependCommands :: [Command]
 dependCommands = [
   (Long   "d" "depends"
           "list packages directly depending on this package"
@@ -72,6 +76,7 @@ dependCommands = [
           qWant)
   ]
 
+useCommands :: [Command]
 useCommands = [
   (Long   "u" "uses"
           "describe a package's USE flags"
@@ -81,6 +86,7 @@ useCommands = [
           qHasUse)
   ]
 
+allCommands :: [Command]
 allCommands = logCommands ++ listCommands ++ ownCommands ++ dependCommands ++ useCommands
 
 ----------------------------------------------------------------
@@ -152,5 +158,7 @@ putCommand (Long cmd0 cmd1 desc _) = f `withDesc` desc
 withDesc :: IO () -> String -> IO ()
 f `withDesc` desc = putStr "    " >> f >> tab >> putStrLn desc
 
+tab :: IO ()
 tab = putChar '\t'
+nl :: IO ()
 nl  = putChar '\n'
diff --git a/TODO b/TODO
new file mode 100644 (file)
index 0000000..298a268
--- /dev/null
+++ b/TODO
@@ -0,0 +1,4 @@
+ * make fquery a drop-in replacement of equery:
+    o outpout compatible
+    o options full
+ * explore attoparsec in search of faster performance
index 796c10c..9862a11 100644 (file)
@@ -1,16 +1,27 @@
 Name:          fquery
-Version:       0.2
-Author:                David Wang <millimillenary@gmail.com>
-Maintainer:    David Wang <millimillenary@gmail.com>
-Copyright:     2006 David Wang
+Version:       0.2.1
+
+Author:                David Wang <millimillenary@gmail.com>, Sergei Trofimovich <slyfox@inbox.ru>
+Maintainer:    Sergei Trofimovich <slyfox@inbox.ru>
+Copyright:     2006 David Wang, 2009 Sergei Trofimovich
+
 License-File:  LICENCE.txt
 License:       OtherLicense
+
 Synopsis:      Installed package query tool for Gentoo Linux
-Build-depends: base, haskell98, parsec, unix
+Description:   Installed package query tool for Gentoo Linux
+
+               Home page http://home.exetel.com.au/tjaden/fquery/
+               Public repository is http://repo.or.cz/w/fquery.git
+
+Category:      Gentoo
+
+Build-depends: base, haskell98, parsec, unix, regex-compat, process, directory
 Extra-Source-Files:
-                configure
+               configure
                Adelie/Config.hs.in
                Adelie/opts.h
+               TODO
 
 Executable:    fquery
 Main-is:       Main.hs
@@ -19,7 +30,7 @@ Other-Modules:        Adelie.Colour
                Adelie.Contents
                Adelie.Depend
                Adelie.ListEx
-                Adelie.Options
+               Adelie.Options
                Adelie.Portage
                Adelie.Pretty
                Adelie.Provide
@@ -34,5 +45,8 @@ Other-Modules:        Adelie.Colour
                Adelie.QWant
                Adelie.Use
                Adelie.UseDesc
-GHC-Options:   -O
+
+GHC-Options:   -O2 -Wall -Werror
+-- GHC-Options:        -Werror
+
 c-sources:     Adelie/opts.c