{-
 - Load application configuration from a config file.
 -}

module Hmpf.Config ( load ) where

import Data.ConfigFile
import Control.Concurrent.MVar (swapMVar)
import Control.Monad.Error
import Network.Socket (PortNumber)
import qualified Hmpf.ApplicationTypes as S


defaultlocations = [ "~/.hmpf.conf" , "/etc/hmpf.conf" ]


--Known properties
lirc = "lirc.socket"
mpdhost = "mpd.host"
mpdport = "mpd.port"
lcdhost = "lcd.host"
lcdport = "lcd.port"
lastuid = "lastfm.uid"
lastpass = "lastfm.pwd"


load :: FilePath -> S.Session ()
load f = do
 st <- S.get
 m' <- m
 case m' of
  Left _ -> lift $ putStrLn "MPD not configured. Using defaults"
  Right x -> do
              let mv = S.mpdConf st
	      lift (swapMVar mv x)
	      return ()
              --S.put st { S.mpdConf =  }
 l' <- l
 case l' of
  Left _ -> lift $ putStrLn "LCD not configured. Using defaults"
  Right x -> S.put st { S.lcdConf = x }
 r' <- r
 case r' of
  Left _ -> lift $ putStrLn "LIRC not configured. Using defaults"
  Right x -> S.put st { S.lircConf = x }
 lf' <- lf
 case lf' of
  Left _ -> lift $ putStrLn "Last.FM user not configured."
  Right x -> S.put st { S.lastfmUser = x }
 
 where
 m = lift $ runErrorT ( getMPDConfig f )
 l = lift $ runErrorT ( getLCDConfig f )
 r = lift $ runErrorT ( getLIRCConfig f )
 lf = lift $ runErrorT ( getLastFM f )


--getProperty p = msum . map (getProperty' p) 
getProperty p [f] = (getProperty' p f)
getProperty p (f:fs) = 
 (getProperty' p f) `mplus` (getProperty p fs)

getProperty' p f = do
 load'
 where
 loadFile = catch (readFile f >>= return . Right )
                  (\e -> return . Left . show $ e )
 load' = do 
  cts <- liftIO loadFile
  case cts of
   Right cp -> do
  	cp <- readstring emptyCP cp
  	val <- get cp "DEFAULT" p
        -- lift (putStr p >> putStrLn (show val) )
        return val
   Left err -> do
        -- lift (putStr p >> putStrLn err)
        fail err

getLIRCConfig file = do
 dev <- getProperty lirc files
 return (dev :: FilePath )
 where
  files  = ( file : defaultlocations )

getLastFM file = do
 uid <- getProperty lastuid files
 pwd <- getProperty lastpass files
 return $ Just (uid :: String , pwd :: String)
 where
  files  = ( file : defaultlocations )

getLCDConfig file = do
 host <- getProperty lcdhost files
 port <- getProperty lcdport files
 return (host :: String , (toEnum port) :: PortNumber)
 where
  files  = ( file : defaultlocations )

getMPDConfig file = do
 host <- getProperty mpdhost files
 port <- getProperty mpdport files
 return (host :: String , (toEnum  port) :: PortNumber)
 where
  files  = ( file : defaultlocations )