From 067c9c10e08bc48678687996945b35fa921229f4 Mon Sep 17 00:00:00 2001
From: Gregor Kleen <aethoago@141.li>
Date: Thu, 26 Jan 2017 22:10:29 +0100
Subject: Basic concepts

---
 lib/Postdelay/Scan.hs | 43 +++++++++++++++++++++++++++++++++++++++++++
 1 file changed, 43 insertions(+)
 create mode 100644 lib/Postdelay/Scan.hs

(limited to 'lib/Postdelay/Scan.hs')

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
-- 
cgit v1.2.3