    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE InstanceSigs        #-}
    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE NamedFieldPuns      #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StrictData          #-}
    --------------------------------------------------------------------
    -- |
    -- Module      :  XMonad.Prompt.OrgMode
    -- Description :  A prompt for interacting with org-mode.
    -- Copyright   :  (c) 2021  Tony Zorman
    -- License     :  BSD3-style (see LICENSE)
    --
    -- Maintainer  :  Tony Zorman <soliditsallgood@mailbox.org>
    -- Stability   :  experimental
    -- Portability :  unknown
    --
    -- A prompt for interacting with <https:\/\/orgmode.org\/ org-mode>.
    -- This can be seen as an org-specific version of
    -- "XMonad.Prompt.AppendFile", allowing for more interesting
    -- interactions with that particular file type.
    --
    -- It can be used to quickly save TODOs, NOTEs, and the like with the
    -- additional capability to schedule/deadline a task, add a priority,
    -- and use the system's clipboard (really: the primary selection) as the
    -- contents of the note.
    --
    -- A blog post highlighting some features of this module can be found
    -- <https://tony-zorman.com/posts/orgmode-prompt/2022-08-27-xmonad-and-org-mode.html here>.
    --
    --------------------------------------------------------------------
    module XMonad.Prompt.OrgMode (
        -- * Usage
        -- $usage

        -- * Prompts
        orgPrompt,              -- :: XPConfig -> String -> FilePath -> X ()
        orgPromptPrimary,       -- :: XPConfig -> String -> FilePath -> X ()

        -- * Types
        ClipboardSupport (..),
        OrgMode,                -- abstract

    #ifdef TESTING
        pInput,
        Note (..),
        Priority (..),
        Date (..),
        Time (..),
        TimeOfDay (..),
        DayOfWeek (..),
    #endif

    ) where

    import XMonad.Prelude

    import XMonad (X, io)
    import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPrompt)
    import XMonad.Util.Parser
    import XMonad.Util.XSelection (getSelection)

    import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, defaultTimeLocale, formatTime, fromGregorian, getCurrentTime, iso8601DateFormat, nominalDay, toGregorian)
    import System.IO (IOMode (AppendMode), hPutStrLn, withFile)

    {- $usage

    You can use this module by importing it, along with "XMonad.Prompt", in
    your @xmonad.hs@

    > import XMonad.Prompt
    > import XMonad.Prompt.OrgMode (orgPrompt)

    and adding an appropriate keybinding.  For example, using syntax from
    "XMonad.Util.EZConfig":

    > , ("M-C-o", orgPrompt def "TODO" "/home/me/org/todos.org")

    This would create notes of the form @* TODO /my-message/@ in the
    specified file.

    You can also enter a relative path; in that case the file path will be
    prepended with @$HOME@ or an equivalent directory.  I.e. instead of the
    above you can write

    > , ("M-C-o", orgPrompt def "TODO" "org/todos.org")
    >                -- also possible: "~/org/todos.org"

    There is also some scheduling and deadline functionality present.  This
    may be initiated by entering @+s@ or @+d@—separated by at least one
    whitespace character on either side—into the prompt, respectively.
    Then, one may enter a date and (optionally) a time of day.  Any of the
    following are valid dates, where brackets indicate optionality:

      - tod[ay]
      - tom[orrow]
      - /any weekday/
      - /any date of the form DD [MM] [YYYY]/

    In the last case, the missing month and year will be filled out with the
    current month and year.

    For weekdays, we also disambiguate as early as possible; a simple @w@
    will suffice to mean Wednesday, but @s@ will not be enough to say
    Sunday.  You can, however, also write the full word without any
    troubles.  Weekdays always schedule into the future; e.g., if today is
    Monday and you schedule something for Monday, you will actually schedule
    it for the /next/ Monday (the one in seven days).

    The time is specified in the @HH:MM@ format.  The minutes may be
    omitted, in which case we assume a full hour is specified.

    A few examples are probably in order.  Suppose we have bound the key
    above, pressed it, and are now confronted with a prompt:

      - @hello +s today@ would create a TODO note with the header @hello@
        and would schedule that for today's date.

      - @hello +s today 12@ schedules the note for today at 12:00.

      - @hello +s today 12:30@ schedules it for today at 12:30.

      - @hello +d today 12:30@ works just like above, but creates a
        deadline.

      - @hello +s thu@ would schedule the note for next thursday.

      - @hello +s 11@ would schedule it for the 11th of this month and this
        year.

      - @hello +s 11 jan 2013@ would schedule the note for the 11th of
        January 2013.

    Note that, due to ambiguity concerns, years below @25@ result in
    undefined parsing behaviour.  Otherwise, what should @message +s 11 jan
    13@ resolve to—the 11th of january at 13:00 or the 11th of january in
    the year 13?

    There is basic support for alphabetic org-mode
    <https:\/\/orgmode.org\/manual\/Priorities.html priorities>.
    Simply append either @#A@, @#B@, or @#C@ (capitalisation is optional) to
    the end of the note.  For example, one could write @"hello +s 11 jan
    2013 #A"@ or @"hello #C"@.  Note that there has to be at least one
    whitespace character between the end of the note and the chosen
    priority.

    There's also the possibility to take what's currently in the primary
    selection and paste that as the content of the created note.  This is
    especially useful when you want to quickly save a URL for later and
    return to whatever you were doing before.  See the 'orgPromptPrimary'
    prompt for that.

    -}

    {- TODO

      - XMonad.Util.XSelection.getSelection is really, really horrible.  The
        plan would be to rewrite this in a way so it uses xmonad's
        connection to the X server.

      - Add option to explicitly use the system clipboard instead of the
        primary selection.

    -}

    ------------------------------------------------------------------------
    -- Prompt

    data OrgMode = OrgMode
      { OrgMode -> ClipboardSupport
    clpSupport :: ClipboardSupport
      , OrgMode -> String
    todoHeader :: String    -- ^ Will display like @* todoHeader @
      , OrgMode -> String
    orgFile    :: FilePath
      }

    -- | Whether we should use a clipboard and which one to use.
    data ClipboardSupport
      = PrimarySelection
      | NoClpSupport

    -- | How one should display the clipboard string.
    data Clp
      = Header String  -- ^ In the header as a link: @* [[clp][message]]@
      | Body   String  -- ^ In the body as additional text: @* message \n clp@

    instance XPrompt OrgMode where
      showXPrompt :: OrgMode -> String
      showXPrompt :: OrgMode -> String
    showXPrompt OrgMode{ String
    todoHeader :: OrgMode -> String
    todoHeader :: String
    todoHeader, String
    orgFile :: OrgMode -> String
    orgFile :: String
    orgFile, ClipboardSupport
    clpSupport :: OrgMode -> ClipboardSupport
    clpSupport :: ClipboardSupport
    clpSupport } =
        [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "Add ", String
    todoHeader, String
    clp, String
    " to ", String
    orgFile, String
    ": "]
       where
        String
    clp :: String = case ClipboardSupport
    clpSupport of
          ClipboardSupport
    NoClpSupport     -> String
    ""
          ClipboardSupport
    PrimarySelection -> String
    " + PS"

    -- | Prompt for interacting with @org-mode@.
    orgPrompt
      :: XPConfig  -- ^ Prompt configuration
      -> String    -- ^ What kind of note to create; will be displayed after
                   --   a single @*@
      -> FilePath  -- ^ Path to @.org@ file, e.g. @home\/me\/todos.org@
      -> X ()
    orgPrompt :: XPConfig -> String -> String -> X ()
    orgPrompt XPConfig
    xpc = XPConfig -> OrgMode -> X ()
    mkOrgPrompt XPConfig
    xpc (OrgMode -> X ())
    -> (String -> String -> OrgMode) -> String -> String -> X ()
    forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: ClipboardSupport -> String -> String -> OrgMode
    OrgMode ClipboardSupport
    NoClpSupport

    -- | Like 'orgPrompt', but additionally make use of the primary
    -- selection.  If it is a URL, then use an org-style link
    -- @[[primary-selection][entered message]]@ as the heading.  Otherwise,
    -- use the primary selection as the content of the note.
    --
    -- The prompt will display a little @+ PS@ in the window
    -- after the type of note.
    orgPromptPrimary :: XPConfig -> String -> FilePath -> X ()
    orgPromptPrimary :: XPConfig -> String -> String -> X ()
    orgPromptPrimary XPConfig
    xpc = XPConfig -> OrgMode -> X ()
    mkOrgPrompt XPConfig
    xpc (OrgMode -> X ())
    -> (String -> String -> OrgMode) -> String -> String -> X ()
    forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: ClipboardSupport -> String -> String -> OrgMode
    OrgMode ClipboardSupport
    PrimarySelection

    -- | Create the actual prompt.
    mkOrgPrompt :: XPConfig -> OrgMode -> X ()
    mkOrgPrompt :: XPConfig -> OrgMode -> X ()
    mkOrgPrompt XPConfig
    xpc oc :: OrgMode
    oc@OrgMode{ String
    todoHeader :: OrgMode -> String
    todoHeader :: String
    todoHeader, String
    orgFile :: OrgMode -> String
    orgFile :: String
    orgFile, ClipboardSupport
    clpSupport :: OrgMode -> ClipboardSupport
    clpSupport :: ClipboardSupport
    clpSupport } =
      OrgMode -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    forall p.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> (String -> X ()) -> X ()
    mkXPrompt OrgMode
    oc XPConfig
    xpc (IO [String] -> ComplFunction
    forall a b. a -> b -> a
    const ([String] -> IO [String]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [])) String -> X ()
    appendNote
     where
      -- | Parse the user input, create an @org-mode@ note out of that and
      -- try to append it to the given file.
      appendNote :: String -> X ()
      appendNote :: String -> X ()
    appendNote String
    input = IO () -> X ()
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO () -> X ()) -> IO () -> X ()
    forall a b. (a -> b) -> a -> b
    $ do
        Clp
    clpStr <- case ClipboardSupport
    clpSupport of
          ClipboardSupport
    NoClpSupport     -> Clp -> IO Clp
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Clp -> IO Clp) -> Clp -> IO Clp
    forall a b. (a -> b) -> a -> b
    $ String -> Clp
    Body String
    ""
          ClipboardSupport
    PrimarySelection -> do
            String
    sel <- IO String
    forall (m :: * -> *). MonadIO m => m String
    getSelection
            Clp -> IO Clp
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Clp -> IO Clp) -> Clp -> IO Clp
    forall a b. (a -> b) -> a -> b
    $ if   (String -> Bool) -> [String] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any (String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    sel) [String
    "http://", String
    "https://"]
                   then String -> Clp
    Header String
    sel
                   else String -> Clp
    Body   (String -> Clp) -> String -> Clp
    forall a b. (a -> b) -> a -> b
    $ String
    "\n " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    sel

        -- Expand path if applicable
        String
    fp <- String -> IO String
    forall (m :: * -> *). MonadIO m => String -> m String
    mkAbsolutePath String
    orgFile

        String -> IOMode -> (Handle -> IO ()) -> IO ()
    forall r. String -> IOMode -> (Handle -> IO r) -> IO r
    withFile String
    fp IOMode
    AppendMode ((Handle -> IO ()) -> IO ())
    -> (String -> Handle -> IO ()) -> String -> IO ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Handle -> String -> IO ()) -> String -> Handle -> IO ()
    forall a b c. (a -> b -> c) -> b -> a -> c
    flip Handle -> String -> IO ()
    hPutStrLn
          (String -> IO ()) -> (String -> IO String) -> String -> IO ()
    forall (m :: * -> *) b c a.
    Monad m =>
    (b -> m c) -> (a -> m b) -> a -> m c
    <=< IO String -> (Note -> IO String) -> Maybe Note -> IO String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe (String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    "") (Clp -> String -> Note -> IO String
    ppNote Clp
    clpStr String
    todoHeader) (Maybe Note -> IO String)
    -> (String -> Maybe Note) -> String -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> Maybe Note
    pInput
            (String -> IO ()) -> String -> IO ()
    forall a b. (a -> b) -> a -> b
    $ String
    input

    ------------------------------------------------------------------------
    -- Time

    -- | A 'Time' is a 'Date' with the possibility of having a specified
    -- @HH:MM@ time.
    data Time = Time
      { Time -> Date
    date :: Date
      , Time -> Maybe TimeOfDay
    tod  :: Maybe TimeOfDay
      }
      deriving (Time -> Time -> Bool
    (Time -> Time -> Bool) -> (Time -> Time -> Bool) -> Eq Time
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Time -> Time -> Bool
    == :: Time -> Time -> Bool
    $c/= :: Time -> Time -> Bool
    /= :: Time -> Time -> Bool
    Eq, Int -> Time -> String -> String
    [Time] -> String -> String
    Time -> String
    (Int -> Time -> String -> String)
    -> (Time -> String) -> ([Time] -> String -> String) -> Show Time
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Time -> String -> String
    showsPrec :: Int -> Time -> String -> String
    $cshow :: Time -> String
    show :: Time -> String
    $cshowList :: [Time] -> String -> String
    showList :: [Time] -> String -> String
    Show)

    -- | The time in HH:MM.
    data TimeOfDay = TimeOfDay Int Int
      deriving (TimeOfDay -> TimeOfDay -> Bool
    (TimeOfDay -> TimeOfDay -> Bool)
    -> (TimeOfDay -> TimeOfDay -> Bool) -> Eq TimeOfDay
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: TimeOfDay -> TimeOfDay -> Bool
    == :: TimeOfDay -> TimeOfDay -> Bool
    $c/= :: TimeOfDay -> TimeOfDay -> Bool
    /= :: TimeOfDay -> TimeOfDay -> Bool
    Eq)

    instance Show TimeOfDay where
      show :: TimeOfDay -> String
      show :: TimeOfDay -> String
    show (TimeOfDay Int
    h Int
    m) = Int -> String
    pad Int
    h String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    ":" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    pad Int
    m
       where
        pad :: Int -> String
        pad :: Int -> String
    pad Int
    n = (if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    9 then String
    "0" else String
    "") String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Int -> String
    forall a. Show a => a -> String
    show Int
    n

    -- | Type for specifying exactly which day one wants.
    data Date
      = Today
      | Tomorrow
      | Next DayOfWeek
        -- ^ This will __always__ show the next 'DayOfWeek' (e.g. calling
        -- 'Next Monday' on a Monday will result in getting the menu for the
        -- following Monday)
      | Date (Int, Maybe Int, Maybe Integer)
        -- ^ Manual date entry in the format DD [MM] [YYYY]
      deriving (Date -> Date -> Bool
    (Date -> Date -> Bool) -> (Date -> Date -> Bool) -> Eq Date
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Date -> Date -> Bool
    == :: Date -> Date -> Bool
    $c/= :: Date -> Date -> Bool
    /= :: Date -> Date -> Bool
    Eq, Eq Date
    Eq Date
    -> (Date -> Date -> Ordering)
    -> (Date -> Date -> Bool)
    -> (Date -> Date -> Bool)
    -> (Date -> Date -> Bool)
    -> (Date -> Date -> Bool)
    -> (Date -> Date -> Date)
    -> (Date -> Date -> Date)
    -> Ord Date
    Date -> Date -> Bool
    Date -> Date -> Ordering
    Date -> Date -> Date
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: Date -> Date -> Ordering
    compare :: Date -> Date -> Ordering
    $c< :: Date -> Date -> Bool
    < :: Date -> Date -> Bool
    $c<= :: Date -> Date -> Bool
    <= :: Date -> Date -> Bool
    $c> :: Date -> Date -> Bool
    > :: Date -> Date -> Bool
    $c>= :: Date -> Date -> Bool
    >= :: Date -> Date -> Bool
    $cmax :: Date -> Date -> Date
    max :: Date -> Date -> Date
    $cmin :: Date -> Date -> Date
    min :: Date -> Date -> Date
    Ord, Int -> Date -> String -> String
    [Date] -> String -> String
    Date -> String
    (Int -> Date -> String -> String)
    -> (Date -> String) -> ([Date] -> String -> String) -> Show Date
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Date -> String -> String
    showsPrec :: Int -> Date -> String -> String
    $cshow :: Date -> String
    show :: Date -> String
    $cshowList :: [Date] -> String -> String
    showList :: [Date] -> String -> String
    Show)

    toOrgFmt :: Maybe TimeOfDay -> Day -> String
    toOrgFmt :: Maybe TimeOfDay -> Day -> String
    toOrgFmt Maybe TimeOfDay
    tod Day
    day =
      [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "<", String
    isoDay, String
    " ", Int -> String -> String
    forall a. Int -> [a] -> [a]
    take Int
    3 (String -> String) -> String -> String
    forall a b. (a -> b) -> a -> b
    $ DayOfWeek -> String
    forall a. Show a => a -> String
    show (Day -> DayOfWeek
    dayOfWeek Day
    day), String
    time, String
    ">"]
     where
      String
    time   :: String = String -> (TimeOfDay -> String) -> Maybe TimeOfDay -> String
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe String
    "" ((Char
    ' ' Char -> String -> String
    forall a. a -> [a] -> [a]
    :) (String -> String) -> (TimeOfDay -> String) -> TimeOfDay -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeOfDay -> String
    forall a. Show a => a -> String
    show) Maybe TimeOfDay
    tod
      String
    isoDay :: String = TimeLocale -> String -> Day -> String
    forall t. FormatTime t => TimeLocale -> String -> t -> String
    formatTime TimeLocale
    defaultTimeLocale (Maybe String -> String
    iso8601DateFormat Maybe String
    forall a. Maybe a
    Nothing) Day
    day

    -- | Pretty print a 'Date' and an optional time to reflect the actual
    -- date.
    ppDate :: Time -> IO String
    ppDate :: Time -> IO String
    ppDate Time{ Date
    date :: Time -> Date
    date :: Date
    date, Maybe TimeOfDay
    tod :: Time -> Maybe TimeOfDay
    tod :: Maybe TimeOfDay
    tod } = do
      UTCTime
    curTime <- IO UTCTime
    getCurrentTime
      let curDay :: Day
    curDay      = UTCTime -> Day
    utctDay UTCTime
    curTime
          (Integer
    y, Int
    m, Int
    _)   = Day -> (Integer, Int, Int)
    toGregorian Day
    curDay
          diffToDay :: DayOfWeek -> NominalDiffTime
    diffToDay DayOfWeek
    d = DayOfWeek -> DayOfWeek -> NominalDiffTime
    diffBetween DayOfWeek
    d (Day -> DayOfWeek
    dayOfWeek Day
    curDay)

      String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> (Day -> String) -> Day -> IO String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe TimeOfDay -> Day -> String
    toOrgFmt Maybe TimeOfDay
    tod (Day -> IO String) -> Day -> IO String
    forall a b. (a -> b) -> a -> b
    $ case Date
    date of
        Date
    Today              -> Day
    curDay
        Date
    Tomorrow           -> UTCTime -> Day
    utctDay (UTCTime -> Day) -> UTCTime -> Day
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> UTCTime -> UTCTime
    addDays NominalDiffTime
    1 UTCTime
    curTime
        Next DayOfWeek
    wday          -> UTCTime -> Day
    utctDay (UTCTime -> Day) -> UTCTime -> Day
    forall a b. (a -> b) -> a -> b
    $ NominalDiffTime -> UTCTime -> UTCTime
    addDays (DayOfWeek -> NominalDiffTime
    diffToDay DayOfWeek
    wday) UTCTime
    curTime
        Date (Int
    d, Maybe Int
    mbM, Maybe Integer
    mbY) -> Integer -> Int -> Int -> Day
    fromGregorian (Integer -> Maybe Integer -> Integer
    forall a. a -> Maybe a -> a
    fromMaybe Integer
    y Maybe Integer
    mbY) (Int -> Maybe Int -> Int
    forall a. a -> Maybe a -> a
    fromMaybe Int
    m Maybe Int
    mbM) Int
    d
     where
      -- | Add a specified number of days to a 'UTCTime'.
      NominalDiffTime -> UTCTime -> UTCTime
    addDays :: NominalDiffTime -> UTCTime -> UTCTime
        = NominalDiffTime -> UTCTime -> UTCTime
    addUTCTime (NominalDiffTime -> UTCTime -> UTCTime)
    -> (NominalDiffTime -> NominalDiffTime)
    -> NominalDiffTime
    -> UTCTime
    -> UTCTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (NominalDiffTime -> NominalDiffTime -> NominalDiffTime
    forall a. Num a => a -> a -> a
    * NominalDiffTime
    nominalDay)

      -- | Evil enum hackery.
      diffBetween :: DayOfWeek -> DayOfWeek -> NominalDiffTime
      diffBetween :: DayOfWeek -> DayOfWeek -> NominalDiffTime
    diffBetween DayOfWeek
    d DayOfWeek
    cur  -- we want to jump to @d@
        | DayOfWeek
    d DayOfWeek -> DayOfWeek -> Bool
    forall a. Eq a => a -> a -> Bool
    == DayOfWeek
    cur  = NominalDiffTime
    7
        | Bool
    otherwise = Int -> NominalDiffTime
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Int -> NominalDiffTime) -> (Int -> Int) -> Int -> NominalDiffTime
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> Int
    forall a. Num a => a -> a
    abs (Int -> NominalDiffTime) -> Int -> NominalDiffTime
    forall a b. (a -> b) -> a -> b
    $ (DayOfWeek -> Int
    forall a. Enum a => a -> Int
    fromEnum DayOfWeek
    d Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - DayOfWeek -> Int
    forall a. Enum a => a -> Int
    fromEnum DayOfWeek
    cur) Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    `mod` Int
    7

    -- Old GHC versions don't have a @time@ library new enough to have
    -- this, so replicate it here for the moment.

    dayOfWeek :: Day -> DayOfWeek
    dayOfWeek :: Day -> DayOfWeek
    dayOfWeek (ModifiedJulianDay Integer
    d) = Int -> DayOfWeek
    forall a. Enum a => Int -> a
    toEnum (Int -> DayOfWeek) -> Int -> DayOfWeek
    forall a b. (a -> b) -> a -> b
    $ Integer -> Int
    forall a. Num a => Integer -> a
    fromInteger (Integer -> Int) -> Integer -> Int
    forall a b. (a -> b) -> a -> b
    $ Integer
    d Integer -> Integer -> Integer
    forall a. Num a => a -> a -> a
    + Integer
    3

    data DayOfWeek
      = Monday | Tuesday | Wednesday | Thursday | Friday | Saturday | Sunday
      deriving (DayOfWeek -> DayOfWeek -> Bool
    (DayOfWeek -> DayOfWeek -> Bool)
    -> (DayOfWeek -> DayOfWeek -> Bool) -> Eq DayOfWeek
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: DayOfWeek -> DayOfWeek -> Bool
    == :: DayOfWeek -> DayOfWeek -> Bool
    $c/= :: DayOfWeek -> DayOfWeek -> Bool
    /= :: DayOfWeek -> DayOfWeek -> Bool
    Eq, Eq DayOfWeek
    Eq DayOfWeek
    -> (DayOfWeek -> DayOfWeek -> Ordering)
    -> (DayOfWeek -> DayOfWeek -> Bool)
    -> (DayOfWeek -> DayOfWeek -> Bool)
    -> (DayOfWeek -> DayOfWeek -> Bool)
    -> (DayOfWeek -> DayOfWeek -> Bool)
    -> (DayOfWeek -> DayOfWeek -> DayOfWeek)
    -> (DayOfWeek -> DayOfWeek -> DayOfWeek)
    -> Ord DayOfWeek
    DayOfWeek -> DayOfWeek -> Bool
    DayOfWeek -> DayOfWeek -> Ordering
    DayOfWeek -> DayOfWeek -> DayOfWeek
    forall a.
    Eq a
    -> (a -> a -> Ordering)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> Bool)
    -> (a -> a -> a)
    -> (a -> a -> a)
    -> Ord a
    $ccompare :: DayOfWeek -> DayOfWeek -> Ordering
    compare :: DayOfWeek -> DayOfWeek -> Ordering
    $c< :: DayOfWeek -> DayOfWeek -> Bool
    < :: DayOfWeek -> DayOfWeek -> Bool
    $c<= :: DayOfWeek -> DayOfWeek -> Bool
    <= :: DayOfWeek -> DayOfWeek -> Bool
    $c> :: DayOfWeek -> DayOfWeek -> Bool
    > :: DayOfWeek -> DayOfWeek -> Bool
    $c>= :: DayOfWeek -> DayOfWeek -> Bool
    >= :: DayOfWeek -> DayOfWeek -> Bool
    $cmax :: DayOfWeek -> DayOfWeek -> DayOfWeek
    max :: DayOfWeek -> DayOfWeek -> DayOfWeek
    $cmin :: DayOfWeek -> DayOfWeek -> DayOfWeek
    min :: DayOfWeek -> DayOfWeek -> DayOfWeek
    Ord, Int -> DayOfWeek -> String -> String
    [DayOfWeek] -> String -> String
    DayOfWeek -> String
    (Int -> DayOfWeek -> String -> String)
    -> (DayOfWeek -> String)
    -> ([DayOfWeek] -> String -> String)
    -> Show DayOfWeek
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> DayOfWeek -> String -> String
    showsPrec :: Int -> DayOfWeek -> String -> String
    $cshow :: DayOfWeek -> String
    show :: DayOfWeek -> String
    $cshowList :: [DayOfWeek] -> String -> String
    showList :: [DayOfWeek] -> String -> String
    Show)

    -- | \"Circular\", so for example @[Tuesday ..]@ gives an endless
    -- sequence.  Also: 'fromEnum' gives [1 .. 7] for [Monday .. Sunday],
    -- and 'toEnum' performs mod 7 to give a cycle of days.
    instance Enum DayOfWeek where
      toEnum :: Int -> DayOfWeek
      toEnum :: Int -> DayOfWeek
    toEnum Int
    i = case Int -> Int -> Int
    forall a. Integral a => a -> a -> a
    mod Int
    i Int
    7 of
        Int
    0 -> DayOfWeek
    Sunday
        Int
    1 -> DayOfWeek
    Monday
        Int
    2 -> DayOfWeek
    Tuesday
        Int
    3 -> DayOfWeek
    Wednesday
        Int
    4 -> DayOfWeek
    Thursday
        Int
    5 -> DayOfWeek
    Friday
        Int
    _ -> DayOfWeek
    Saturday

      fromEnum :: DayOfWeek -> Int
      fromEnum :: DayOfWeek -> Int
    fromEnum = \case
        DayOfWeek
    Monday    -> Int
    1
        DayOfWeek
    Tuesday   -> Int
    2
        DayOfWeek
    Wednesday -> Int
    3
        DayOfWeek
    Thursday  -> Int
    4
        DayOfWeek
    Friday    -> Int
    5
        DayOfWeek
    Saturday  -> Int
    6
        DayOfWeek
    Sunday    -> Int
    7

    ------------------------------------------------------------------------
    -- Note

    -- | An @org-mode@ style note.
    data Note
      = Scheduled String Time Priority
      | Deadline  String Time Priority
      | NormalMsg String      Priority
      deriving (Note -> Note -> Bool
    (Note -> Note -> Bool) -> (Note -> Note -> Bool) -> Eq Note
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Note -> Note -> Bool
    == :: Note -> Note -> Bool
    $c/= :: Note -> Note -> Bool
    /= :: Note -> Note -> Bool
    Eq, Int -> Note -> String -> String
    [Note] -> String -> String
    Note -> String
    (Int -> Note -> String -> String)
    -> (Note -> String) -> ([Note] -> String -> String) -> Show Note
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Note -> String -> String
    showsPrec :: Int -> Note -> String -> String
    $cshow :: Note -> String
    show :: Note -> String
    $cshowList :: [Note] -> String -> String
    showList :: [Note] -> String -> String
    Show)

    -- | An @org-mode@ style priority symbol[1]; e.g., something like
    -- @[#A]@.  Note that this uses the standard org conventions: supported
    -- priorities are @A@, @B@, and @C@, with @A@ being the highest.
    -- Numerical priorities are not supported.
    --
    -- [1]: https://orgmode.org/manual/Priorities.html
    data Priority = A | B | C | NoPriority
      deriving (Priority -> Priority -> Bool
    (Priority -> Priority -> Bool)
    -> (Priority -> Priority -> Bool) -> Eq Priority
    forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
    $c== :: Priority -> Priority -> Bool
    == :: Priority -> Priority -> Bool
    $c/= :: Priority -> Priority -> Bool
    /= :: Priority -> Priority -> Bool
    Eq, Int -> Priority -> String -> String
    [Priority] -> String -> String
    Priority -> String
    (Int -> Priority -> String -> String)
    -> (Priority -> String)
    -> ([Priority] -> String -> String)
    -> Show Priority
    forall a.
    (Int -> a -> String -> String)
    -> (a -> String) -> ([a] -> String -> String) -> Show a
    $cshowsPrec :: Int -> Priority -> String -> String
    showsPrec :: Int -> Priority -> String -> String
    $cshow :: Priority -> String
    show :: Priority -> String
    $cshowList :: [Priority] -> String -> String
    showList :: [Priority] -> String -> String
    Show)

    -- | Pretty print a given 'Note'.
    ppNote :: Clp -> String -> Note -> IO String
    ppNote :: Clp -> String -> Note -> IO String
    ppNote Clp
    clp String
    todo = \case
      Scheduled String
    str Time
    time Priority
    prio -> String -> String -> Maybe Time -> Priority -> IO String
    mkLine String
    str String
    "SCHEDULED: " (Time -> Maybe Time
    forall a. a -> Maybe a
    Just Time
    time) Priority
    prio
      Deadline  String
    str Time
    time Priority
    prio -> String -> String -> Maybe Time -> Priority -> IO String
    mkLine String
    str String
    "DEADLINE: "  (Time -> Maybe Time
    forall a. a -> Maybe a
    Just Time
    time) Priority
    prio
      NormalMsg String
    str      Priority
    prio -> String -> String -> Maybe Time -> Priority -> IO String
    mkLine String
    str String
    ""            Maybe Time
    forall a. Maybe a
    Nothing     Priority
    prio
     where
      mkLine :: String -> String -> Maybe Time -> Priority -> IO String
      mkLine :: String -> String -> Maybe Time -> Priority -> IO String
    mkLine String
    str String
    sched Maybe Time
    time Priority
    prio = do
        String
    t <- case Maybe Time
    time of
          Maybe Time
    Nothing -> String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    ""
          Just Time
    ti -> ((String
    "\n  " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    sched) String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <>) (String -> String) -> IO String -> IO String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Time -> IO String
    ppDate Time
    ti
        String -> IO String
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String -> IO String) -> String -> IO String
    forall a b. (a -> b) -> a -> b
    $ String
    "* " String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    todo String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    priority String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> case Clp
    clp of
          Body   String
    c -> [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    str, String
    t, String
    c]
          Header String
    c -> [String] -> String
    forall a. Monoid a => [a] -> a
    mconcat [String
    "[[", String
    c, String
    "][", String
    str,String
    "]]", String
    t]
       where
        priority :: String
    priority = case Priority
    prio of
          Priority
    NoPriority -> String
    " "
          Priority
    otherPrio  -> String
    " [#" String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> Priority -> String
    forall a. Show a => a -> String
    show Priority
    otherPrio String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    "] "

    ------------------------------------------------------------------------
    -- Parsing

    -- | Parse the given string into a 'Note'.
    pInput :: String -> Maybe Note
    pInput :: String -> Maybe Note
    pInput String
    inp = (Parser Note -> String -> Maybe Note
    forall a. Parser a -> String -> Maybe a
    `runParser` String
    inp) (Parser Note -> Maybe Note)
    -> ([Parser Note] -> Parser Note) -> [Parser Note] -> Maybe Note
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . [Parser Note] -> Parser Note
    forall a. [Parser a] -> Parser a
    choice ([Parser Note] -> Maybe Note) -> [Parser Note] -> Maybe Note
    forall a b. (a -> b) -> a -> b
    $
      [ String -> Time -> Priority -> Note
    Scheduled (String -> Time -> Priority -> Note)
    -> Parser String -> Parser (Time -> Priority -> Note)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Parser String
    getLast String
    "+s" Parser (Time -> Priority -> Note)
    -> Parser Time -> Parser (Priority -> Note)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Date -> Maybe TimeOfDay -> Time
    Time (Date -> Maybe TimeOfDay -> Time)
    -> Parser Date -> Parser (Maybe TimeOfDay -> Time)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Date
    pDate Parser (Maybe TimeOfDay -> Time)
    -> Parser (Maybe TimeOfDay) -> Parser Time
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser (Maybe TimeOfDay)
    pTimeOfDay) Parser (Priority -> Note) -> Parser Priority -> Parser Note
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Priority
    pPriority
      , String -> Time -> Priority -> Note
    Deadline  (String -> Time -> Priority -> Note)
    -> Parser String -> Parser (Time -> Priority -> Note)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> String -> Parser String
    getLast String
    "+d" Parser (Time -> Priority -> Note)
    -> Parser Time -> Parser (Priority -> Note)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> (Date -> Maybe TimeOfDay -> Time
    Time (Date -> Maybe TimeOfDay -> Time)
    -> Parser Date -> Parser (Maybe TimeOfDay -> Time)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Date
    pDate Parser (Maybe TimeOfDay -> Time)
    -> Parser (Maybe TimeOfDay) -> Parser Time
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser (Maybe TimeOfDay)
    pTimeOfDay) Parser (Priority -> Note) -> Parser Priority -> Parser Note
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Priority
    pPriority
      , do String
    s <- (Char -> Bool) -> Parser String
    munch1 (Bool -> Char -> Bool
    forall a. a -> Char -> a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Bool
    True)
           let (String
    s', String
    p) = Int -> String -> (String, String)
    forall a. Int -> [a] -> ([a], [a])
    splitAt (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    s Int -> Int -> Int
    forall a. Num a => a -> a -> a
    - Int
    3) String
    s
           Note -> Parser Note
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (Note -> Parser Note) -> Note -> Parser Note
    forall a b. (a -> b) -> a -> b
    $ case String -> Maybe Priority
    tryPrio String
    p of
             Just Priority
    prio -> String -> Priority -> Note
    NormalMsg (Int -> String -> String
    dropStripEnd Int
    0 String
    s') Priority
    prio
             Maybe Priority
    Nothing   -> String -> Priority -> Note
    NormalMsg String
    s                   Priority
    NoPriority
      ]
     where
      tryPrio :: String -> Maybe Priority
      tryPrio :: String -> Maybe Priority
    tryPrio [Char
    ' ', Char
    '#', Char
    x]
        | Char
    x Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String
    "Aa" :: String) = Priority -> Maybe Priority
    forall a. a -> Maybe a
    Just Priority
    A
        | Char
    x Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String
    "Bb" :: String) = Priority -> Maybe Priority
    forall a. a -> Maybe a
    Just Priority
    B
        | Char
    x Char -> String -> Bool
    forall a. Eq a => a -> [a] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `elem` (String
    "Cc" :: String) = Priority -> Maybe Priority
    forall a. a -> Maybe a
    Just Priority
    C
      tryPrio String
    _ = Maybe Priority
    forall a. Maybe a
    Nothing

      -- Trim whitespace at the end of a string after dropping some number
      -- of characters from it.
      dropStripEnd :: Int -> String -> String
      dropStripEnd :: Int -> String -> String
    dropStripEnd Int
    n = String -> String
    forall a. [a] -> [a]
    reverse (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Char -> Bool) -> String -> String
    forall a. (a -> Bool) -> [a] -> [a]
    dropWhile (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ' ') (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Int -> String -> String
    forall a. Int -> [a] -> [a]
    drop Int
    n (String -> String) -> (String -> String) -> String -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . String -> String
    forall a. [a] -> [a]
    reverse

      getLast :: String -> Parser String
      getLast :: String -> Parser String
    getLast String
    ptn =  Int -> String -> String
    dropStripEnd (String -> Int
    forall a. [a] -> Int
    forall (t :: * -> *) a. Foldable t => t a -> Int
    length String
    ptn) -- drop only the last pattern before stripping
                  (String -> String) -> ([String] -> String) -> [String] -> String
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    .  [String] -> String
    forall (t :: * -> *) a. Foldable t => t [a] -> [a]
    concat
                 ([String] -> String) -> Parser [String] -> Parser String
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser String -> Parser String -> Parser [String]
    forall a sep. Parser a -> Parser sep -> Parser [a]
    endBy1 (String -> Parser String
    go String
    "") (String -> Parser String
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure String
    ptn)
       where
        go :: String -> Parser String
        go :: String -> Parser String
    go String
    consumed = do
          String
    str  <- (Char -> Bool) -> Parser String
    munch  (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= String -> Char
    forall a. HasCallStack => [a] -> a
    head String
    ptn)
          String
    word <- (Char -> Bool) -> Parser String
    munch1 (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ')
          (String -> Parser String)
    -> (String -> Parser String) -> Bool -> String -> Parser String
    forall a. a -> a -> Bool -> a
    bool String -> Parser String
    go String -> Parser String
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (String
    word String -> String -> Bool
    forall a. Eq a => a -> a -> Bool
    == String
    ptn) (String -> Parser String) -> String -> Parser String
    forall a b. (a -> b) -> a -> b
    $ String
    consumed String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    str String -> String -> String
    forall a. Semigroup a => a -> a -> a
    <> String
    word

    -- | Parse a 'Priority'.
    pPriority :: Parser Priority
    pPriority :: Parser Priority
    pPriority = Parser Priority -> Parser Priority -> Parser Priority
    forall a. Parser a -> Parser a -> Parser a
    pLast (Priority -> Parser Priority
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Priority
    NoPriority) (Parser Priority -> Parser Priority)
    -> Parser Priority -> Parser Priority
    forall a b. (a -> b) -> a -> b
    $
      Parser String
    " " Parser String -> Parser () -> Parser ()
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser ()
    skipSpaces Parser () -> Parser Priority -> Parser Priority
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Parser Priority] -> Parser Priority
    forall a. [Parser a] -> Parser a
    choice
        [ Parser String
    "#" Parser String -> Parser String -> Parser String
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Parser String
    "A" Parser String -> Parser String -> Parser String
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser String
    "a") Parser String -> Priority -> Parser Priority
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Priority
    A
        , Parser String
    "#" Parser String -> Parser String -> Parser String
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Parser String
    "B" Parser String -> Parser String -> Parser String
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser String
    "b") Parser String -> Priority -> Parser Priority
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Priority
    B
        , Parser String
    "#" Parser String -> Parser String -> Parser String
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> (Parser String
    "C" Parser String -> Parser String -> Parser String
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser String
    "c") Parser String -> Priority -> Parser Priority
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Priority
    C
        ]

    -- | Try to parse a 'Time'.
    pTimeOfDay :: Parser (Maybe TimeOfDay)
    pTimeOfDay :: Parser (Maybe TimeOfDay)
    pTimeOfDay = Parser (Maybe TimeOfDay)
    -> Parser (Maybe TimeOfDay) -> Parser (Maybe TimeOfDay)
    forall a. Parser a -> Parser a -> Parser a
    pLast (Maybe TimeOfDay -> Parser (Maybe TimeOfDay)
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Maybe TimeOfDay
    forall a. Maybe a
    Nothing) (Parser (Maybe TimeOfDay) -> Parser (Maybe TimeOfDay))
    -> Parser (Maybe TimeOfDay) -> Parser (Maybe TimeOfDay)
    forall a b. (a -> b) -> a -> b
    $
      Parser ()
    skipSpaces Parser () -> Parser (Maybe TimeOfDay) -> Parser (Maybe TimeOfDay)
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Parser (Maybe TimeOfDay)] -> Parser (Maybe TimeOfDay)
    forall a. [Parser a] -> Parser a
    choice
        [ TimeOfDay -> Maybe TimeOfDay
    forall a. a -> Maybe a
    Just (TimeOfDay -> Maybe TimeOfDay)
    -> Parser TimeOfDay -> Parser (Maybe TimeOfDay)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Int -> Int -> TimeOfDay
    TimeOfDay (Int -> Int -> TimeOfDay)
    -> Parser Int -> Parser (Int -> TimeOfDay)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Int
    pHour Parser (Int -> TimeOfDay)
    -> Parser String -> Parser (Int -> TimeOfDay)
    forall a b. Parser a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* String -> Parser String
    string String
    ":" Parser (Int -> TimeOfDay) -> Parser Int -> Parser TimeOfDay
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Int
    pMinute) -- HH:MM
        , TimeOfDay -> Maybe TimeOfDay
    forall a. a -> Maybe a
    Just (TimeOfDay -> Maybe TimeOfDay)
    -> Parser TimeOfDay -> Parser (Maybe TimeOfDay)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Int -> Int -> TimeOfDay
    TimeOfDay (Int -> Int -> TimeOfDay)
    -> Parser Int -> Parser (Int -> TimeOfDay)
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser Int
    pHour               Parser (Int -> TimeOfDay) -> Parser Int -> Parser TimeOfDay
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Int -> Parser Int
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    0 ) -- HH
        ]
     where
      Parser Int
    pMinute :: Parser Int = Int -> Int -> Parser Int
    pNumBetween Int
    1 Int
    60
      Parser Int
    pHour   :: Parser Int = Int -> Int -> Parser Int
    pNumBetween Int
    1 Int
    24

    -- | Parse a 'Date'.
    pDate :: Parser Date
    pDate :: Parser Date
    pDate = Parser ()
    skipSpaces Parser () -> Parser Date -> Parser Date
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Parser Date] -> Parser Date
    forall a. [Parser a] -> Parser a
    choice
      [ Parser String -> String -> Date -> Parser Date
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "tod" String
    "ay"    Date
    Today
      , Parser String -> String -> Date -> Parser Date
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "tom" String
    "orrow" Date
    Tomorrow
      , DayOfWeek -> Date
    Next (DayOfWeek -> Date) -> Parser DayOfWeek -> Parser Date
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser DayOfWeek
    pNext
      , (Int, Maybe Int, Maybe Integer) -> Date
    Date ((Int, Maybe Int, Maybe Integer) -> Date)
    -> Parser (Int, Maybe Int, Maybe Integer) -> Parser Date
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser (Int, Maybe Int, Maybe Integer)
    pDate'
      ]
     where
      Parser DayOfWeek
    pNext :: Parser DayOfWeek = [Parser DayOfWeek] -> Parser DayOfWeek
    forall a. [Parser a] -> Parser a
    choice
        [ Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "m"  String
    "onday"    DayOfWeek
    Monday   , Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "tu" String
    "esday"  DayOfWeek
    Tuesday
        , Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "w"  String
    "ednesday" DayOfWeek
    Wednesday, Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "th" String
    "ursday" DayOfWeek
    Thursday
        , Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "f"  String
    "riday"    DayOfWeek
    Friday   , Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "sa" String
    "turday" DayOfWeek
    Saturday
        , Parser String -> String -> DayOfWeek -> Parser DayOfWeek
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "su" String
    "nday"     DayOfWeek
    Sunday
        ]

      numWithoutColon :: Parser Int
      numWithoutColon :: Parser Int
    numWithoutColon = do
        Int
    str <- Int -> Int -> Parser Int
    pNumBetween Int
    1 Int
    12 -- month
        Char
    c <- Parser Char
    get
        if Char
    c Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    ':'
        then Parser Int
    forall a. Parser a
    pfail
        else Int -> Parser Int
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Int
    str

      pDate' :: Parser (Int, Maybe Int, Maybe Integer)
      pDate' :: Parser (Int, Maybe Int, Maybe Integer)
    pDate' =
        (,,) (Int
     -> Maybe Int -> Maybe Integer -> (Int, Maybe Int, Maybe Integer))
    -> Parser Int
    -> Parser
         (Maybe Int -> Maybe Integer -> (Int, Maybe Int, Maybe Integer))
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Int -> Int -> Parser Int
    pNumBetween Int
    1 Int
    31               -- day
             Parser
      (Maybe Int -> Maybe Integer -> (Int, Maybe Int, Maybe Integer))
    -> Parser (Maybe Int)
    -> Parser (Maybe Integer -> (Int, Maybe Int, Maybe Integer))
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Int -> Parser (Maybe Int)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser ()
    skipSpaces Parser () -> Parser Int -> Parser Int
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Parser Int] -> Parser Int
    forall a. [Parser a] -> Parser a
    choice
                   [ Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "ja"  String
    "nuary"    Int
    1 , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "f"   String
    "ebruary" Int
    2
                   , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "mar" String
    "ch"       Int
    3 , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "ap"  String
    "ril"     Int
    4
                   , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "may" String
    ""         Int
    5 , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "jun" String
    "e"       Int
    6
                   , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "jul" String
    "y"        Int
    7 , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "au"  String
    "gust"    Int
    8
                   , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "s"   String
    "eptember" Int
    9 , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "o"   String
    "ctober"  Int
    10
                   , Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "n"   String
    "ovember"  Int
    11, Parser String -> String -> Int -> Parser Int
    forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    "d"   String
    "ecember" Int
    12
                   , Parser Int
    numWithoutColon
                   ])
             Parser (Maybe Integer -> (Int, Maybe Int, Maybe Integer))
    -> Parser (Maybe Integer) -> Parser (Int, Maybe Int, Maybe Integer)
    forall a b. Parser (a -> b) -> Parser a -> Parser b
    forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
    <*> Parser Integer -> Parser (Maybe Integer)
    forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
    optional (Parser ()
    skipSpaces Parser () -> Parser Integer -> Parser Integer
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> Parser Integer
    forall a. (Read a, Integral a) => Parser a
    num Parser Integer -> (Integer -> Parser Integer) -> Parser Integer
    forall a b. Parser a -> (a -> Parser b) -> Parser b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \Integer
    i -> Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Integer
    i Integer -> Integer -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Integer
    25) Parser () -> Integer -> Parser Integer
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Integer
    i)

      -- | Parse a prefix and drop a potential suffix up to the next (space
      -- separated) word.  If successful, return @ret@.
      pPrefix :: Parser String -> String -> a -> Parser a
      pPrefix :: forall a. Parser String -> String -> a -> Parser a
    pPrefix Parser String
    start String
    leftover a
    ret = do
        Parser String -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void Parser String
    start
        String
    l <- (Char -> Bool) -> Parser String
    munch (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ')
        Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (String
    l String -> String -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` String
    leftover)
        a -> Parser a
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure a
    ret

    -- | Parse a number between @lo@ (inclusive) and @hi@ (inclusive).
    pNumBetween :: Int -> Int -> Parser Int
    pNumBetween :: Int -> Int -> Parser Int
    pNumBetween Int
    lo Int
    hi = do
      Int
    n <- Parser Int
    forall a. (Read a, Integral a) => Parser a
    num
      Int
    n Int -> Parser () -> Parser Int
    forall a b. a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    lo Bool -> Bool -> Bool
    && Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    hi)

    -- | A flipped version of '(<|>)'.  Useful when @p'@ is some complicated
    -- expression that, for example, consumes spaces and @p@ does not want
    -- to do that.
    pLast :: Parser a -> Parser a -> Parser a
    pLast :: forall a. Parser a -> Parser a -> Parser a
    pLast Parser a
    p Parser a
    p' = Parser a
    p' Parser a -> Parser a -> Parser a
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Parser a
    p