Basic concepts

11 files changed, 148 insertions, 9 deletions

diff --git a/all.gup b/all.gup
new file mode 100644
index 0000000..c83d29c
--- /dev/null
+++ b/all.gup
@@ -0,0 +1,3 @@
+#!/usr/bin/env zsh
+
+gup -u result
\ No newline at end of file
diff --git a/lib/Postdelay/Scan.hs b/lib/Postdelay/Scan.hs
new file mode 100644
index 0000000..e6de0cf
--- /dev/null
+++ b/lib/Postdelay/Scan.hs
@@ -0,0 +1,43 @@
+{-# LANGUAGE OverloadedStrings, ScopedTypeVariables, FlexibleContexts #-}
+
+module Postdelay.Scan
+  ( scan
+  , Delay(..)
+  , ParseError(..)
+  ) where
+
+import Postdelay.Types
+import Postdelay.Utils
+import Postdelay.TimeSpec
+
+import Control.Monad
+import Control.Monad.IO.Class
+import Control.Monad.Error.Class
+
+import Text.Parsec.Char
+import Text.Parsec.Prim
+import Text.Parsec.Combinator
+import Text.Parsec.Error (ParseError(..))
+import Text.ParserCombinators.Parsec.Rfc2822
+
+import Data.CaseInsensitive (CI)
+import qualified Data.CaseInsensitive as CI
+
+import Data.Either
+import Data.Foldable
+import Data.Semigroup
+
+
+scan :: (MonadIO m, MonadError ParseError m) => String -> m (Maybe Delay)
+scan = fmap getOption . extractDelay <=< either throwError return . parse message ""
+
+extractDelay :: forall m. (MonadIO m, MonadError ParseError m) => Message -> m (Option Delay)
+extractDelay (Message headers _) = foldMap pure <$> mapM parseDelay delayHeaders
+  where
+    delayHeaders :: [Field]
+    delayHeaders = do
+      h@(OptionalField field content) <- headers
+      guard $ CI.mk field == "X-Delay"
+      return h
+    parseDelay :: Field -> m Delay
+    parseDelay (OptionalField field content) = either throwError return =<< runParserT (Until <$> pTimeSpec) () field content
diff --git a/lib/Postdelay/TimeSpec.hs b/lib/Postdelay/TimeSpec.hs
new file mode 100644
index 0000000..b080dcc
--- /dev/null
+++ b/lib/Postdelay/TimeSpec.hs
@@ -0,0 +1,14 @@
+module Postdelay.TimeSpec
+  ( pTimeSpec
+  ) where
+
+import Control.Monad.IO.Class
+import Data.Time
+
+import Text.Parsec.Char
+import Text.Parsec.Prim
+import Text.Parsec.Combinator
+import Text.Parsec.Error (ParseError(..))
+
+pTimeSpec :: MonadIO m => ParsecT String () m UTCTime
+pTimeSpec = undefined
diff --git a/lib/Postdelay/Types.hs b/lib/Postdelay/Types.hs
new file mode 100644
index 0000000..3f66fb8
--- /dev/null
+++ b/lib/Postdelay/Types.hs
@@ -0,0 +1,13 @@
+module Postdelay.Types
+  ( Delay(..)
+  ) where
+
+import Data.Semigroup
+
+import Data.Time.Clock (UTCTime)
+
+newtype Delay = Until { releaseTime :: UTCTime }
+  deriving (Eq, Ord)
+
+instance Semigroup Delay where
+  (Until a) <> (Until b) = Until $ max a b
diff --git a/lib/Postdelay/Utils.hs b/lib/Postdelay/Utils.hs
new file mode 100644
index 0000000..d716b4d
--- /dev/null
+++ b/lib/Postdelay/Utils.hs
@@ -0,0 +1,21 @@
+{-# LANGUAGE FlexibleContexts #-}
+
+module Postdelay.Utils
+  ( hoistParsecT
+  ) where
+
+import Control.Monad.Error.Class
+
+import Data.Functor
+import Data.Either
+
+import Data.Functor.Identity
+import Text.Parsec.Prim
+import Text.Parsec.Error
+
+hoistParsecT :: (Monad m, Stream s Identity t, Stream s m t) => ParsecT s u Identity a -> ParsecT s u m a
+hoistParsecT p = do
+  st <- getParserState
+  let res = runParser p' undefined "" undefined
+      p' = setParserState st >> ((,) <$> getState <*> p)
+  either (fail . show) (\(st', res) -> putState st' $> res) $ res
diff --git a/postdelay.cabal b/postdelay.cabal
index 9f13336..957e6d5 100644
--- a/postdelay.cabal
+++ b/postdelay.cabal
@@ -16,10 +16,26 @@ build-type:          Simple
 -- extra-source-files:  
 cabal-version:       >=1.10
 
-executable postdelay
-  main-is:             Main.hs
+library
+  exposed-modules:     Postdelay.Scan
+                     , Postdelay.Types
+  other-modules:       Postdelay.Utils
+                     , Postdelay.TimeSpec
+  build-depends:       base >=4.9 && <5
+                     , time >=1.6 && <2
+                     , parsec >=3.1 && <4
+                     , case-insensitive >=1.2 && <2
+                     , hsemail >=1.7 && <2
+                     , mtl >=2.2 && <3
+  hs-source-dirs:      lib
+  default-language:    Haskell2010
+
+executable postdelay-simple
+  main-is:             Simple.hs
   -- other-modules:       
   -- other-extensions:    
   build-depends:       base >=4.9 && <5
+                     , postdelay
+                     , transformers >=0.5 && <1
   hs-source-dirs:      src
   default-language:    Haskell2010
diff --git a/postdelay.nix b/postdelay.nix
index 1ef3413..66dae61 100644
--- a/postdelay.nix
+++ b/postdelay.nix
@@ -1,11 +1,16 @@
-{ mkDerivation, base, stdenv }:
+{ mkDerivation, base, case-insensitive, hsemail, mtl, parsec
+, stdenv, time, transformers
+}:
 mkDerivation {
   pname = "postdelay";
   version = "0.0.0";
   src = ./.;
-  isLibrary = false;
+  isLibrary = true;
   isExecutable = true;
-  executableHaskellDepends = [ base ];
+  libraryHaskellDepends = [
+    base case-insensitive hsemail mtl parsec time
+  ];
+  executableHaskellDepends = [ base transformers ];
   homepage = "https://git.yggdrasil.li/gkleen/pub/postdelay";
   description = "A postfix content filter for delaying delivery of mail";
   license = stdenv.lib.licenses.mit;
diff --git a/postdelay.nix.gup b/postdelay.nix.gup
index 976221f..976221f 100755..100644
--- a/postdelay.nix.gup
+++ b/postdelay.nix.gup
diff --git a/result.gup b/result.gup
new file mode 100644
index 0000000..5c03e49
--- /dev/null
+++ b/result.gup
@@ -0,0 +1,4 @@
+#!/usr/bin/env zsh
+
+gup -u postdelay.nix default.nix
+nix-build -o ${1} ./default.nix
\ No newline at end of file
diff --git a/src/Main.hs b/src/Main.hs
deleted file mode 100644
index 65ae4a0..0000000
--- a/src/Main.hs
+++ /dev/null
@@ -1,4 +0,0 @@
-module Main where
-
-main :: IO ()
-main = putStrLn "Hello, Haskell!"
diff --git a/src/Simple.hs b/src/Simple.hs
new file mode 100644
index 0000000..f461766
--- /dev/null
+++ b/src/Simple.hs
@@ -0,0 +1,24 @@
+module Main (main) where
+
+import Postdelay.Scan
+
+import Control.Monad.IO.Class
+import Control.Monad.Trans.Except
+
+  
+main :: MonadIO 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