diff options
Diffstat (limited to 'src/Message')
| -rw-r--r-- | src/Message/Service.hs | 26 |
1 files changed, 18 insertions, 8 deletions
diff --git a/src/Message/Service.hs b/src/Message/Service.hs index 1311e24..0a8f180 100644 --- a/src/Message/Service.hs +++ b/src/Message/Service.hs @@ -1,10 +1,10 @@ module Message.Service ( - DirectMessageService(..), + DirectMessageService, + ServicePacket(DirectMessagePacket), formatMessage, ) where import Control.Monad.Reader -import Control.Monad.State import Data.List import qualified Data.Text as T @@ -18,18 +18,24 @@ import State import Storage import Storage.List -data DirectMessageService = DirectMessageService +data DirectMessageService instance Service DirectMessageService where - type ServicePacket DirectMessageService = DirectMessage + serviceID _ = mkServiceID "c702076c-4928-4415-8b6b-3e839eafcb0d" + + data ServiceState DirectMessageService = DirectMessageService emptyServiceState = DirectMessageService - serviceHandler smsg = do - let msg = fromStored smsg + + newtype ServicePacket DirectMessageService = DirectMessagePacket (Stored DirectMessage) + + serviceHandler packet = do + let DirectMessagePacket smsg = fromStored packet + msg = fromStored smsg powner <- asks $ finalOwner . svcPeer tzone <- liftIO $ getCurrentTimeZone svcPrint $ formatMessage tzone msg if | powner `sameIdentity` msgFrom msg - -> do erb <- gets svcLocal + -> do erb <- svcGetLocal let st = storedStorage erb erb' <- liftIO $ do threads <- storedFromSList $ lsMessages $ fromStored erb @@ -38,12 +44,16 @@ instance Service DirectMessageService where slistReplaceS thread thread' $ lsMessages $ fromStored erb Nothing -> slistAdd (emptyDirectThread powner) { msgHead = [smsg] } $ lsMessages $ fromStored erb wrappedStore st (fromStored erb) { lsMessages = slist } - modify $ \s -> s { svcLocal = erb' } + svcSetLocal erb' return Nothing | otherwise -> do svcPrint "Owner mismatch" return Nothing +instance Storable (ServicePacket DirectMessageService) where + store' (DirectMessagePacket smsg) = store' smsg + load' = DirectMessagePacket <$> load' + formatMessage :: TimeZone -> DirectMessage -> String formatMessage tzone msg = concat [ formatTime defaultTimeLocale "[%H:%M] " $ utcToLocalTime tzone $ zonedTimeToUTC $ msgTime msg |