module System.Cron.Types
( CronSchedule(..)
, Crontab(..)
, CrontabEntry(..)
, MinuteSpec
, CronCommand(..)
, minuteSpec
, mkMinuteSpec
, HourSpec
, hourSpec
, mkHourSpec
, MonthSpec
, monthSpec
, mkMonthSpec
, DayOfMonthSpec
, dayOfMonthSpec
, mkDayOfMonthSpec
, DayOfWeekSpec
, dayOfWeekSpec
, mkDayOfWeekSpec
, BaseField(..)
, SpecificField
, specificField
, mkSpecificField
, RangeField
, rfBegin
, rfEnd
, mkRangeField
, CronField(..)
, StepField
, sfField
, sfStepping
, mkStepField
, yearly
, monthly
, daily
, weekly
, hourly
, everyMinute
, serializeCronSchedule
, serializeCrontab
) where
import Control.Applicative as A
import qualified Data.Foldable as FT
import Data.Ix
import Data.List.NonEmpty (NonEmpty (..))
import qualified Data.List.NonEmpty as NE
import Data.Monoid
import Data.Text (Text)
import qualified Data.Text as T
import Data.Typeable (Typeable)
import GHC.Generics (Generic)
yearly :: CronSchedule
yearly = monthly { month = Months (Field (SpecificField' (SpecificField 1))) }
monthly :: CronSchedule
monthly = daily { dayOfMonth = DaysOfMonth (Field (SpecificField' (SpecificField 1))) }
weekly :: CronSchedule
weekly = daily { dayOfWeek = DaysOfWeek (Field (SpecificField' (SpecificField 0))) }
daily :: CronSchedule
daily = hourly { hour = Hours (Field (SpecificField' (SpecificField 0))) }
hourly :: CronSchedule
hourly = everyMinute { minute = Minutes (Field (SpecificField' (SpecificField 0))) }
everyMinute :: CronSchedule
everyMinute = CronSchedule {
minute = Minutes (Field Star)
, hour = Hours (Field Star)
, dayOfMonth = DaysOfMonth (Field Star)
, month = Months (Field Star)
, dayOfWeek = DaysOfWeek (Field Star)
}
class ShowT a where
showT :: a -> Text
instance ShowT Text where
showT = id
instance ShowT Int where
showT = T.pack . show
data CronSchedule = CronSchedule {
minute :: MinuteSpec
, hour :: HourSpec
, dayOfMonth :: DayOfMonthSpec
, month :: MonthSpec
, dayOfWeek :: DayOfWeekSpec
} deriving (Eq, Generic, Typeable)
instance Show CronSchedule where
show cs = "CronSchedule " <> T.unpack (showT cs)
instance ShowT CronSchedule where
showT CronSchedule {..} = T.unwords [ showT minute
, showT hour
, showT dayOfMonth
, showT month
, showT dayOfWeek
]
serializeCronSchedule :: CronSchedule -> Text
serializeCronSchedule = showT
newtype Crontab = Crontab {
crontabEntries :: [CrontabEntry]
} deriving (Eq, Generic, Typeable)
instance ShowT Crontab where
showT (Crontab entries) = T.intercalate "\n" (showT A.<$> entries)
instance Show Crontab where
show = T.unpack . showT
serializeCrontab :: Crontab -> Text
serializeCrontab = showT
newtype CronCommand = CronCommand {
cronCommand :: Text
} deriving (Show, Eq, Ord, ShowT, Generic, Typeable)
data CrontabEntry = CommandEntry CronSchedule CronCommand
| EnvVariable Text Text
deriving (Eq, Generic, Typeable)
instance ShowT CrontabEntry where
showT (CommandEntry s c) = showT s <> " " <> showT c
showT (EnvVariable n v) = showT n <> "=" <> showT v
instance Show CrontabEntry where
show = T.unpack . showT
newtype MinuteSpec = Minutes {
minuteSpec :: CronField
} deriving (Eq, ShowT, Generic, Typeable)
instance Show MinuteSpec where
show (Minutes cf) = show cf
mkMinuteSpec :: CronField -> Maybe MinuteSpec
mkMinuteSpec cf
| validCF cf 0 59 = Just (Minutes cf)
| otherwise = Nothing
newtype HourSpec = Hours {
hourSpec :: CronField
} deriving (Eq, ShowT, Generic, Typeable)
instance Show HourSpec where
show (Hours cf) = show cf
mkHourSpec :: CronField -> Maybe HourSpec
mkHourSpec cf
| validCF cf 0 23 = Just (Hours cf)
| otherwise = Nothing
newtype DayOfMonthSpec = DaysOfMonth {
dayOfMonthSpec :: CronField
} deriving (Eq, ShowT, Generic, Typeable)
instance Show DayOfMonthSpec where
show (DaysOfMonth cf) = show cf
mkDayOfMonthSpec :: CronField -> Maybe DayOfMonthSpec
mkDayOfMonthSpec cf
| validCF cf 1 31 = Just (DaysOfMonth cf)
| otherwise = Nothing
newtype MonthSpec = Months {
monthSpec :: CronField
} deriving (Eq, ShowT, Generic, Typeable)
instance Show MonthSpec where
show (Months cf) = show cf
mkMonthSpec :: CronField -> Maybe MonthSpec
mkMonthSpec cf
| validCF cf 1 12 = Just (Months cf)
| otherwise = Nothing
newtype DayOfWeekSpec = DaysOfWeek {
dayOfWeekSpec :: CronField
} deriving (Eq, ShowT, Generic, Typeable)
instance Show DayOfWeekSpec where
show (DaysOfWeek cf) = show cf
mkDayOfWeekSpec :: CronField -> Maybe DayOfWeekSpec
mkDayOfWeekSpec cf
| validCF cf 0 7 = Just (DaysOfWeek cf)
| otherwise = Nothing
validCF
:: CronField
-> Int
-> Int
-> Bool
validCF (Field bf) mn mx = validBF bf mn mx
validCF (ListField bfs) mn mx = FT.all (\bf -> validBF bf mn mx) bfs
validCF (StepField' (StepField bf step)) mn mx = validBF bf mn mx && inRange (mn, mx) step
validBF
:: BaseField
-> Int
-> Int
-> Bool
validBF Star _ _ = True
validBF (SpecificField' (SpecificField n)) mn mx =
inRange (mn, mx) n
validBF (RangeField' (RangeField n1 n2)) mn mx =
inRange (mn, mx) n1 && inRange (mn, mx) n2
data BaseField = Star
| SpecificField' SpecificField
| RangeField' RangeField
deriving (Eq, Generic, Typeable)
instance ShowT BaseField where
showT Star = "*"
showT (SpecificField' f) = showT f
showT (RangeField' rf) = showT rf
instance Show BaseField where
show = T.unpack . showT
newtype SpecificField = SpecificField {
specificField :: Int
} deriving (Eq, ShowT, Generic, Typeable)
instance Show SpecificField where
show = T.unpack . showT
mkSpecificField :: Int -> Maybe SpecificField
mkSpecificField n
| n >= 0 = Just (SpecificField n)
| otherwise = Nothing
data RangeField = RangeField {
rfBegin :: Int
, rfEnd :: Int
} deriving (Eq, Generic, Typeable)
instance ShowT RangeField where
showT (RangeField x y) = showT x <> "-" <> showT y
instance Show RangeField where
show = T.unpack . showT
mkRangeField :: Int -> Int -> Maybe RangeField
mkRangeField x y
| x <= y = Just (RangeField x y)
| otherwise = Nothing
data CronField = Field BaseField
| ListField (NonEmpty BaseField)
| StepField' StepField
deriving (Generic)
instance Eq CronField where
Field a == Field b = a == b
Field a == ListField (b :| []) = a == b
ListField as == ListField bs = as == bs
ListField (a :| []) == Field b = a == b
StepField' a == StepField' b = a == b
_ == _ = False
instance ShowT CronField where
showT (Field f) = showT f
showT (ListField xs) = T.intercalate "," (NE.toList (showT <$> xs))
showT (StepField' sf) = showT sf
instance Show CronField where
show = T.unpack . showT
data StepField = StepField { sfField :: BaseField
, sfStepping :: Int
} deriving (Eq, Generic)
instance ShowT StepField where
showT (StepField f step) = showT f <> "/" <> showT step
instance Show StepField where
show = T.unpack . showT
mkStepField :: BaseField -> Int -> Maybe StepField
mkStepField bf n
| n > 0 = Just (StepField bf n)
| otherwise = Nothing