diff options
-rw-r--r-- | Presence/ConfigFiles.hs | 66 |
1 files changed, 66 insertions, 0 deletions
diff --git a/Presence/ConfigFiles.hs b/Presence/ConfigFiles.hs new file mode 100644 index 00000000..ee0d5b85 --- /dev/null +++ b/Presence/ConfigFiles.hs | |||
@@ -0,0 +1,66 @@ | |||
1 | {-# LANGUAGE OverloadedStrings #-} | ||
2 | module ConfigFiles where | ||
3 | |||
4 | import Data.ByteString.Lazy.Char8 as L | ||
5 | import System.Posix.User | ||
6 | import System.FilePath | ||
7 | import System.Directory | ||
8 | import System.IO | ||
9 | -- import System.IO.Strict | ||
10 | import System.IO.Error | ||
11 | import Control.Exception | ||
12 | import Control.Monad | ||
13 | import Todo | ||
14 | import Control.DeepSeq | ||
15 | import ByteStringOperators | ||
16 | |||
17 | type User = ByteString | ||
18 | |||
19 | configDir = ".presence" | ||
20 | buddyFile = "buddies" | ||
21 | subscriberFile = "subscribers" | ||
22 | |||
23 | buddyPath :: User -> IO String | ||
24 | buddyPath user = do | ||
25 | ue <- getUserEntryForName (unpack user) | ||
26 | return $ (++("/"++configDir++"/"++buddyFile)) $ homeDirectory ue | ||
27 | |||
28 | subscriberPath :: User -> IO String | ||
29 | subscriberPath user = do | ||
30 | ue <- getUserEntryForName (unpack user) | ||
31 | return $ (++("/"++configDir++"/"++subscriberFile)) $ homeDirectory ue | ||
32 | |||
33 | createConfigFile tag path = do | ||
34 | let dir = dropFileName path | ||
35 | doesDirectoryExist dir >>= flip unless (do | ||
36 | createDirectory dir | ||
37 | ) | ||
38 | withFile path WriteMode $ \h -> | ||
39 | L.hPutStrLn h tag | ||
40 | |||
41 | addItem item tag path = | ||
42 | let doit = do | ||
43 | handle (\e -> when (isDoesNotExistError e) | ||
44 | (createConfigFile tag path >> doit)) | ||
45 | $ withFile path AppendMode $ \h -> | ||
46 | L.hPutStrLn h item | ||
47 | in doit | ||
48 | |||
49 | addBuddy :: User -> ByteString -> IO () | ||
50 | addBuddy user buddy = | ||
51 | buddyPath user >>= addItem buddy "<? buddies ?>" | ||
52 | |||
53 | addSubscriber :: User -> ByteString -> IO () | ||
54 | addSubscriber user subscriber = | ||
55 | subscriberPath user >>= addItem subscriber "<? subscribers ?>" | ||
56 | |||
57 | getConfigList path = withFile path ReadMode $ | ||
58 | L.hGetContents | ||
59 | >=> return . Prelude.tail . L.lines | ||
60 | >=> (\a -> seq (rnf a) (return a)) | ||
61 | |||
62 | getBuddies :: User -> IO [ByteString] | ||
63 | getBuddies user = buddyPath user >>= getConfigList | ||
64 | |||
65 | getSubscribers :: User -> IO [ByteString] | ||
66 | getSubscribers user = subscriberPath user >>= getConfigList | ||