{-# LANGUAGE ViewPatterns    #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE CPP             #-}
--------------------------------------------------------------------
-- |
-- Module      : System.Cron.Describe
-- Description : Turn a cron schedule into a human-readable string
-- Copyright   : (c) Joseph Canero 2016
-- License     : MIT
--
-- Maintainer: Joseph Canero <jmc41493@gmail.com>
-- Portability: portable
--
--
-- > import System.Cron
-- >
-- > main :: IO ()
-- > main = do
-- >   let Right cs1 = parseCronSchedule "*/2 * 3 * 4,5,6"
-- >   print $ describe defaultOpts cs1
-- >
-- >   let Right cs2 = parseCronSchedule "*/2 12 3 * 4,5,6"
-- >   print $ describe (twentyFourHourFormat <> verbose) cs2
--------------------------------------------------------------------
module System.Cron.Describe
    (
      -- * Options handling
      defaultOpts
    , twentyFourHourFormat
    , twelveHourFormat
    , verbose
    , notVerbose
    , OptionBuilder
      -- * Describe a CronSchedule
    , describe
    ) where

-------------------------------------------------------------------------------
import Control.Monad
import Data.List.NonEmpty                       (NonEmpty (..), toList)
import Data.Maybe                               (fromJust)
#if !MIN_VERSION_base(4,8,0)
import Data.Traversable                         (traverse)
#endif
-------------------------------------------------------------------------------
import System.Cron.Internal.Describe.Descriptors
import System.Cron.Internal.Describe.Options
import System.Cron.Internal.Describe.Time
import System.Cron.Internal.Describe.Types
import System.Cron.Internal.Describe.Utils
import System.Cron.Types
-------------------------------------------------------------------------------


-- | Given an 'OptionBuilder' and a 'CronSchedule' parsed with
-- 'System.Cron.Parser.parseCronSchedule', return a human-readable string
-- describing when that schedule will match.
describe :: OptionBuilder -> CronSchedule -> String
describe ob = cap                      .
              show                     .
              matchVerbosity verbosity .
              description timeFormat
  where Opts{..} = getOpts ob


-------------------------------------------------------------------------------
-- Internals
-------------------------------------------------------------------------------


describeRange :: RangeField -> Descriptor -> String
describeRange rf d = allWords [rangePrefix d,
                               displayItem d (rfBegin rf),
                               rangeJoiner d,
                               displayItem d (rfEnd rf),
                               rangeSuffix d]


describeBaseField :: Descriptor -> BaseField -> DescribedValue
describeBaseField d (RangeField' rf)   = Concrete $ describeRange rf d
describeBaseField d Star               = Every $ "every " ++ singularDesc d
describeBaseField d (SpecificField' s) =
  Concrete $ allWords [specificPrefix d,
                       displayItem d (specificField s),
                       specificSuffix d]


type StarOrDesc = Either String String


describeListFields :: (BaseField -> String) -> NonEmpty BaseField -> StarOrDesc
describeListFields f (l :| ls) =
  fmap joinWords . foldM describeF [] $ reverse (l:ls)
  where describeF _ Star = Left $ f Star
        describeF e bf   = Right $ f bf : e



describeCronField :: Descriptor -> CronField -> DescribedValue
describeCronField d (Field f) = describeBaseField d f


describeCronField d (StepField' sf) = Concrete $
  stepPrefix ++ maybe "" (", " ++) (stepSuffix $ sfField sf)
  where
    stepPrefix = unwords ["every", show (sfStepping sf), pluralDesc d]
    stepSuffix Star              = Nothing
    stepSuffix (RangeField' rf)  = Just $ describeRange rf d
    stepSuffix (SpecificField' s) = stepSpecificSuffix d $ specificField s


describeCronField d (ListField ls) =
  case describeListFields describeBF ls of
    Left  s -> Every s
    Right s -> Concrete $ unwords [listPrefix d,
                                   maybe s ((s ++ " ") ++) (listSuffix d)]
  where
    describeBF Star               = "every " ++ singularDesc d
    describeBF (SpecificField' s) = displayItem d $ specificField s
    describeBF (RangeField' rf)   = unwords [displayItem d (rfBegin rf),
                                             "through",
                                             displayItem d (rfEnd rf)]

-- There are a few special cases to handle when describing the minute and hour
-- fields that will make the cron description easier to read.
-- For the most part, these are pretty straight forward. The first three
-- pattern matches look for specific patterns in the minute and hour fields that
-- can be formatted differently. The last pattern match just defaults
-- to describing the fields using existing rules.
describeTime :: TimeFormat -> MinuteSpec -> HourSpec -> Time
describeTime tf (viewMinute -> Just m) (viewHour -> Just h) =
  ConcreteTime $ "at " ++ format tf m h
describeTime tf (viewMinuteRange -> Just (m1, m2)) (viewHour -> Just h) =
  ConcreteTime $ unwords ["every minute between",
                          format tf m1 h,
                          "and",
                          format tf m2 h]
describeTime tf (viewMinute -> Just m) (viewHourList -> Just hs) =
  describeMultHours tf m hs
describeTime tf (minuteSpec -> m) (hourSpec -> h) =
  Other (return $ describeCronField minuteDescriptor m)
        (return $ describeCronField (hourDescriptor tf) h)

-- We want to create a description for multiple hours given a concrete minute.
-- This is rather ugly, as the ListField type allows for any BaseField, so
-- we can potentially have a '*' within the list. In that case, we don't need
-- to describe the rest of the BaseFields for hour list, since we will just be
-- firing each hour.
describeMultHours :: TimeFormat -> Minute -> NonEmpty BaseField -> Time
describeMultHours t mn@(Minute m) ls =
  maybe mkOther (formatAllFields . toList) $ traverse formatBaseField ls
  where hourCF   = ListField ls
        minuteCF = Field (SpecificField' (fromJust $ mkSpecificField m))

        formatAllFields = ConcreteTime . ("at " ++) . joinWords

        formatBaseField (SpecificField' s) =
          Just $ format t mn (Hour (specificField s))
        formatBaseField Star               = Nothing
        formatBaseField f@(RangeField' _)  =
          Just $ unwords [show describedMinute,
                          show $ describeCronField (hourDescriptor t) (Field f)]

        mkOther = Other (return describedMinute)
                        (return $ describeCronField (hourDescriptor t) hourCF)
        describedMinute = describeCronField minuteDescriptor minuteCF


description :: TimeFormat -> CronSchedule -> Description
description t c = Desc (describeTime t (minute c) (hour c))
                       (return ddom)
                       (return dm)
                       (return ddow)
  where ddom = describeCronField domDescriptor $ dayOfMonthSpec (dayOfMonth c)
        dm   = describeCronField monthDescriptor $ monthSpec (month c)
        ddow = describeCronField dowDescriptor $ dayOfWeekSpec (dayOfWeek c)


matchVerbosity :: Verbosity -> Description -> Description
matchVerbosity v d@Desc{..} = d{  _dom   = stripEvery v =<< _dom
                                , _dow   = stripEvery v =<< _dow
                                , _time  = stripTime _time
                                , _month = stripEvery NotVerbose =<< _month}
  where stripTime t@(ConcreteTime _)   = t
        stripTime (Other mbMin mbHour) = Other mbMin (stripEvery v =<< mbHour)


stripEvery :: Verbosity -> DescribedValue -> Maybe DescribedValue
stripEvery NotVerbose (Every _) = Nothing
stripEvery _          c         = Just c