From 84d7c83bc85ff0862a39d6de3bd227550175ebce Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Roman=20Smr=C5=BE?= <roman.smrz@seznam.cz>
Date: Sun, 2 Feb 2020 21:03:02 +0100
Subject: Direct messages in shared state

---
 src/Message/Service.hs | 63 --------------------------------------------------
 1 file changed, 63 deletions(-)
 delete mode 100644 src/Message/Service.hs

(limited to 'src/Message')

diff --git a/src/Message/Service.hs b/src/Message/Service.hs
deleted file mode 100644
index 0a8f180..0000000
--- a/src/Message/Service.hs
+++ /dev/null
@@ -1,63 +0,0 @@
-module Message.Service (
-    DirectMessageService,
-    ServicePacket(DirectMessagePacket),
-    formatMessage,
-) where
-
-import Control.Monad.Reader
-
-import Data.List
-import qualified Data.Text as T
-import Data.Time.Format
-import Data.Time.LocalTime
-
-import Identity
-import Message
-import Service
-import State
-import Storage
-import Storage.List
-
-data DirectMessageService
-
-instance Service DirectMessageService where
-    serviceID _ = mkServiceID "c702076c-4928-4415-8b6b-3e839eafcb0d"
-
-    data ServiceState DirectMessageService = DirectMessageService
-    emptyServiceState = DirectMessageService
-
-    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 <- svcGetLocal
-                 let st = storedStorage erb
-                 erb' <- liftIO $ do
-                     threads <- storedFromSList $ lsMessages $ fromStored erb
-                     slist <- case find (sameIdentity powner . msgPeer . fromStored) threads of
-                                   Just thread -> do thread' <- wrappedStore st (fromStored thread) { msgHead = smsg : msgHead (fromStored thread) }
-                                                     slistReplaceS thread thread' $ lsMessages $ fromStored erb
-                                   Nothing -> slistAdd (emptyDirectThread powner) { msgHead = [smsg] } $ lsMessages $ fromStored erb
-                     wrappedStore st (fromStored erb) { lsMessages = slist }
-                 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
-    , maybe "<unnamed>" T.unpack $ idName $ msgFrom msg
-    , ": "
-    , T.unpack $ msgText msg
-    ]
-- 
cgit v1.2.3