module EIBd.Client.Groups (
	-- * Types
	GroupCache,

	-- * Execution
	GroupM,
	execGroupM,
	tryGroupM,
	tryGroupM_,

	-- * Cache Interaction
	putGroup,
	getGroup,
	clearGroups,
	uncacheGroup,
) where

import Control.Monad
import Control.Monad.State.Strict
import Control.Monad.Trans.Maybe
import Control.Applicative

import qualified Data.ByteString as B
import qualified Data.Map.Strict as M

import EIBd.Client.Types
import EIBd.Client.Address
import EIBd.Client.Connection

-- | Group Cache
type GroupCache = M.Map GroupAddress B.ByteString

-- | Handle cached group values
type GroupM = MaybeT (StateT GroupCache IO)

-- | Execute a GroupM action. Changes to group values will be send to
--   EIBd after the GroupM action has run.
execGroupM :: GroupM a -> Connection -> GroupCache -> IO GroupCache
execGroupM handler conn cache = do
	-- Generate the new group cache map
	newCache <- execStateT (runMaybeT handler) cache

	-- Commit changed groups
	M.foldlWithKey' updateGroup (return True) (toBeUpdated newCache)

	return newCache

	where
		-- Figure out which groups have been updated
		toBeUpdated newCache = M.differenceWith (const . Just) newCache cache

		-- Used to generate an IO action which commits
		-- all changed groups to EIBd
		updateGroup prev dst val = do
			prev
			sendMessage conn dst 0 GroupAddrWrite val

-- | Try to execute a GroupM action. If it fails return the given alternative value.
tryGroupM :: a -> GroupM a -> GroupM a
tryGroupM a ch = ch <|> return a

-- | Similar to "tryGroupM" but without an alternative return value.
tryGroupM_ :: GroupM a -> GroupM ()
tryGroupM_ = tryGroupM () . void

-- | Update a group value. The new value will be commited to the cache
--   immediately but not to the bus. See "execGroupM" for more.
putGroup :: DatapointType a => GroupAddress -> a -> GroupM ()
putGroup dst val = lift (modify (M.insert dst (fromDPT val)))

-- | Fetch a group value.
--   If a group value is not cached yet, this function will silently fail and
--   stop further instructions. Even in a case of failure, previous changes to
--   group values will be commited to EIBd.
getGroup :: DatapointType a => GroupAddress -> GroupM a
getGroup adr = MaybeT (gets (\m -> M.lookup adr m >>= toDPT))

-- | Clear the entire cache.
clearGroups :: GroupM ()
clearGroups = lift (put M.empty)

-- | Remove one group from the cache.
uncacheGroup :: GroupAddress -> GroupM ()
uncacheGroup = lift . modify . M.delete