From 8dbd04bfccb5566ae0599b4008666609bb03abf4 Mon Sep 17 00:00:00 2001 From: joe Date: Wed, 19 Jun 2013 16:38:31 -0400 Subject: Added ConfigFiles module --- Presence/ConfigFiles.hs | 66 +++++++++++++++++++++++++++++++++++++++++++++++++ 1 file changed, 66 insertions(+) create mode 100644 Presence/ConfigFiles.hs (limited to 'Presence/ConfigFiles.hs') 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 @@ +{-# LANGUAGE OverloadedStrings #-} +module ConfigFiles where + +import Data.ByteString.Lazy.Char8 as L +import System.Posix.User +import System.FilePath +import System.Directory +import System.IO +-- import System.IO.Strict +import System.IO.Error +import Control.Exception +import Control.Monad +import Todo +import Control.DeepSeq +import ByteStringOperators + +type User = ByteString + +configDir = ".presence" +buddyFile = "buddies" +subscriberFile = "subscribers" + +buddyPath :: User -> IO String +buddyPath user = do + ue <- getUserEntryForName (unpack user) + return $ (++("/"++configDir++"/"++buddyFile)) $ homeDirectory ue + +subscriberPath :: User -> IO String +subscriberPath user = do + ue <- getUserEntryForName (unpack user) + return $ (++("/"++configDir++"/"++subscriberFile)) $ homeDirectory ue + +createConfigFile tag path = do + let dir = dropFileName path + doesDirectoryExist dir >>= flip unless (do + createDirectory dir + ) + withFile path WriteMode $ \h -> + L.hPutStrLn h tag + +addItem item tag path = + let doit = do + handle (\e -> when (isDoesNotExistError e) + (createConfigFile tag path >> doit)) + $ withFile path AppendMode $ \h -> + L.hPutStrLn h item + in doit + +addBuddy :: User -> ByteString -> IO () +addBuddy user buddy = + buddyPath user >>= addItem buddy "" + +addSubscriber :: User -> ByteString -> IO () +addSubscriber user subscriber = + subscriberPath user >>= addItem subscriber "" + +getConfigList path = withFile path ReadMode $ + L.hGetContents + >=> return . Prelude.tail . L.lines + >=> (\a -> seq (rnf a) (return a)) + +getBuddies :: User -> IO [ByteString] +getBuddies user = buddyPath user >>= getConfigList + +getSubscribers :: User -> IO [ByteString] +getSubscribers user = subscriberPath user >>= getConfigList -- cgit v1.2.3