{-# 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