Initial version0.1.0

7 files changed, 259 insertions, 0 deletions

diff --git a/CHANGELOG.md b/CHANGELOG.md
new file mode 100644
index 0000000..38e356e
--- /dev/null
+++ b/CHANGELOG.md
@@ -0,0 +1,3 @@
+## 0.1.0 -- 2019-08-31
+
+* First version. Can print days to delete or to keep. Supports only exponential intervals.
diff --git a/README.md b/README.md
new file mode 100644
index 0000000..f33d831
--- /dev/null
+++ b/README.md
@@ -0,0 +1,76 @@
+About
+=====
+
+`frotate` stands for "functional rotate", whatever.
+This is an evolution of the [log2rotate's ideas](http://jekor.com/log2rotate).
+See also [pylog2rotate](https://github.com/avian2/pylog2rotate).
+
+`frotate` is designed to rotate backups with any balance between retention
+and space usage.  Instead of rotating backups using some familiar method such
+as daily, weekly, monthly, and yearly periods, it rotates backups using any
+periods. Thus "functional".
+
+The idea is simple, the rotation schedule is determined by an integer function.
+This function gives us a period (number) of days when we must encounter at
+least one backup or whatever we are rotating. When we use an exponential
+function, the scheme is similar to the radioactive decay law. When the
+funtion is simply a constant 1, we don't rotate anything and retain all
+the backups. If it is 2, we retain each second backup.  With some trivial
+function we can achieve a well-known dayly-weekly-monthly-yearly scheme.
+
+The `frotate` command line utility implements only exponential periods with
+arbitrary base (ensure it is > 1, or have fun otherwise).
+
+
+Usage
+=====
+
+Note that when neither `--keep` nor `--delete` option is given, the utility
+prints all intervals with all days in them _to standard error_. In production
+you will need to specify `--keep` or `--delete` explicitly.
+
+```
+Usage: frotate ([-k|--keep] | [-d|--delete]) [-b|--base BASE] DAY...
+
+Available options:
+  -k,--keep                Print days to keep
+  -d,--delete              Print days to delete
+  -b,--base BASE           Base of the exponent (default: 1.1)
+  -h,--help                Show this help text
+
+```
+
+
+Example
+=======
+
+Different modes with the same days:
+
+```
+$ frotate --base 2 2019-08-31 2019-08-30 2019-08-29 2019-08-28 2019-08-27 2019-08-26 2019-08-25 2019-08-24
+2019-08-31
+2019-08-30 2019-08-29
+2019-08-28 2019-08-27 2019-08-26 2019-08-25
+2019-08-24
+
+$ frotate --keep --base 2 2019-08-31 2019-08-30 2019-08-29 2019-08-28 2019-08-27 2019-08-26 2019-08-25 2019-08-24
+2019-08-31 2019-08-30 2019-08-28 2019-08-24
+
+$ frotate --delete --base 2 2019-08-31 2019-08-30 2019-08-29 2019-08-28 2019-08-27 2019-08-26 2019-08-25 2019-08-24
+2019-08-29 2019-08-27 2019-08-26 2019-08-25
+```
+
+More or less realistic example when we keep some backups and get new ones, but not every day:
+
+```
+$ frotate --keep --base 2 2019-09-01 2019-08-31 2019-08-30 2019-08-28 2019-08-24
+2019-09-01 2019-08-31 2019-08-28 2019-08-24
+
+$ frotate --keep --base 2 2019-09-05 2019-09-01 2019-08-31 2019-08-28 2019-08-24
+2019-09-05 2019-09-01 2019-08-28
+
+$ frotate --keep --base 2 2019-09-06 2019-09-05 2019-09-01 2019-08-28
+2019-09-06 2019-09-05 2019-09-01 2019-08-28
+
+```
+
diff --git a/Setup.hs b/Setup.hs
new file mode 100644
index 0000000..9a994af
--- /dev/null
+++ b/Setup.hs
@@ -0,0 +1,2 @@
+import Distribution.Simple
+main = defaultMain
diff --git a/frotate.cabal b/frotate.cabal
new file mode 100644
index 0000000..d93a86e
--- /dev/null
+++ b/frotate.cabal
@@ -0,0 +1,34 @@
+cabal-version: >=1.10
+name: frotate
+version: 0.1.0
+license: PublicDomain
+maintainer: pashev.igor@gmail.com
+author: Igor Pashev
+synopsis: Advanced rotation of backups and other things
+category: Math, System
+build-type: Simple
+extra-source-files:
+    CHANGELOG.md
+    README.md
+
+source-repository head
+    type: git
+    location: https://github.com/ip1981/frotate.git
+
+executable frotate
+    main-is: Main.hs
+    hs-source-dirs: src
+    other-modules:
+      Lib
+    default-language: Haskell2010
+    build-depends:
+        base < 50,
+        time -any,
+        optparse-applicative -any
+
+test-suite doctests
+    main-is: doctests.hs
+    hs-source-dirs: test
+    default-language: Haskell2010
+    type: exitcode-stdio-1.0
+    build-depends: base, doctest >= 0.8
diff --git a/src/Lib.hs b/src/Lib.hs
new file mode 100644
index 0000000..a7c64c6
--- /dev/null
+++ b/src/Lib.hs
@@ -0,0 +1,71 @@
+module Lib
+  ( partition
+  , partitionDays
+  ) where
+
+import Data.List (group, sortOn, span)
+import Data.Ord (Down(Down))
+
+import Data.Time.Calendar (Day, addDays, diffDays)
+
+{- | Split a strictly increasing list of integer numbers into intervals
+such that the width of each interval is defined by a positive, weakly increasing
+function of the interval's serial number (1, 2, 3, ...).
+Some of the intervals may be empty.
+
+>>> partition (const 1) [1,2,3,4,5,6,7,8,9]
+[[1],[2],[3],[4],[5],[6],[7],[8],[9]]
+
+>>> partition (const 1) [1,3,5,7,9,11,13,15,17,19]
+[[1],[],[3],[],[5],[],[7],[],[9],[],[11],[],[13],[],[15],[],[17],[],[19]]
+
+>>> partition (const 2) $ take 10 [1,3 ..]
+[[1],[3],[5],[7],[9],[11],[13],[15],[17],[19]]
+
+>>> partition (\n -> floor (2^n)) $ take 20 [1, 2 ..]
+[[1,2],[3,4,5,6],[7,8,9,10,11,12,13,14],[15,16,17,18,19,20]]
+
+>>> partition (\n -> floor (2^n)) [2,5,14,20]
+[[2],[5],[14],[20]]
+
+>>> partition (\n -> floor (2^n)) $ take 20 [10,20 ..]
+[[10],[],[20],[30],[40,50,60,70],[80,90,100,110,120,130],[140,150,160,170,180,190,200]]
+
+-}
+partition ::
+     (Ord t, Num t)
+  => (Int -> t) -- ^ positive, weakly increasing function of a natural number
+  -> [t] -- ^ strictly increasing, non-empty list
+  -> [[t]]
+partition f l = go 1 (head l) l
+  where
+    go _ _ [] = []
+    go n a aa =
+      let a' = a + f n
+          n' = n + 1
+          (slot, rest) = span (< a') aa
+       in slot : go n' a' rest
+
+{- | Split days into intervals, backwards from the most recent day.
+This function uses the 'partition' function after calculating differences
+between the days.
+
+>>> let days = map read ["2019-08-30", "2019-08-31", "2019-09-02"]
+>>> partitionDays (const 1) days
+[[2019-09-02],[],[2019-08-31],[2019-08-30]]
+
+>>> let days = map read ["2019-08-30", "2019-08-31", "2019-09-01", "2019-09-02", "2019-09-03", "2019-09-04"]
+>>> partitionDays (\n -> floor (2^(n-1))) days
+[[2019-09-04],[2019-09-03,2019-09-02],[2019-09-01,2019-08-31,2019-08-30]]
+
+-}
+partitionDays ::
+     (Int -> Integer) -- ^ positive, weakly increasing function of a natural number
+  -> [Day] -- ^ non-empty list of days, with no other restrictions
+  -> [[Day]]
+partitionDays f days = map (map int2day) (partition f ints)
+  where
+    sorted = map head . group . sortOn Down $ days
+    day1 = head sorted
+    ints = map (diffDays day1) sorted
+    int2day i = addDays (-i) day1
diff --git a/src/Main.hs b/src/Main.hs
new file mode 100644
index 0000000..0ab3259
--- /dev/null
+++ b/src/Main.hs
@@ -0,0 +1,65 @@
+module Main
+  ( main
+  ) where
+
+import System.IO (hPutStrLn, stderr)
+
+import Data.Time.Calendar (Day)
+import Options.Applicative
+  ( Parser
+  , (<**>)
+  , (<|>)
+  , argument
+  , auto
+  , execParser
+  , flag'
+  , fullDesc
+  , help
+  , helper
+  , info
+  , long
+  , metavar
+  , option
+  , optional
+  , short
+  , showDefault
+  , some
+  , value
+  )
+
+import Lib (partitionDays)
+
+data Mode
+  = Keep
+  | Delete
+
+data Options = Options
+  { mode :: Maybe Mode
+  , base :: Double
+  , days :: [Day]
+  }
+
+parseMode :: Parser Mode
+parseMode = keep <|> delete
+  where
+    keep = flag' Keep (long "keep" <> short 'k' <> help "Print days to keep")
+    delete =
+      flag' Delete (long "delete" <> short 'd' <> help "Print days to delete")
+
+parseOptions :: Parser Options
+parseOptions =
+  Options <$> optional parseMode <*>
+  option
+    auto
+    (long "base" <> short 'b' <> metavar "BASE" <> showDefault <> value 1.1 <>
+     help "Base of the exponent") <*>
+  some (argument auto (metavar "DAY..."))
+
+main :: IO ()
+main = do
+  opts <- execParser $ info (parseOptions <**> helper) fullDesc
+  let groups = partitionDays (\n -> floor (base opts ^ (n - 1))) (days opts)
+  case mode opts of
+    Just Keep -> putStrLn $ unwords . map show . concatMap (take 1) $ groups
+    Just Delete -> putStrLn $ unwords . map show . concatMap (drop 1) $ groups
+    Nothing -> mapM_ (hPutStrLn stderr . unwords . map show) groups
diff --git a/test/doctests.hs b/test/doctests.hs
new file mode 100644
index 0000000..71ee50d
--- /dev/null
+++ b/test/doctests.hs
@@ -0,0 +1,8 @@
+module Main
+  ( main
+  ) where
+
+import Test.DocTest (doctest)
+
+main :: IO ()
+main = doctest ["-isrc", "src/Lib.hs"]