{-# LANGUAGE OverloadedStrings #-}
module ConfigFiles where

import Data.ByteString.Lazy.Char8 as L
import System.Posix.User
import System.Posix.Files (fileExist)
import System.FilePath
import System.Directory
import System.IO
-- import System.IO.Strict
import System.IO.Error
import Control.Exception
import Control.Monad
import Control.DeepSeq
import ByteStringOperators () -- For NFData instance
import Data.List (partition)
import Data.Maybe (catMaybes,isJust)

import DPut
import DebugTag

type User = ByteString
type Profile = String

configDir, buddyFile, subscriberFile,
  otherFile, pendingFile, solicitedFile,
  secretsFile :: FilePath

-- A "buddy" is somebody who approved our friend request and will keep
-- us informed of their presence.
--
-- A "subscriber" is somebody who we approved and promised to keep informed
-- of our own presence.

configDir      = ".presence"
buddyFile      = "buddies"     -- subscription="to"
subscriberFile = "subscribers" -- subscription="from"
pendingFile    = "pending"     -- pending subscriber (we've yet to approve)
solicitedFile  = "solicited"   -- pending buddy (we sent a friend request)
otherFile      = "others"
secretsFile    = "secret"


configPath :: User -> Profile -> String -> IO String
configPath user "." filename = do
    ue <- getUserEntryForName (unpack user)
    return $ (++("/"++configDir++"/"++filename)) $ homeDirectory ue
 `catchIOError` \e -> do
    dput XJabber $ "configPath " ++ show user ++ "\".\": " ++ show e
    return $ (++("/"++configDir++"/"++filename)) $ "/tmp"
configPath user profile filename = do
    ue <- getUserEntryForName (unpack user)
    return $ (++("/"++configDir++"/"++profile++"/"++filename)) $ homeDirectory ue
 `catchIOError` \e -> do
    dput XJabber $ "configPath " ++ show user ++ " " ++ show profile ++ ": " ++ show e
    return $ (++("/"++configDir++"/"++filename)) $ "/tmp"

createConfigFile :: ByteString -> FilePath -> IO ()
createConfigFile tag path = do
    let dir = dropFileName path
    doesDirectoryExist dir >>= flip unless (do
            createDirectoryIfMissing True dir
        )
    withFile path WriteMode $ \h -> do
        L.hPutStrLn h tag

addItem :: ByteString -> ByteString -> FilePath -> IO ()
addItem item tag path =
    let doit = do
         handle (\e -> when (isDoesNotExistError e)
                       (createConfigFile tag path >> doit))
           $ do exists <- fileExist path
                if exists
                  then withFile path AppendMode $ \h ->
                         L.hPutStrLn h item
                  else withFile path WriteMode $ \h -> do
                         L.hPutStrLn h tag
                         L.hPutStrLn h item
    in doit


getProfiles :: User -> IO [Profile]
getProfiles user = do
    home <- homeDirectory <$> getUserEntryForName (unpack user)
    let cfg = home </> configDir
    fs <- listDirectory cfg
    ds <- filterM (doesDirectoryExist . (cfg </>))  fs
    return ds
  `catchIOError` \e -> do
    return []

-- | Modify a presence configuration file.  This function will iterate over all
-- items in the file and invoke a test function.  If the function returns
-- Nothing, that item is removed from the file.  Otherwise, the function may
-- rename the item by returning the new name.
--
-- If the last argument is populated, it is a new item to append to the end of
-- the file.
--
-- Note that the entire file is read in, processed, and then rewritten from
-- scratch.
modifyFile ::
  (ByteString,FilePath)
  -> User
  -> Profile
  -> (ByteString -> IO (Maybe ByteString)) -- ^ Returns Just for each item you want to keep.
  -> Maybe ByteString                      -- ^ Optionally append this item.
  -> IO Bool                               -- Returns True if test function ever returned Nothing
modifyFile (tag,file) user profile test appending = configPath user profile file >>= doit
    where
        doit path = do
         handle (\e -> if (isDoesNotExistError e)
                        then (createConfigFile tag path >> doit path)
                        else return False)
           $ do exists <- fileExist path
                if exists
                  then do
                    xs <- withFile path ReadMode $ \h -> do
                             contents <- L.hGetContents h
                             case L.lines contents of
                              x:xs -> mapM test xs
                              _    -> return []
                    let (keepers,deleted) = partition isJust xs
                    withFile path WriteMode $ \h -> do
                        L.hPutStrLn h tag
                        forM_ (catMaybes keepers) (L.hPutStrLn h)
                        forM_ appending (L.hPutStrLn h)
                    return . not . Prelude.null $ deleted
                  else do
                    withFile path WriteMode $ \h -> do
                        L.hPutStrLn h tag
                        forM_ appending (L.hPutStrLn h)
                    return False

modifySolicited, modifyBuddies, modifyOthers, modifyPending, modifySubscribers
  :: User -> Profile -> (ByteString -> IO (Maybe ByteString)) -> Maybe ByteString -> IO Bool

modifySolicited   = modifyFile ("<? solicited ?>"   , solicitedFile)
modifyBuddies     = modifyFile ("<? buddies ?>"     , buddyFile)
modifyOthers      = modifyFile ("<? others ?>"      , otherFile)
modifyPending     = modifyFile ("<? pending ?>"     , pendingFile)
modifySubscribers = modifyFile ("<? subscribers ?>" , subscriberFile)

addBuddy :: User -> Profile -> ByteString -> IO ()
addBuddy user profile buddy =
    configPath user profile buddyFile >>= addItem buddy "<? buddies ?>"

addSubscriber :: User -> Profile -> ByteString -> IO ()
addSubscriber user profile subscriber =
    configPath user profile subscriberFile >>= addItem subscriber "<? subscribers ?>"

addSolicited :: User -> Profile -> ByteString -> IO ()
addSolicited user profile solicited =
    configPath user profile solicitedFile >>= addItem solicited "<? solicited ?>"

getConfigList :: FilePath -> IO [ByteString]
getConfigList path =
  handle (\e -> if isDoesNotExistError e then (return []) else throw e)
    $ withFile path ReadMode $
        L.hGetContents
        >=> return . Prelude.tail . L.lines
        >=> (\a -> seq (rnf a) (return a))

getBuddies :: User -> Profile -> IO [ByteString]
getBuddies user profile = configPath user profile buddyFile >>= getConfigList

getSubscribers :: User -> Profile -> IO [ByteString]
getSubscribers user profile = configPath user profile subscriberFile >>= getConfigList

getOthers :: User -> Profile -> IO [ByteString]
getOthers user profile = configPath user profile otherFile >>= getConfigList

getPending :: User -> Profile -> IO [ByteString]
getPending user profile = configPath user profile pendingFile >>= getConfigList

getSolicited :: User -> Profile -> IO [ByteString]
getSolicited user profile = configPath user profile solicitedFile >>= getConfigList

getSecrets :: User -> Profile -> IO [ByteString]
getSecrets user profile = configPath user profile secretsFile >>= getConfigList