datepicker

 1module CmdLine
 2  ( Opts (optNoTime, optLogical, optFormat, optDuration),
 3    cmdOpts,
 4    optsPeriod,
 5  )
 6where
 7
 8import Data.Time.Calendar qualified as Cal
 9import Data.Time.Calendar.Month (Month, addMonths)
10import Data.Time.Calendar.OrdinalDate (toOrdinalDate)
11import Options.Applicative qualified as OPT
12import Util (periodAllMonths)
13
14data Duration = OneMonth | ThreeMonths | TwelveMonths
15
16data Opts = Opts
17  { optNoTime :: Bool,
18    optLogical :: Bool,
19    optFormat :: String,
20    optDuration :: Duration
21  }
22
23durationParser :: OPT.Parser Duration
24durationParser =
25  OPT.flag
26    OneMonth
27    OneMonth
28    ( OPT.long "one"
29        <> OPT.short '1'
30        <> OPT.help "Display a single month"
31    )
32    OPT.<|> OPT.flag'
33      ThreeMonths
34      ( OPT.long "three"
35          <> OPT.short '3'
36          <> OPT.help "Display next/previous month for current month"
37      )
38    OPT.<|> OPT.flag'
39      TwelveMonths
40      ( OPT.long "year"
41          <> OPT.short 'y'
42          <> OPT.help "Display the entire year"
43      )
44
45optsParser :: OPT.Parser Opts
46optsParser =
47  Opts
48    <$> OPT.switch
49      ( OPT.long "date-only"
50          <> OPT.short 'd'
51          <> OPT.help "Only require date selection, omitting time"
52      )
53    <*> OPT.switch
54      ( OPT.long "logical-move"
55          <> OPT.short 'l'
56          <> OPT.help "Always move cursor logically by week/date"
57      )
58    <*> OPT.option
59      OPT.str
60      ( OPT.long "format"
61          <> OPT.short 'f'
62          -- RFC 1123 format as per Go's time package
63          <> OPT.value "%a, %d %b %Y %T %Z"
64          <> OPT.metavar "FORMAT"
65          <> OPT.help "Format in which the date should be output"
66      )
67    <*> durationParser
68
69------------------------------------------------------------------------
70
71optsPeriod :: Duration -> Cal.Day -> [Month]
72optsPeriod OneMonth day = [Cal.dayPeriod day]
73optsPeriod ThreeMonths day =
74  let month = Cal.dayPeriod day
75   in [addMonths (-1) month, month, addMonths 1 month]
76optsPeriod TwelveMonths day = periodAllMonths (fst $ toOrdinalDate day)
77
78cmdOpts :: OPT.ParserInfo Opts
79cmdOpts =
80  OPT.info
81    (optsParser OPT.<**> OPT.helper)
82    ( OPT.fullDesc
83        <> OPT.progDesc "Interactively select a date to be printed to stdout"
84        <> OPT.header "datepicker - a utility for interactive date selection"
85    )