! Copyright (C) 2018 John Benediktsson
! See http://factorcode.org/license.txt for BSD license

USING: accessors arrays ascii assocs calendar calendar.english
calendar.private combinators io kernel literals locals math
math.order math.parser math.ranges sequences splitting ;

IN: crontab

:: parse-value ( value quot: ( value -- value' ) seq -- value )
    value {
        { [ CHAR: , over member? ] [
            "," split [ quot seq parse-value ] map concat ] }
        { [ dup "*" = ] [ drop seq ] }
        { [ CHAR: / over member? ] [
            "/" split1 [ quot seq parse-value 0 over length 1 - ] dip
            string>number <range> swap nths ] }
        { [ CHAR: - over member? ] [
            "-" split1 quot bi@ [a,b] ] }
        [ quot call 1array ]
    } cond ; inline recursive

: parse-day ( str -- n )
    dup string>number [ ] [
        >lower $[ day-abbreviations3 [ >lower ] map ] index
    ] ?if ;

: parse-month ( str -- n )
    dup string>number [ ] [
        >lower $[ month-abbreviations [ >lower ] map ] index
    ] ?if ;

TUPLE: cronentry minutes hours days months days-of-week command ;

CONSTANT: aliases H{
    { "@yearly"   "0 0 1 1 *" }
    { "@annually" "0 0 1 1 *" }
    { "@monthly"  "0 0 1 * *" }
    { "@weekly"   "0 0 * * 0" }
    { "@daily"    "0 0 * * *" }
    { "@midnight" "0 0 * * *" }
    { "@hourly"   "0 * * * *" }
}

: parse-cronentry ( entry -- cronentry )
    " " split1 [ aliases ?at drop ] dip " " glue
    " " split1 " " split1 " " split1 " " split1 " " split1 {
        [ [ string>number ] T{ range f 0 60 1 } parse-value ]
        [ [ string>number ] T{ range f 0 24 1 } parse-value ]
        [ [ string>number ] T{ range f 1 31 1 } parse-value ]
        [ [ parse-month ] T{ range f 1 12 1 } parse-value ]
        [ [ parse-day ] T{ range f 0 7 1 } parse-value ]
        [ ]
    } spread cronentry boa ;

<PRIVATE

:: (next-time-after) ( cronentry timestamp -- )
    timestamp month>> :> month
    cronentry months>> [ month >= ] find nip [
        dup month = [ drop f ] [
            timestamp 1 >>day 0 >>hour 0 >>minute month<< t
        ] if
    ] [
        timestamp 1 >>day 0 >>hour 0 >>minute
        cronentry months>> first >>month 1 +year
    ] if* [ cronentry timestamp (next-time-after) ] when

    timestamp day>> :> day
    cronentry days>> [ day >= ] find nip [
        dup day = [ drop f ] [
            timestamp 0 >>hour 0 >>minute day<< t
        ] if
    ] [
        timestamp 0 >>hour 0 >>minute
        cronentry days>> first >>day 1 +month
    ] if* [ cronentry timestamp (next-time-after) ] when

    timestamp day-of-week :> weekday
    cronentry days-of-week>> [ weekday >= ] find nip [
        cronentry days-of-week>> first 7 +
    ] unless* weekday - [
        timestamp 0 >>hour 0 >>minute swap +day drop
        cronentry timestamp (next-time-after)
    ] unless-zero

    timestamp hour>> :> hour
    cronentry hours>> [ hour >= ] find nip [
        dup hour = [ drop f ] [
            timestamp 0 >>minute hour<< t
        ] if
    ] [
        timestamp 0 >>minute
        cronentry hours>> first >>hour 1 +day
    ] if* [ cronentry timestamp (next-time-after) ] when

    timestamp minute>> :> minute
    cronentry minutes>> [ minute >= ] find nip [
        dup minute = [ drop f ] [ timestamp minute<< t ] if
    ] [
        timestamp cronentry minutes>> first >>minute 1 +hour
    ] if* [ cronentry timestamp (next-time-after) ] when ;

PRIVATE>

: next-time-after ( cronentry timestamp -- timestamp )
    1 minutes time+ 0 >>second [ (next-time-after) ] keep ;

: next-time ( cronentry -- timestamp )
    now next-time-after ;

: next-times-after ( cronentry n timestamp -- timestamps )
    swap [ dupd next-time-after dup ] replicate 2nip ;

: next-times ( cronentry n -- timestamps )
    now next-times-after ;

: read-crontab ( -- entries )
    lines harvest [ parse-cronentry ] map ;