imported fquery-0.2
[fquery.git] / Adelie / QOwn.hs
blobdb301c9855a1b61e3a9bb72663e7d6c959c15f86
1 -- QOwn.hs
2 --
3 -- Module to query who owns a particular file.
5 module Adelie.QOwn (
6 qOwn,
7 qOwnRegex
8 ) where
10 import List (delete)
11 import Monad (when)
12 import Text.Regex (Regex, matchRegex, mkRegex)
14 import Adelie.Colour
15 import Adelie.Contents
16 import Adelie.ListEx
17 import Adelie.Portage
18 import Adelie.Pretty
20 ----------------------------------------------------------------
22 qOwn :: [String] -> IO ()
23 qOwn [] = return ()
24 qOwn args = do
25 foldMUntil qOwn' null args =<< allInstalledPackages
26 putChar '\n'
28 qOwn' :: [String] -> (String, String) -> IO [String]
29 qOwn' files catname = readContents (puts catname) contents files
30 where contents = contentsFromCatName catname
32 ----------------------------------------------------------------
34 puts :: (String, String) -> Contents -> [String] -> IO (Bool, [String])
35 puts catname c fs =
36 if c `contentsElem` fs
37 then do
38 let fs' = deleteContent c fs
39 putCatName catname >> putStr " (" >> putContents c >> putStrLn ")"
40 return (null fs', fs')
41 else
42 return (False, fs)
44 contentsElem :: Contents -> [String] -> Bool
45 (Dir d) `contentsElem` fs = d `elem` fs
46 (Obj o _ _) `contentsElem` fs = o `elem` fs
47 (Sym l _ _) `contentsElem` fs = l `elem` fs
49 -- Only remove objects from the list.
50 deleteContent :: Contents -> [String] -> [String]
51 deleteContent (Obj o _ _) fs = delete o fs
52 deleteContent _ fs = fs
54 ----------------------------------------------------------------
56 qOwnRegex :: [String] -> IO ()
57 qOwnRegex args = mapM_ (qOwnRegex' pats) =<< allInstalledPackages
58 where pats = map mkRegex args
60 qOwnRegex' :: [Regex] -> (String, String) -> IO ()
61 qOwnRegex' pats catname = readContents (putsRegex catname pats) contents ()
62 where contents = contentsFromCatName catname
64 putsRegex :: (String, String) -> [Regex] -> Contents -> () -> IO (Bool, ())
65 putsRegex catname pats c _ = do
66 when (c `regexElem` pats) match
67 return (False, ())
68 where match = putCatName catname >> putStr " (" >> putContents c>>putStrLn ")"
70 regexElem :: Contents -> [Regex] -> Bool
71 (Dir d) `regexElem` pats = mapMaybeOnce (flip matchRegex d) pats
72 (Obj o _ _) `regexElem` pats = mapMaybeOnce (flip matchRegex o) pats
73 (Sym l _ _) `regexElem` pats = mapMaybeOnce (flip matchRegex l) pats
75 mapMaybeOnce :: (a -> Maybe b) -> [a] -> Bool
76 mapMaybeOnce _ [] = False
77 mapMaybeOnce f (x:xs) =
78 case f x of
79 Just a -> True
80 Nothing -> mapMaybeOnce f xs