channels.scm

@@ -3,7 +3,7 @@
         (url "https://git.savannah.gnu.org/git/guix.git")
         (branch "master")
         (commit
-          "7309da3ba64a191f074807275d8c5661a25c035c")
+          "4547bc6fa3142dca77f7fc912368aeff31bd6e53")
         (introduction
           (make-channel-introduction
             "9edb3f66fd807b096b48283debdcddccfea34bad"

src/Main.hs

@@ -7,7 +7,6 @@ module Main where
 import Control.Concurrent (forkIO)
 import Control.Exception (onException)
 import Control.Exception (throwIO)
-import Control.Monad (void)
 import Data.Acid (openLocalState)
 import Data.Acid.Remote (skipAuthenticationCheck, acidServerSockAddr, openRemoteStateSockAddr, skipAuthenticationPerform)
 import Data.IMF (Mailbox, parse, mailbox)
@@ -22,6 +21,7 @@ import System.Exit.Codes (codeTempFail)
 import System.Posix.User (getRealUserID, userName, getUserEntryForID)
 import Web.Scotty (scotty, post, liftAndCatchIO, defaultHandler)
 
+
 import qualified Data.Text as T
 import qualified Data.Text.Lazy.IO as LT
 
@@ -30,7 +30,6 @@ import TiedoteMD.Review
 import TiedoteMD.Send
 import TiedoteMD.State
 import TiedoteMD.Types
-import TiedoteMD.Debug
 
 serverMain :: SockAddr -> Mailbox -> FilePath -> FilePath -> IO ()
 serverMain socket mail repoPath sendmailPath = do
@@ -39,7 +38,7 @@ serverMain socket mail repoPath sendmailPath = do
     queueMessages acid
     _ <- forkIO $ scotty 3000 $ do
         defaultHandler $ liftAndCatchIO . LT.putStrLn -- Don't return exceptions to clients
-        post "/" $ liftAndCatchIO $ void $ forkIO $ updateMessages acid repoPath
+        post "/" $ liftAndCatchIO $ updateMessages acid repoPath
     updateMessages acid repoPath
     _ <- forkIO $ manageQueueingMessages acid
     _ <- forkIO $ managePreviews acid mail sendmailPath
@@ -51,15 +50,8 @@ clientMain socket mail sendmailPath = do
         `onException` exitWith codeTempFail
     manageIncomingEmail acid mail sendmailPath
 
-printStateMain :: SockAddr -> IO ()
-printStateMain socket = do
-    acid <- openRemoteStateSockAddr skipAuthenticationPerform socket
-        `onException` openLocalState emptyState
-        `onException` exitWith codeTempFail
-    printState acid
-
 data Config = Config { socketPath :: FilePath, mail :: Mailbox, sendmailCommand :: String, runMode :: RunMode } deriving Show
-data RunMode = Server { repoPath :: FilePath } | Recieve | Print deriving Show
+data RunMode = Server { repoPath :: FilePath } | Recieve deriving Show
 
 config :: Maybe Mailbox -> Parser Config
 config mail = Config
@@ -67,8 +59,7 @@ config mail = Config
     <*> option readMailbox (long "address" <> short 'a' <> metavar "EMAIL" <> maybe mempty value mail <> help "Email address to send and recieve mail")
     <*> strOption (long "sendmail" <> short 'm' <> metavar "FILE" <> value "sendmail" <> help "Sendmail command")
     <*> hsubparser (command "server" (info serverCommand (progDesc "Run the server"))
-        <> command "recieve" (info (pure Recieve) (progDesc "Recieve an email"))
-        <> command "state" (info (pure Print) (progDesc "Print the server's current state")))
+        <> command "recieve" (info (pure Recieve) (progDesc "Recieve an email")))
 
 serverCommand :: Parser RunMode
 serverCommand = Server <$> strOption (long "repository" <> short 'r' <> metavar "DIRECTORY" <> value "/var/lib/tiedote.md/git-repo" <> showDefault <> help "Path to git repository")
@@ -87,5 +78,4 @@ main = do
         findExecutable (sendmailCommand args)
     case args of
       Config {runMode = Recieve, ..} -> clientMain (SockAddrUnix socketPath) mail sendmailPath
-      Config {runMode = Print, ..} -> printStateMain (SockAddrUnix socketPath)
       Config {runMode = Server {..}, ..} -> serverMain (SockAddrUnix socketPath) mail repoPath sendmailPath

src/TiedoteMD/Debug.hs

@@ -1,8 +0,0 @@
-module TiedoteMD.Debug where
-
-import Data.Acid (AcidState, query)
-
-import TiedoteMD.State
-
-printState :: AcidState State -> IO ()
-printState acid = query acid GetState >>= print

src/TiedoteMD/Send.hs

@@ -70,8 +70,8 @@ renderMessage' subjectPrefix maybeMailID (Message {messageContent = MessageConte
     set (headerFrom defaultCharsets) [Single sender] $
     IMF.Message (Headers []) $ Multipart Alternative boundary $ NE.fromList
         [ createTextPlainMessage plainTextMessage
-        , createTextMarkdownMessage markdownMessage
         , createTextHtmlMessage htmlMessage
+        , createTextMarkdownMessage markdownMessage
         ]
 
 createTextMarkdownMessage :: T.Text -> MIMEMessage

src/TiedoteMD/State.hs

@@ -35,7 +35,7 @@ emptyState = State
 updateListBy :: (a -> a -> Bool) -> [a] -> [a] -> [a]
 updateListBy f old new = olds <> news
     where news = differenceBy f new old
-          olds = intersectBy f old new
+          olds = intersectBy f old news
 
 elemBy :: (a -> b -> Bool) -> a -> [b] -> Bool
 elemBy = (.) any

tiedote-md.cabal

@@ -55,7 +55,6 @@ executable tiedote.md
     utf8-string
   main-is: Main.hs
   other-modules:
-    TiedoteMD.Debug
     TiedoteMD.Git
     TiedoteMD.Read
     TiedoteMD.Review