Framework for spooling

1 files changed, 59 insertions, 18 deletions

diff --git a/src/Simple.hs b/src/Simple.hs
index f461766..68524a8 100644
--- a/src/Simple.hs
+++ b/src/Simple.hs
@@ -1,24 +1,65 @@
+{-# LANGUAGE RecordWildCards, ApplicativeDo, FlexibleContexts #-}
+
 module Main (main) where
 
 import Postdelay.Scan
+import Postdelay.Queue
 
-import Control.Monad.IO.Class
-import Control.Monad.Trans.Except
+import Data.Function (on)
+import Data.List
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
 
-  
-main :: MonadIO m => m ()
+import Control.Monad.IO.Class (MonadIO(..))
+import Control.Monad.Catch (MonadCatch)
+import Control.Monad.Reader
+
+import Data.ByteString.Lazy as Lazy (ByteString)
+import qualified Data.ByteString.Lazy as Lazy.BS
+
+import Data.ByteString.Lazy.Char8 as Lazy.Char8 (ByteString)
+import qualified Data.ByteString.Lazy.Char8 as Lazy.Char8.BS
+
+import Data.Conduit
+
+import System.Environment (getProgName)
+
+import qualified Options.Applicative as Opt (Parser)
+import Options.Applicative hiding (Parser)
+
+
+opts :: Opt.Parser (String, [String], StoreConfig)
+opts = do
+  sConfig <- storeConfig
+  sender <- strOption $ mconcat
+    [ long "sender"
+    , short 'f'
+    , metavar "SENDER"
+    ]
+  recipients <- some . strArgument $ mconcat
+    [ metavar "RECIPIENTS"
+    ]
+  pure (sender, recipients, sConfig)
+
+main :: (MonadIO m, MonadCatch m) => m ()
 main = do
-  mailStr <- liftIO getContents
-  delay <- runExceptT $ scan mailStr
-  case delay of
-    Left err       -> do
-      liftIO . putStrLn $ show err
-      sendNow mailStr
-    Right Nothing  -> sendNow mailStr
-    Right (Just d) -> sendLater mailStr d
-
-sendNow :: MonadIO m => String -> m ()
-sendNow = undefined
-
-sendLater :: MonadIO m => String -> Delay -> m ()
-sendLater = undefined
+  pName <- liftIO getProgName
+  (sender, recipients, sConfig) <- liftIO . execParser . info (helper <*> opts) $ mconcat
+    [ fullDesc
+    , progDesc "Queue an email for later delivery"
+    , header pName
+    ]
+  
+  flip runReaderT sConfig $ do
+    mailStr <- liftIO getContents
+    delay <- scan mailStr
+    let
+      (headers, body) = break (== "") $ lines mailStr
+      mailStr' = unlines $ filter (not . (isPrefixOf `on` CI.foldCase) "X-Delay:") headers ++ body
+
+      sendNow = sendmail sender recipients $ Lazy.Char8.BS.pack mailStr'
+      sendLater sendDelay = pushStore . yield $ StoredMail
+        { message = Lazy.Char8.BS.pack mailStr'
+        , ..
+        }
+    maybe sendNow sendLater delay