datepicker

  1{-# LANGUAGE PatternSynonyms #-}
  2
  3module DatePicker.CmdLine
  4  ( Opts (..),
  5    CmdTime,
  6    getTime,
  7    optsPeriod,
  8    getCmdArgs,
  9  )
 10where
 11
 12import Control.Applicative ((<|>))
 13import Data.Time.Calendar qualified as Cal
 14import Data.Time.Calendar.Month (Month, addMonths, pattern YearMonth)
 15import Data.Time.Calendar.OrdinalDate (Day, toOrdinalDate)
 16import Data.Time.Format qualified as Fmt
 17import Data.Time.LocalTime (LocalTime (LocalTime))
 18import DatePicker.Util (locale, periodAllMonths)
 19import Options.Applicative qualified as OPT
 20
 21data CmdTime = CmdTime String (Maybe String)
 22
 23firstDayInMY :: Cal.Year -> Cal.MonthOfYear -> Day
 24firstDayInMY y my = Cal.periodFirstDay $ YearMonth y my
 25
 26parseMonth :: String -> IO Month
 27parseMonth input =
 28  Fmt.parseTimeM False locale "%B" input
 29    <|> Fmt.parseTimeM False locale "%b" input
 30    <|> Fmt.parseTimeM False locale "%m" input
 31
 32getTime :: LocalTime -> CmdTime -> IO Day
 33getTime _ (CmdTime month (Just year)) = do
 34  (YearMonth _ my) <- parseMonth month
 35  pure (firstDayInMY (read year) my)
 36getTime (LocalTime cd _) (CmdTime month Nothing) = do
 37  (YearMonth _ my) <- parseMonth month
 38  pure (firstDayInMY (fst $ toOrdinalDate cd) my)
 39
 40------------------------------------------------------------------------
 41
 42data Duration = OneMonth | ThreeMonths | TwelveMonths | OneYear
 43
 44data Opts = Opts
 45  { optNoTime :: Bool,
 46    optLogical :: Bool,
 47    optFormat :: String,
 48    optMonday :: Bool,
 49    optDuration :: Duration,
 50    optTime :: Maybe CmdTime
 51  }
 52
 53durationParser :: OPT.Parser Duration
 54durationParser =
 55  OPT.flag
 56    OneMonth
 57    OneMonth
 58    ( OPT.long "one"
 59        <> OPT.short '1'
 60        <> OPT.help "Display a single month"
 61    )
 62    OPT.<|> OPT.flag'
 63      ThreeMonths
 64      ( OPT.long "three"
 65          <> OPT.short '3'
 66          <> OPT.help "Display next/previous month for current month"
 67      )
 68    OPT.<|> OPT.flag'
 69      TwelveMonths
 70      ( OPT.long "twelve"
 71          <> OPT.short 'Y'
 72          <> OPT.help "Display the next twelve months"
 73      )
 74    OPT.<|> OPT.flag'
 75      OneYear
 76      ( OPT.long "year"
 77          <> OPT.short 'y'
 78          <> OPT.help "Display the entire year"
 79      )
 80
 81timeParser :: OPT.Parser CmdTime
 82timeParser =
 83  CmdTime
 84    <$> OPT.argument OPT.str (OPT.metavar "month")
 85    <*> OPT.optional
 86      (OPT.argument OPT.str (OPT.metavar "year"))
 87
 88optsParser :: OPT.Parser Opts
 89optsParser =
 90  Opts
 91    <$> OPT.switch
 92      ( OPT.long "date-only"
 93          <> OPT.short 'd'
 94          <> OPT.help "Only require date selection, omitting time"
 95      )
 96    <*> OPT.switch
 97      ( OPT.long "logical-move"
 98          <> OPT.short 'l'
 99          <> OPT.help "Always move cursor logically by week/date"
100      )
101    <*> OPT.option
102      OPT.str
103      ( OPT.long "format"
104          <> OPT.short 'f'
105          -- RFC 1123 format as per Go's time package
106          <> OPT.value "%a, %d %b %Y %T %Z"
107          <> OPT.metavar "FORMAT"
108          <> OPT.help "Format in which the date should be output"
109      )
110    <*> OPT.switch
111      ( OPT.long "monday"
112          <> OPT.short 'm'
113          <> OPT.help "Treat monday as the first day of the week"
114      )
115    <*> durationParser
116    <*> OPT.optional timeParser
117
118------------------------------------------------------------------------
119
120optsPeriod :: Duration -> Cal.Day -> [Month]
121optsPeriod OneMonth day = [Cal.dayPeriod day]
122optsPeriod ThreeMonths day =
123  let month = Cal.dayPeriod day
124   in [addMonths (-1) month, month, addMonths 1 month]
125optsPeriod TwelveMonths day =
126  let month = Cal.dayPeriod day
127   in map (`addMonths` month) [0 .. 11]
128optsPeriod OneYear day = periodAllMonths (fst $ toOrdinalDate day)
129
130cmdOpts :: OPT.ParserInfo Opts
131cmdOpts =
132  OPT.info
133    (optsParser OPT.<**> OPT.helper)
134    ( OPT.fullDesc
135        <> OPT.progDesc "Interactively select a date to be printed to stdout"
136        <> OPT.header "datepicker - a utility for interactive date selection"
137    )
138
139getCmdArgs :: IO Opts
140getCmdArgs = OPT.execParser cmdOpts