aboutsummaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--CHANGELOG.md3
-rw-r--r--README.md76
-rw-r--r--Setup.hs2
-rw-r--r--frotate.cabal34
-rw-r--r--src/Lib.hs71
-rw-r--r--src/Main.hs65
-rw-r--r--test/doctests.hs8
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"]