aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--.gitignore2
-rw-r--r--COPYING373
-rw-r--r--Makefile19
-rw-r--r--README.md19
-rw-r--r--app/Main.hs23
-rw-r--r--flake.lock80
-rw-r--r--flake.nix25
-rw-r--r--fourmolu.yaml5
-rw-r--r--src/Common.hs71
-rw-r--r--src/Cron.hs138
-rw-r--r--src/Cron/Expr.hs21
-rw-r--r--src/Cron/Parser.hs88
-rw-r--r--src/Cron/Schedule.hs72
-rw-r--r--src/Intro.hs64
-rw-r--r--uncron.cabal65
15 files changed, 1065 insertions, 0 deletions
diff --git a/.gitignore b/.gitignore
new file mode 100644
index 0000000..6d7e2df
--- /dev/null
+++ b/.gitignore
@@ -0,0 +1,2 @@
+dist-newstyle/
+result
diff --git a/COPYING b/COPYING
new file mode 100644
index 0000000..d0a1fa1
--- /dev/null
+++ b/COPYING
@@ -0,0 +1,373 @@
+Mozilla Public License Version 2.0
+==================================
+
+1. Definitions
+--------------
+
+1.1. "Contributor"
+ means each individual or legal entity that creates, contributes to
+ the creation of, or owns Covered Software.
+
+1.2. "Contributor Version"
+ means the combination of the Contributions of others (if any) used
+ by a Contributor and that particular Contributor's Contribution.
+
+1.3. "Contribution"
+ means Covered Software of a particular Contributor.
+
+1.4. "Covered Software"
+ means Source Code Form to which the initial Contributor has attached
+ the notice in Exhibit A, the Executable Form of such Source Code
+ Form, and Modifications of such Source Code Form, in each case
+ including portions thereof.
+
+1.5. "Incompatible With Secondary Licenses"
+ means
+
+ (a) that the initial Contributor has attached the notice described
+ in Exhibit B to the Covered Software; or
+
+ (b) that the Covered Software was made available under the terms of
+ version 1.1 or earlier of the License, but not also under the
+ terms of a Secondary License.
+
+1.6. "Executable Form"
+ means any form of the work other than Source Code Form.
+
+1.7. "Larger Work"
+ means a work that combines Covered Software with other material, in
+ a separate file or files, that is not Covered Software.
+
+1.8. "License"
+ means this document.
+
+1.9. "Licensable"
+ means having the right to grant, to the maximum extent possible,
+ whether at the time of the initial grant or subsequently, any and
+ all of the rights conveyed by this License.
+
+1.10. "Modifications"
+ means any of the following:
+
+ (a) any file in Source Code Form that results from an addition to,
+ deletion from, or modification of the contents of Covered
+ Software; or
+
+ (b) any new file in Source Code Form that contains any Covered
+ Software.
+
+1.11. "Patent Claims" of a Contributor
+ means any patent claim(s), including without limitation, method,
+ process, and apparatus claims, in any patent Licensable by such
+ Contributor that would be infringed, but for the grant of the
+ License, by the making, using, selling, offering for sale, having
+ made, import, or transfer of either its Contributions or its
+ Contributor Version.
+
+1.12. "Secondary License"
+ means either the GNU General Public License, Version 2.0, the GNU
+ Lesser General Public License, Version 2.1, the GNU Affero General
+ Public License, Version 3.0, or any later versions of those
+ licenses.
+
+1.13. "Source Code Form"
+ means the form of the work preferred for making modifications.
+
+1.14. "You" (or "Your")
+ means an individual or a legal entity exercising rights under this
+ License. For legal entities, "You" includes any entity that
+ controls, is controlled by, or is under common control with You. For
+ purposes of this definition, "control" means (a) the power, direct
+ or indirect, to cause the direction or management of such entity,
+ whether by contract or otherwise, or (b) ownership of more than
+ fifty percent (50%) of the outstanding shares or beneficial
+ ownership of such entity.
+
+2. License Grants and Conditions
+--------------------------------
+
+2.1. Grants
+
+Each Contributor hereby grants You a world-wide, royalty-free,
+non-exclusive license:
+
+(a) under intellectual property rights (other than patent or trademark)
+ Licensable by such Contributor to use, reproduce, make available,
+ modify, display, perform, distribute, and otherwise exploit its
+ Contributions, either on an unmodified basis, with Modifications, or
+ as part of a Larger Work; and
+
+(b) under Patent Claims of such Contributor to make, use, sell, offer
+ for sale, have made, import, and otherwise transfer either its
+ Contributions or its Contributor Version.
+
+2.2. Effective Date
+
+The licenses granted in Section 2.1 with respect to any Contribution
+become effective for each Contribution on the date the Contributor first
+distributes such Contribution.
+
+2.3. Limitations on Grant Scope
+
+The licenses granted in this Section 2 are the only rights granted under
+this License. No additional rights or licenses will be implied from the
+distribution or licensing of Covered Software under this License.
+Notwithstanding Section 2.1(b) above, no patent license is granted by a
+Contributor:
+
+(a) for any code that a Contributor has removed from Covered Software;
+ or
+
+(b) for infringements caused by: (i) Your and any other third party's
+ modifications of Covered Software, or (ii) the combination of its
+ Contributions with other software (except as part of its Contributor
+ Version); or
+
+(c) under Patent Claims infringed by Covered Software in the absence of
+ its Contributions.
+
+This License does not grant any rights in the trademarks, service marks,
+or logos of any Contributor (except as may be necessary to comply with
+the notice requirements in Section 3.4).
+
+2.4. Subsequent Licenses
+
+No Contributor makes additional grants as a result of Your choice to
+distribute the Covered Software under a subsequent version of this
+License (see Section 10.2) or under the terms of a Secondary License (if
+permitted under the terms of Section 3.3).
+
+2.5. Representation
+
+Each Contributor represents that the Contributor believes its
+Contributions are its original creation(s) or it has sufficient rights
+to grant the rights to its Contributions conveyed by this License.
+
+2.6. Fair Use
+
+This License is not intended to limit any rights You have under
+applicable copyright doctrines of fair use, fair dealing, or other
+equivalents.
+
+2.7. Conditions
+
+Sections 3.1, 3.2, 3.3, and 3.4 are conditions of the licenses granted
+in Section 2.1.
+
+3. Responsibilities
+-------------------
+
+3.1. Distribution of Source Form
+
+All distribution of Covered Software in Source Code Form, including any
+Modifications that You create or to which You contribute, must be under
+the terms of this License. You must inform recipients that the Source
+Code Form of the Covered Software is governed by the terms of this
+License, and how they can obtain a copy of this License. You may not
+attempt to alter or restrict the recipients' rights in the Source Code
+Form.
+
+3.2. Distribution of Executable Form
+
+If You distribute Covered Software in Executable Form then:
+
+(a) such Covered Software must also be made available in Source Code
+ Form, as described in Section 3.1, and You must inform recipients of
+ the Executable Form how they can obtain a copy of such Source Code
+ Form by reasonable means in a timely manner, at a charge no more
+ than the cost of distribution to the recipient; and
+
+(b) You may distribute such Executable Form under the terms of this
+ License, or sublicense it under different terms, provided that the
+ license for the Executable Form does not attempt to limit or alter
+ the recipients' rights in the Source Code Form under this License.
+
+3.3. Distribution of a Larger Work
+
+You may create and distribute a Larger Work under terms of Your choice,
+provided that You also comply with the requirements of this License for
+the Covered Software. If the Larger Work is a combination of Covered
+Software with a work governed by one or more Secondary Licenses, and the
+Covered Software is not Incompatible With Secondary Licenses, this
+License permits You to additionally distribute such Covered Software
+under the terms of such Secondary License(s), so that the recipient of
+the Larger Work may, at their option, further distribute the Covered
+Software under the terms of either this License or such Secondary
+License(s).
+
+3.4. Notices
+
+You may not remove or alter the substance of any license notices
+(including copyright notices, patent notices, disclaimers of warranty,
+or limitations of liability) contained within the Source Code Form of
+the Covered Software, except that You may alter any license notices to
+the extent required to remedy known factual inaccuracies.
+
+3.5. Application of Additional Terms
+
+You may choose to offer, and to charge a fee for, warranty, support,
+indemnity or liability obligations to one or more recipients of Covered
+Software. However, You may do so only on Your own behalf, and not on
+behalf of any Contributor. You must make it absolutely clear that any
+such warranty, support, indemnity, or liability obligation is offered by
+You alone, and You hereby agree to indemnify every Contributor for any
+liability incurred by such Contributor as a result of warranty, support,
+indemnity or liability terms You offer. You may include additional
+disclaimers of warranty and limitations of liability specific to any
+jurisdiction.
+
+4. Inability to Comply Due to Statute or Regulation
+---------------------------------------------------
+
+If it is impossible for You to comply with any of the terms of this
+License with respect to some or all of the Covered Software due to
+statute, judicial order, or regulation then You must: (a) comply with
+the terms of this License to the maximum extent possible; and (b)
+describe the limitations and the code they affect. Such description must
+be placed in a text file included with all distributions of the Covered
+Software under this License. Except to the extent prohibited by statute
+or regulation, such description must be sufficiently detailed for a
+recipient of ordinary skill to be able to understand it.
+
+5. Termination
+--------------
+
+5.1. The rights granted under this License will terminate automatically
+if You fail to comply with any of its terms. However, if You become
+compliant, then the rights granted under this License from a particular
+Contributor are reinstated (a) provisionally, unless and until such
+Contributor explicitly and finally terminates Your grants, and (b) on an
+ongoing basis, if such Contributor fails to notify You of the
+non-compliance by some reasonable means prior to 60 days after You have
+come back into compliance. Moreover, Your grants from a particular
+Contributor are reinstated on an ongoing basis if such Contributor
+notifies You of the non-compliance by some reasonable means, this is the
+first time You have received notice of non-compliance with this License
+from such Contributor, and You become compliant prior to 30 days after
+Your receipt of the notice.
+
+5.2. If You initiate litigation against any entity by asserting a patent
+infringement claim (excluding declaratory judgment actions,
+counter-claims, and cross-claims) alleging that a Contributor Version
+directly or indirectly infringes any patent, then the rights granted to
+You by any and all Contributors for the Covered Software under Section
+2.1 of this License shall terminate.
+
+5.3. In the event of termination under Sections 5.1 or 5.2 above, all
+end user license agreements (excluding distributors and resellers) which
+have been validly granted by You or Your distributors under this License
+prior to termination shall survive termination.
+
+************************************************************************
+* *
+* 6. Disclaimer of Warranty *
+* ------------------------- *
+* *
+* Covered Software is provided under this License on an "as is" *
+* basis, without warranty of any kind, either expressed, implied, or *
+* statutory, including, without limitation, warranties that the *
+* Covered Software is free of defects, merchantable, fit for a *
+* particular purpose or non-infringing. The entire risk as to the *
+* quality and performance of the Covered Software is with You. *
+* Should any Covered Software prove defective in any respect, You *
+* (not any Contributor) assume the cost of any necessary servicing, *
+* repair, or correction. This disclaimer of warranty constitutes an *
+* essential part of this License. No use of any Covered Software is *
+* authorized under this License except under this disclaimer. *
+* *
+************************************************************************
+
+************************************************************************
+* *
+* 7. Limitation of Liability *
+* -------------------------- *
+* *
+* Under no circumstances and under no legal theory, whether tort *
+* (including negligence), contract, or otherwise, shall any *
+* Contributor, or anyone who distributes Covered Software as *
+* permitted above, be liable to You for any direct, indirect, *
+* special, incidental, or consequential damages of any character *
+* including, without limitation, damages for lost profits, loss of *
+* goodwill, work stoppage, computer failure or malfunction, or any *
+* and all other commercial damages or losses, even if such party *
+* shall have been informed of the possibility of such damages. This *
+* limitation of liability shall not apply to liability for death or *
+* personal injury resulting from such party's negligence to the *
+* extent applicable law prohibits such limitation. Some *
+* jurisdictions do not allow the exclusion or limitation of *
+* incidental or consequential damages, so this exclusion and *
+* limitation may not apply to You. *
+* *
+************************************************************************
+
+8. Litigation
+-------------
+
+Any litigation relating to this License may be brought only in the
+courts of a jurisdiction where the defendant maintains its principal
+place of business and such litigation shall be governed by laws of that
+jurisdiction, without reference to its conflict-of-law provisions.
+Nothing in this Section shall prevent a party's ability to bring
+cross-claims or counter-claims.
+
+9. Miscellaneous
+----------------
+
+This License represents the complete agreement concerning the subject
+matter hereof. If any provision of this License is held to be
+unenforceable, such provision shall be reformed only to the extent
+necessary to make it enforceable. Any law or regulation which provides
+that the language of a contract shall be construed against the drafter
+shall not be used to construe this License against a Contributor.
+
+10. Versions of the License
+---------------------------
+
+10.1. New Versions
+
+Mozilla Foundation is the license steward. Except as provided in Section
+10.3, no one other than the license steward has the right to modify or
+publish new versions of this License. Each version will be given a
+distinguishing version number.
+
+10.2. Effect of New Versions
+
+You may distribute the Covered Software under the terms of the version
+of the License under which You originally received the Covered Software,
+or under the terms of any subsequent version published by the license
+steward.
+
+10.3. Modified Versions
+
+If you create software not governed by this License, and you want to
+create a new license for such software, you may create and use a
+modified version of this License if you rename the license and remove
+any references to the name of the license steward (except to note that
+such modified license differs from this License).
+
+10.4. Distributing Source Code Form that is Incompatible With Secondary
+Licenses
+
+If You choose to distribute Source Code Form that is Incompatible With
+Secondary Licenses under the terms of this version of the License, the
+notice described in Exhibit B of this License must be attached.
+
+Exhibit A - Source Code Form License Notice
+-------------------------------------------
+
+ This Source Code Form is subject to the terms of the Mozilla Public
+ License, v. 2.0. If a copy of the MPL was not distributed with this
+ file, You can obtain one at https://mozilla.org/MPL/2.0/.
+
+If it is not possible or desirable to put the notice in a particular
+file, then You may include the notice in a location (such as a LICENSE
+file in a relevant directory) where a recipient would be likely to look
+for such a notice.
+
+You may add additional accurate notices of copyright ownership.
+
+Exhibit B - "Incompatible With Secondary Licenses" Notice
+---------------------------------------------------------
+
+ This Source Code Form is "Incompatible With Secondary Licenses", as
+ defined by the Mozilla Public License, v. 2.0.
diff --git a/Makefile b/Makefile
new file mode 100644
index 0000000..2db5bff
--- /dev/null
+++ b/Makefile
@@ -0,0 +1,19 @@
+.PHONY: format
+format:
+ fourmolu -i app/ src/
+
+.PHONY: lint
+lint:
+ find {app,src}/ | entr -c hlint src/ app/
+
+.PHONY: run
+run:
+ find {app,src}/ | entr -cr cabal new-run uncron -- "* * * * *"
+
+.PHONY: build
+build:
+ find {app,src}/ | entr -c cabal new-build uncron
+
+.PHONY: repl
+repl:
+ ghcid --allow-eval --lint --command "cabal repl uncron"
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..93e3f58
--- /dev/null
+++ b/README.md
@@ -0,0 +1,19 @@
+# uncron
+
+Convert cron schedules into a human-readable form:
+
+ > uncron "0 6 1 * *"
+ At 06:00, on the 1st of every month
+ > uncron "0 * 2 1-4 *"
+ At the top of every hour, on the 2nd from January to April
+ > uncron "10,30,50 * 1 1-6/3 *"
+ At minutes 10, 30 and 50 of every hour, on the 1st of every 3 months from January to June
+
+## Building & Running
+
+The recommended solution is to use `nix`:
+
+- Use `nix profile install http://git.k.mulga.net/julien/uncron/snapshot/uncron-main.tar.gz` to install uncron,
+- Use `nix run http://git.k.mulga.net/julien/uncron/snapshot/uncron-main.tar.gz` to build and run the binary directly.
+
+If you have `cabal` installed, use `cabal build` or `cabal install`.
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..0b1f81e
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,23 @@
+module Main (main) where
+
+import Control.Arrow (left)
+import qualified Cron
+import Intro
+import System.Environment (getArgs)
+import System.IO (getLine)
+
+main :: IO ()
+main = do
+ cron <- getCron
+ putStrLn . showOrErr $ Cron.toProse <$> (Cron.parse =<< cron)
+
+getCron :: IO (Either String String)
+getCron = do
+ args <- getArgs
+ case args of
+ [] -> Right <$> getLine
+ [x] -> pure $ Right x
+ xs -> pure $ Left ("Too many inputs or invalid option: " ++ show xs)
+
+showOrErr :: Either String String -> String
+showOrErr = either id id . left ("Error. " ++)
diff --git a/flake.lock b/flake.lock
new file mode 100644
index 0000000..e2626d9
--- /dev/null
+++ b/flake.lock
@@ -0,0 +1,80 @@
+{
+ "nodes": {
+ "flake-parts": {
+ "inputs": {
+ "nixpkgs-lib": "nixpkgs-lib"
+ },
+ "locked": {
+ "lastModified": 1709336216,
+ "narHash": "sha256-Dt/wOWeW6Sqm11Yh+2+t0dfEWxoMxGBvv3JpIocFl9E=",
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "rev": "f7b3c975cf067e56e7cda6cb098ebe3fb4d74ca2",
+ "type": "github"
+ },
+ "original": {
+ "owner": "hercules-ci",
+ "repo": "flake-parts",
+ "type": "github"
+ }
+ },
+ "haskell-flake": {
+ "locked": {
+ "lastModified": 1711568381,
+ "narHash": "sha256-IvVqTNcbSNh6XgyS4ikBkQio1eMmLvKTl3vAvkVPn+0=",
+ "owner": "srid",
+ "repo": "haskell-flake",
+ "rev": "5dcb739e9cc4e0edf5267de665fa7a905a543baa",
+ "type": "github"
+ },
+ "original": {
+ "owner": "srid",
+ "repo": "haskell-flake",
+ "type": "github"
+ }
+ },
+ "nixpkgs": {
+ "locked": {
+ "lastModified": 1711593151,
+ "narHash": "sha256-/9NCoPI7fqJIN8viONsY9X0fAeq8jc3GslFCO0ky6TQ=",
+ "owner": "nixos",
+ "repo": "nixpkgs",
+ "rev": "bb2b73df7bcfbd2dd55ff39b944d70547d53c267",
+ "type": "github"
+ },
+ "original": {
+ "owner": "nixos",
+ "ref": "nixpkgs-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "nixpkgs-lib": {
+ "locked": {
+ "dir": "lib",
+ "lastModified": 1709237383,
+ "narHash": "sha256-cy6ArO4k5qTx+l5o+0mL9f5fa86tYUX3ozE1S+Txlds=",
+ "owner": "NixOS",
+ "repo": "nixpkgs",
+ "rev": "1536926ef5621b09bba54035ae2bb6d806d72ac8",
+ "type": "github"
+ },
+ "original": {
+ "dir": "lib",
+ "owner": "NixOS",
+ "ref": "nixos-unstable",
+ "repo": "nixpkgs",
+ "type": "github"
+ }
+ },
+ "root": {
+ "inputs": {
+ "flake-parts": "flake-parts",
+ "haskell-flake": "haskell-flake",
+ "nixpkgs": "nixpkgs"
+ }
+ }
+ },
+ "root": "root",
+ "version": 7
+}
diff --git a/flake.nix b/flake.nix
new file mode 100644
index 0000000..cc733a1
--- /dev/null
+++ b/flake.nix
@@ -0,0 +1,25 @@
+{
+ inputs = {
+ nixpkgs.url = "github:nixos/nixpkgs/nixpkgs-unstable";
+ flake-parts.url = "github:hercules-ci/flake-parts";
+ haskell-flake.url = "github:srid/haskell-flake";
+ };
+ outputs = inputs@{ self, nixpkgs, flake-parts, ... }:
+ flake-parts.lib.mkFlake { inherit inputs; } {
+ systems = nixpkgs.lib.systems.flakeExposed;
+ imports = [ inputs.haskell-flake.flakeModule ];
+
+ perSystem = { self', pkgs, ... }: {
+
+ haskellProjects.default = {
+ devShell = {
+ enable = true;
+ tools = hp: { fourmolu = hp.fourmolu; ghcid = hp.ghcid; };
+ hlsCheck.enable = true;
+ };
+ };
+
+ packages.default = self'.packages.uncron;
+ };
+ };
+}
diff --git a/fourmolu.yaml b/fourmolu.yaml
new file mode 100644
index 0000000..ce46be3
--- /dev/null
+++ b/fourmolu.yaml
@@ -0,0 +1,5 @@
+column-limit: 100
+comma-style: leading
+import-export-style: leading
+indentation: 2
+respectful: false
diff --git a/src/Common.hs b/src/Common.hs
new file mode 100644
index 0000000..a196527
--- /dev/null
+++ b/src/Common.hs
@@ -0,0 +1,71 @@
+module Common ((?), (?:), fromDigits, leftPad, listToProse, asOrdinal, showDayOfWeek, showMonth) where
+
+import Data.List (replicate, take)
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Data.Maybe (fromMaybe)
+import Intro
+
+fromDigits :: [Int] -> Int
+fromDigits = foldl (\n d -> 10 * n + d) 0
+
+leftPad :: Int -> a -> [a] -> [a]
+leftPad m x xs = replicate (m - length ys) x ++ ys
+ where
+ ys = take m xs
+
+(?) :: Bool -> a -> a -> a
+(?) True x _ = x
+(?) False _ y = y
+
+infixr 1 ?
+
+(?:) :: Maybe a -> a -> a
+maybeA ?: b = fromMaybe b maybeA
+
+infixr 0 ?:
+
+listToProse :: NonEmpty String -> String
+listToProse (x :| xs) = mconcat . reverse $ proseJoin xs [x]
+ where
+ proseJoin [] ys = ys
+ proseJoin [y] [] = [y]
+ proseJoin [y] zs = y : " and " : zs
+ proseJoin (y : ys) zs = proseJoin ys (y : ", " : zs)
+
+asOrdinal :: Int -> String
+asOrdinal 11 = "11th"
+asOrdinal 12 = "12th"
+asOrdinal 13 = "13th"
+asOrdinal n =
+ show n ++ case n `mod` 10 of
+ 1 -> "st"
+ 2 -> "nd"
+ 3 -> "rd"
+ _ -> "th"
+
+showDayOfWeek :: Int -> Maybe String
+showDayOfWeek = \case
+ 0 -> Just "Sunday"
+ 1 -> Just "Monday"
+ 2 -> Just "Tuesday"
+ 3 -> Just "Wednesday"
+ 4 -> Just "Thursday"
+ 5 -> Just "Friday"
+ 6 -> Just "Saturday"
+ _ -> Nothing
+
+showMonth :: Int -> Maybe String
+showMonth = \case
+ 1 -> Just "January"
+ 2 -> Just "February"
+ 3 -> Just "March"
+ 4 -> Just "April"
+ 5 -> Just "May"
+ 6 -> Just "June"
+ 7 -> Just "July"
+ 8 -> Just "August"
+ 9 -> Just "September"
+ 10 -> Just "October"
+ 11 -> Just "November"
+ 12 -> Just "December"
+ _ -> Nothing
diff --git a/src/Cron.hs b/src/Cron.hs
new file mode 100644
index 0000000..3cadac9
--- /dev/null
+++ b/src/Cron.hs
@@ -0,0 +1,138 @@
+module Cron (parse, toProse) where
+
+import Common (asOrdinal, leftPad, listToProse, showDayOfWeek, showMonth, (?:))
+import qualified Cron.Expr as E
+import qualified Cron.Schedule as S
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Intro
+
+parse :: String -> Either String S.Schedule
+parse s = case words s of
+ [mn, h, dom, m, dow] -> S.fromParts mn h dom m dow
+ xs ->
+ Left
+ $ "Invalid cron "
+ ++ s
+ ++ ": not enough qualifiers, expecting 5 but only got "
+ ++ (show . length) xs
+
+toProse :: S.Schedule -> String
+toProse s =
+ mconcat
+ [ proseTime s.minute s.hour
+ , ", "
+ , proseDate s.dayOfMonth s.month s.dayOfWeek
+ ]
+
+proseDate :: E.Expr -> E.Expr -> E.Expr -> String
+proseDate dom mt dow = case (dom, mt, dow) of
+ (E.Every, E.Every, E.Every) -> "daily"
+ (E.Every, _, E.Every) -> "daily " ++ proseMonth mt
+ (E.Every, E.Every, E.Multi ns) -> "every " ++ listToProse (dayOfWeek <$> ns)
+ (E.Every, E.Every, E.Range _ _) -> proseDayOfWeek dow
+ (E.Every, _, E.Multi ns) -> "every " ++ listToProse (dayOfWeek <$> ns) ++ " " ++ proseMonth mt
+ (_, _, _) -> mconcat [proseDayOfMonth dom, " ", proseMonth mt, " ", proseDayOfWeek dow]
+ where
+ dayOfWeek m = showDayOfWeek m ?: "?"
+
+proseDayOfWeek :: E.Expr -> String
+proseDayOfWeek = \case
+ E.Every -> ""
+ E.Multi ns -> "on " ++ listToProse (dayOfWeek <$> ns)
+ E.Range n m -> mconcat ["from ", dayOfWeek n, " to ", dayOfWeek m]
+ E.Step E.StepLEvery 1 -> ""
+ E.Step E.StepLEvery n -> mconcat ["every ", show n, " days of the week"]
+ E.Step (E.StepLRange n m) j ->
+ mconcat
+ [ "every "
+ , show j
+ , " days of the week from "
+ , dayOfWeek n
+ , " to "
+ , dayOfWeek m
+ ]
+ where
+ dayOfWeek m = showDayOfWeek m ?: "?"
+
+proseMonth :: E.Expr -> String
+proseMonth = \case
+ E.Every -> "of every month"
+ E.Multi ns -> "of " ++ listToProse (month <$> ns)
+ E.Range n m -> mconcat ["from ", month n, " to ", month m]
+ E.Step E.StepLEvery 1 -> "of every month"
+ E.Step E.StepLEvery n -> mconcat ["of every ", show n, " months"]
+ E.Step (E.StepLRange n m) j ->
+ mconcat
+ [ "of every "
+ , show j
+ , " months from "
+ , month n
+ , " to "
+ , month m
+ ]
+ where
+ month m = showMonth m ?: "?"
+
+proseDayOfMonth :: E.Expr -> String
+proseDayOfMonth = \case
+ E.Every -> "daily"
+ E.Multi ns -> "on the " ++ listToProse (asOrdinal <$> ns)
+ E.Range n m -> mconcat ["daily from the ", asOrdinal n, " to the ", asOrdinal m]
+ E.Step E.StepLEvery 1 -> "daily"
+ E.Step E.StepLEvery n -> mconcat ["every ", show n, " days"]
+ E.Step (E.StepLRange n m) j ->
+ mconcat
+ [ "every "
+ , show j
+ , " days from the "
+ , asOrdinal n
+ , " to the "
+ , asOrdinal m
+ ]
+
+proseTime :: E.Expr -> E.Expr -> String
+proseTime mn h = case (mn, h) of
+ (E.Multi (0 :| []), E.Every) -> "At the top of every hour"
+ (E.Multi (0 :| []), E.Step E.StepLEvery 1) -> "At the top of every hour"
+ (E.Multi (n :| []), E.Multi (m :| [])) -> mconcat ["At ", leftPad 2 '0' $ show m, ":", leftPad 2 '0' $ show n]
+ (E.Multi (0 :| []), E.Multi ns) -> mconcat ["At the top of the ", listToProse (asOrdinal <$> ns), " hours"]
+ (_, E.Every) -> mconcat [proseMinute mn, " of every hour"]
+ (_, E.Step E.StepLEvery 1) -> mconcat [proseMinute mn, " of every hour"]
+ (_, _) -> mconcat [proseMinute mn, " ", proseHour h]
+
+proseHour :: E.Expr -> String
+proseHour = \case
+ E.Every -> "every hour"
+ E.Multi (n :| []) -> mconcat ["at hour ", leftPad 2 '0' $ show n]
+ E.Multi ns -> "at hours " ++ listToProse (show <$> ns)
+ E.Range n m -> mconcat ["every hour from ", leftPad 2 '0' $ show n, " to ", leftPad 2 '0' $ show m]
+ E.Step E.StepLEvery 1 -> "every hour"
+ E.Step E.StepLEvery n -> mconcat ["every ", show n, " hours"]
+ E.Step (E.StepLRange n m) j ->
+ mconcat
+ [ "every "
+ , show j
+ , " hours from "
+ , show n
+ , " to "
+ , show m
+ ]
+
+proseMinute :: E.Expr -> String
+proseMinute = \case
+ E.Every -> "Every minute"
+ E.Multi (n :| []) -> mconcat ["At minute ", leftPad 2 '0' $ show n]
+ E.Multi ns -> "At minutes " ++ listToProse (show <$> ns)
+ E.Range n m -> mconcat ["Every minute from ", leftPad 2 '0' $ show n, " to ", leftPad 2 '0' $ show m]
+ E.Step E.StepLEvery 1 -> "Every minute"
+ E.Step E.StepLEvery n -> mconcat ["every ", show n, " minutes"]
+ E.Step (E.StepLRange n m) j ->
+ mconcat
+ [ "every "
+ , show j
+ , " minutes from the "
+ , asOrdinal n
+ , " minute to the "
+ , asOrdinal m
+ , " minute"
+ ]
diff --git a/src/Cron/Expr.hs b/src/Cron/Expr.hs
new file mode 100644
index 0000000..a6cb4ca
--- /dev/null
+++ b/src/Cron/Expr.hs
@@ -0,0 +1,21 @@
+module Cron.Expr (Expr (..), StepLExpr (..), showExpr) where
+
+import Data.List.NonEmpty (NonEmpty, intersperse)
+import Data.Semigroup (sconcat)
+import Intro
+
+data Expr = Every | Multi (NonEmpty Int) | Range Int Int | Step StepLExpr Int deriving (Show)
+
+data StepLExpr = StepLEvery | StepLRange Int Int deriving (Show)
+
+showExpr :: Expr -> String
+showExpr = \case
+ Every -> "*"
+ Multi ns -> sconcat $ intersperse "," (fmap show ns)
+ Range n m -> mconcat [show n, "-", show m]
+ Step n m -> mconcat [showStepLExpr n, "/", show m]
+
+showStepLExpr :: StepLExpr -> String
+showStepLExpr = \case
+ StepLEvery -> "*"
+ StepLRange n m -> mconcat [show n, "-", show m]
diff --git a/src/Cron/Parser.hs b/src/Cron/Parser.hs
new file mode 100644
index 0000000..304a1e3
--- /dev/null
+++ b/src/Cron/Parser.hs
@@ -0,0 +1,88 @@
+module Cron.Parser (parse) where
+
+import Common (fromDigits)
+import Control.Applicative (Alternative, empty, liftA2, many, some, (*>), (<$), (<|>))
+import Control.Arrow (first, (>>>))
+import qualified Cron.Expr as E
+import Data.List.NonEmpty (NonEmpty ((:|)))
+import Intro
+import Text.Read (readMaybe)
+
+type Token = Char
+
+newtype Parser a = Parser {runParser :: [Token] -> Maybe (a, [Token])}
+
+instance Functor Parser where
+ fmap f (Parser p) = Parser (p >>> fmap (first f))
+
+instance Applicative Parser where
+ pure a = Parser (\input -> Just (a, input))
+ Parser pF <*> Parser pA = Parser $ \input -> do
+ (f, rest) <- pF input
+ (a, s) <- pA rest
+ pure (f a, s)
+
+instance Alternative Parser where
+ empty = Parser (const Nothing)
+ Parser pA <|> Parser pB = Parser $ \input -> case (pA input, pB input) of
+ (Nothing, expr) -> expr
+ (expr, _) -> expr
+
+match :: (Token -> Bool) -> Parser Token
+match p = Parser $ \case
+ t : ts | p t -> Just (t, ts)
+ _ -> Nothing
+
+token :: Token -> Parser Token
+token = (==) >>> match
+
+read :: (Token -> Maybe a) -> Parser a
+read f = Parser $ \case
+ t : ts -> case f t of
+ Just x -> Just (x, ts)
+ _ -> Nothing
+ _ -> Nothing
+
+sepBy1 :: Parser a -> Parser b -> Parser (NonEmpty a)
+sepBy1 p s = liftA2 (:|) p (many (s *> p))
+
+pair :: Parser a -> Parser b -> Parser c -> Parser (a, b)
+pair p1 p2 s = liftA2 (,) p1 (s *> p2)
+
+digit :: Parser Int
+digit = read $ \case
+ x | x `elem` ['0' .. '9'] -> readMaybe [x] :: Maybe Int
+ _ -> Nothing
+
+number :: Parser Int
+number = fromDigits <$> some digit
+
+--
+-- Cron Exprs
+--
+
+cRange :: Parser E.Expr
+cRange = uncurry E.Range <$> pair number number (token '-')
+
+cStepL :: Parser E.StepLExpr
+cStepL =
+ (E.StepLEvery <$ token '*')
+ <|> (uncurry E.StepLRange <$> pair number number (token '-'))
+
+cStep :: Parser E.Expr
+cStep = uncurry E.Step <$> pair cStepL number (token '/')
+
+cMulti :: Parser E.Expr
+cMulti = E.Multi <$> sepBy1 number (token ',')
+
+cEvery :: Parser E.Expr
+cEvery = E.Every <$ token '*'
+
+cExpr :: Parser E.Expr
+cExpr = cStep <|> cEvery <|> cRange <|> cMulti
+
+parse :: [Token] -> Either String E.Expr
+parse xs = case runParser cExpr xs of
+ Nothing -> Left "Invalid cron expression"
+ Just (expr, []) -> Right expr
+ Just (_, rest) -> Left ("Invalid cron expression. Couldn't parse `" ++ rest ++ "`")
diff --git a/src/Cron/Schedule.hs b/src/Cron/Schedule.hs
new file mode 100644
index 0000000..2ea56ab
--- /dev/null
+++ b/src/Cron/Schedule.hs
@@ -0,0 +1,72 @@
+module Cron.Schedule (Schedule (..), fromParts) where
+
+import Common ((?))
+import qualified Cron.Expr as E
+import qualified Cron.Parser as P
+import Intro
+
+data Schedule = Schedule
+ { minute :: E.Expr
+ , hour :: E.Expr
+ , dayOfMonth :: E.Expr
+ , month :: E.Expr
+ , dayOfWeek :: E.Expr
+ }
+ deriving (Show)
+
+fromParts :: String -> String -> String -> String -> String -> Either String Schedule
+fromParts mn h d m wd =
+ Schedule
+ <$> parseMinute mn
+ <*> parseHour h
+ <*> parseDayOfMonth d
+ <*> parseMonth m
+ <*> parseDayOfWeek wd
+
+parseMinute :: String -> Either String E.Expr
+parseMinute s = P.parse s >>= validateMinute
+
+parseHour :: String -> Either String E.Expr
+parseHour s = P.parse s >>= validateHour
+
+parseDayOfMonth :: String -> Either String E.Expr
+parseDayOfMonth s = P.parse s >>= validateDayOfMonth
+
+parseMonth :: String -> Either String E.Expr
+parseMonth s = P.parse s >>= validateMonth
+
+parseDayOfWeek :: String -> Either String E.Expr
+parseDayOfWeek s = P.parse s >>= validateDayOfWeek
+
+validateMinute :: E.Expr -> Either String E.Expr
+validateMinute expr = validateExpr expr >>= flip validateInRange [0 .. 59]
+
+validateHour :: E.Expr -> Either String E.Expr
+validateHour expr = validateExpr expr >>= flip validateInRange [0 .. 23]
+
+validateDayOfMonth :: E.Expr -> Either String E.Expr
+validateDayOfMonth expr = validateExpr expr >>= flip validateInRange [1 .. 31]
+
+validateMonth :: E.Expr -> Either String E.Expr
+validateMonth expr = validateExpr expr >>= flip validateInRange [1 .. 12]
+
+validateDayOfWeek :: E.Expr -> Either String E.Expr
+validateDayOfWeek expr = validateExpr expr >>= flip validateInRange [0 .. 6]
+
+validateExpr :: E.Expr -> Either String E.Expr
+validateExpr expr = validate expr $ \case
+ E.Range n m -> n < m
+ _ -> True
+
+validateInRange :: E.Expr -> [Int] -> Either String E.Expr
+validateInRange expr range = validate expr $ \case
+ E.Multi ns -> all inRange ns
+ E.Range n m -> inRange n && inRange m
+ E.Step _ _ -> True
+ E.Every -> True
+ where
+ inRange :: Int -> Bool
+ inRange = flip elem range
+
+validate :: E.Expr -> (E.Expr -> Bool) -> Either String E.Expr
+validate expr p = p expr ? Right expr $ Left ("Invalid cron expression " ++ E.showExpr expr)
diff --git a/src/Intro.hs b/src/Intro.hs
new file mode 100644
index 0000000..b6c76b7
--- /dev/null
+++ b/src/Intro.hs
@@ -0,0 +1,64 @@
+module Intro
+ ( ($)
+ , (&&)
+ , (*)
+ , (+)
+ , (++)
+ , (-)
+ , (.)
+ , (/=)
+ , (<$>)
+ , (<*>)
+ , (<)
+ , (=<<)
+ , (==)
+ , (>>=)
+ , (||)
+ , Applicative
+ , Bool (False, True)
+ , Char
+ , Eq
+ , IO
+ , Int
+ , Maybe (Just, Nothing)
+ , Either (Left, Right)
+ , Functor
+ , Show
+ , String
+ , all
+ , break
+ , concat
+ , const
+ , curry
+ , dropWhile
+ , either
+ , elem
+ , filter
+ , flip
+ , foldl
+ , foldr
+ , fst
+ , head
+ , init
+ , last
+ , length
+ , fmap
+ , id
+ , mconcat
+ , mod
+ , not
+ , otherwise
+ , pure
+ , putStrLn
+ , reverse
+ , show
+ , snd
+ , uncurry
+ , words
+ , zip
+ , zipWith
+ , null
+ )
+where
+
+import Prelude
diff --git a/uncron.cabal b/uncron.cabal
new file mode 100644
index 0000000..cbeec89
--- /dev/null
+++ b/uncron.cabal
@@ -0,0 +1,65 @@
+cabal-version: 3.0
+name: uncron
+version: 0.1.0.0
+license: MPL-2.0
+license-file: COPYING
+author: evuez
+maintainer: julien@mulga.net
+build-type: Simple
+
+common warnings
+ ghc-options:
+ -Wall
+ -- -Werror
+ -- -Wall-missed-specialisations
+ -Wcpp-undef
+ -Widentities
+ -Wimplicit-prelude
+ -Wincomplete-record-updates
+ -Wincomplete-uni-patterns
+ -Wmissed-specialisations
+ -- -Wmissing-deriving-strategies
+ -Wmissing-export-lists
+ -Wmissing-exported-signatures
+ -Wmissing-home-modules
+ -- -Wmissing-import-lists
+ -Wmissing-local-signatures
+ -Wmonomorphism-restriction
+ -Wpartial-fields
+ -Wredundant-constraints
+ -Wunused-packages
+ -Wunused-type-patterns
+
+common exe
+ default-extensions:
+ NoImplicitPrelude
+ DuplicateRecordFields
+ OverloadedRecordDot
+ LambdaCase
+ other-modules:
+ Intro
+ Common
+ Cron
+ Cron.Expr
+ Cron.Schedule
+ Cron.Parser
+ build-depends: base >=4.17.2.1
+ hs-source-dirs: app,src
+ default-language: Haskell2010
+
+executable uncron
+ import: warnings
+ import: exe
+ main-is: Main.hs
+ ghc-options:
+ -fno-expose-internal-symbols
+ -O2
+
+executable uncron-dyn
+ import: warnings
+ import: exe
+ main-is: Main.hs
+ ghc-options:
+ -fno-expose-internal-symbols
+ -O2
+ -dynamic