imported fquery-0.2
[fquery.git] / Adelie / Contents.hs
blob4fa4459ca314022992808fed6d10d1c1ded6d5cf
1 -- Contents.hs
2 --
3 -- Module for parsing CONTENTS files, located in portageDB/category/package/.
5 module Adelie.Contents (
6 Contents(..),
8 contentsFromCatName,
9 putContents,
10 putContentsLn,
11 readContents
12 ) where
14 import Char (isDigit, isHexDigit, isSpace)
15 import IO
17 import Adelie.Colour
18 import Adelie.ListEx
19 import Adelie.Portage
21 data Contents
22 = Dir String
23 | Obj String String Int
24 | Sym String String Int
25 deriving Show
27 ----------------------------------------------------------------
29 contentsFromCatName :: (String, String) -> String
30 contentsFromCatName (cat, name) = concatPath [portageDB,cat,name,"CONTENTS"]
32 ----------------------------------------------------------------
34 readContents :: (Contents -> a -> IO (Bool, a)) -> FilePath -> a -> IO a
35 readContents f fn a = do
36 r <- try read
37 case r of
38 Left _ -> return a
39 Right a' -> return a'
40 where
41 read = (bracket (openFile fn ReadMode)
42 hClose
43 (readContents' f a))
45 readContents' :: (Contents -> a -> IO (Bool, a)) -> a -> Handle -> IO a
46 readContents' f a fp = do
47 eof <- hIsEOF fp
48 if eof
49 then return a
50 else do
51 ln <- hGetLine fp
52 (done, a') <- f (contentsParser ln) a
53 if done
54 then return a'
55 else readContents' f a' fp
57 ----------------------------------------------------------------
59 putContents, putContentsLn :: Contents -> IO ()
60 putContents = putContents' off
61 putContentsLn = putContents' off2
63 putContents' :: IO () -> Contents -> IO ()
64 putContents' f (Dir d) = blue >> putStr d >> f
65 putContents' f (Obj o _ _) = white >> putStr o >> f
66 putContents' f (Sym l t _) = cyan >> putStr (l ++ " -> " ++ t) >> f
68 ----------------------------------------------------------------
70 contentsParser :: String -> Contents
71 contentsParser ('d':'i':'r':' ':dir) = (Dir dir)
73 contentsParser ('o':'b':'j':' ':ln0) = (Obj obj md5 time)
74 where ln1 = dropWhile isSpace $ reverse ln0
75 (time', ln2) = break2 (not.isDigit) ln1
76 (md5', obj') = break2 (not.isHexDigit) ln2
77 obj = reverse obj'
78 md5 = reverse md5'
79 time = digitsToInt (reverse time')
81 contentsParser ('s':'y':'m':' ':ln0) = (Sym link target time)
82 where (link, ln1) = breakLink ln0
83 ln2 = reverse ln1
84 (time', target') = break2 (not.isDigit) ln2
85 target = reverse target'
86 time = digitsToInt (reverse time')
88 breakLink (' ':'-':'>':' ':xs) = ([], xs)
89 breakLink (x:xs) = (x:as, bs)
90 where (as, bs) = breakLink xs