The awakening!
[fquery.git] / Adelie / QOwn.hs
blob9bb776f6813758c62972e8e076138bc33e7408d7
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.Contents
15 import Adelie.ListEx
16 import Adelie.Portage
17 import Adelie.Pretty
19 ----------------------------------------------------------------
21 qOwn :: [String] -> IO ()
22 qOwn [] = return ()
23 qOwn args = do
24 foldMUntil qOwn' null args =<< allInstalledPackages
25 putChar '\n'
27 qOwn' :: [String] -> (String, String) -> IO [String]
28 qOwn' files catname = readContents (puts catname) contents files
29 where contents = contentsFromCatName catname
31 ----------------------------------------------------------------
33 puts :: (String, String) -> Contents -> [String] -> IO (Bool, [String])
34 puts catname c fs =
35 if c `contentsElem` fs
36 then do
37 let fs' = deleteContent c fs
38 putCatName catname >> putStr " (" >> putContents c >> putStrLn ")"
39 return (null fs', fs')
40 else
41 return (False, fs)
43 contentsElem :: Contents -> [String] -> Bool
44 (Dir d) `contentsElem` fs = d `elem` fs
45 (Obj o _ _) `contentsElem` fs = o `elem` fs
46 (Sym l _ _) `contentsElem` fs = l `elem` fs
48 -- Only remove objects from the list.
49 deleteContent :: Contents -> [String] -> [String]
50 deleteContent (Obj o _ _) fs = delete o fs
51 deleteContent _ fs = fs
53 ----------------------------------------------------------------
55 qOwnRegex :: [String] -> IO ()
56 qOwnRegex args = mapM_ (qOwnRegex' pats) =<< allInstalledPackages
57 where pats = map mkRegex args
59 qOwnRegex' :: [Regex] -> (String, String) -> IO ()
60 qOwnRegex' pats catname = readContents (putsRegex catname pats) contents ()
61 where contents = contentsFromCatName catname
63 putsRegex :: (String, String) -> [Regex] -> Contents -> () -> IO (Bool, ())
64 putsRegex catname pats c _ = do
65 when (c `regexElem` pats) match
66 return (False, ())
67 where match = putCatName catname >> putStr " (" >> putContents c>>putStrLn ")"
69 regexElem :: Contents -> [Regex] -> Bool
70 (Dir d) `regexElem` pats = mapMaybeOnce (flip matchRegex d) pats
71 (Obj o _ _) `regexElem` pats = mapMaybeOnce (flip matchRegex o) pats
72 (Sym l _ _) `regexElem` pats = mapMaybeOnce (flip matchRegex l) pats
74 mapMaybeOnce :: (a -> Maybe b) -> [a] -> Bool
75 mapMaybeOnce _ [] = False
76 mapMaybeOnce f (x:xs) =
77 case f x of
78 Just _a -> True
79 Nothing -> mapMaybeOnce f xs