    {-# LANGUAGE CPP                 #-}
    {-# LANGUAGE InstanceSigs        #-}
    {-# LANGUAGE LambdaCase          #-}
    {-# LANGUAGE NamedFieldPuns      #-}
    {-# LANGUAGE OverloadedStrings   #-}
    {-# LANGUAGE RecordWildCards     #-}
    {-# LANGUAGE ScopedTypeVariables #-}
    {-# LANGUAGE StrictData          #-}
    {-# LANGUAGE ViewPatterns        #-}
    --------------------------------------------------------------------
    -- |
    -- 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,
    -- refile to some existing heading, 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 ()
        orgPromptRefile,        -- :: XPConfig -> [String] -> String -> FilePath -> X ()
        orgPromptRefileTo,      -- :: XPConfig -> String -> 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, whenJust)
    import XMonad.Prompt (XPConfig, XPrompt (showXPrompt), mkXPromptWithReturn, mkComplFunFromList, ComplFunction)
    import XMonad.Util.Parser
    import XMonad.Util.XSelection (getSelection)
    import XMonad.Util.Run

    import Control.DeepSeq (deepseq)
    import qualified Data.List.NonEmpty as NE (head)
    import Data.Time (Day (ModifiedJulianDay), NominalDiffTime, UTCTime (utctDay), addUTCTime, fromGregorian, getCurrentTime, nominalDay, toGregorian)
    #if MIN_VERSION_time(1, 9, 0)
    import Data.Time.Format.ISO8601 (iso8601Show)
    #else
    import Data.Time.Format (defaultTimeLocale, formatTime, iso8601DateFormat)
    #endif
    import GHC.Natural (Natural)
    import System.IO (IOMode (AppendMode, ReadMode), hClose, hGetContents, openFile, 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@ or @HHMM@ 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.

    Finally, 'orgPromptRefile' and 'orgPromptRefileTo' provide support to
    automatically
    <https://orgmode.org/manual/Refile-and-Copy.html refile>
    the generated item under a heading of choice.  For example, binding

    > orgPromptRefile def "TODO" "todos.org"

    to a key will first pop up an ordinary prompt that works exactly like
    'orgPrompt', and then query the user for an already existing heading
    (with completions) as provided by the @~/todos.org@ file.  If that
    prompt is cancelled, the heading will appear in the org file as normal
    (i.e., at the end of the file); otherwise, it gets refiled under the
    selected heading.

    -}

    {- 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 -> [Char]
    todoHeader :: String    -- ^ Will display like @* todoHeader @
      , OrgMode -> [Char]
    orgFile    :: FilePath
      }

    mkOrgCfg :: ClipboardSupport -> String -> FilePath -> X OrgMode
    mkOrgCfg :: ClipboardSupport -> [Char] -> [Char] -> X OrgMode
    mkOrgCfg ClipboardSupport
    clp [Char]
    header [Char]
    fp = ClipboardSupport -> [Char] -> [Char] -> OrgMode
    OrgMode ClipboardSupport
    clp [Char]
    header ([Char] -> OrgMode) -> X [Char] -> X OrgMode
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> [Char] -> X [Char]
    forall (m :: * -> *). MonadIO m => [Char] -> m [Char]
    mkAbsolutePath [Char]
    fp

    -- | 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 -> [Char]
    showXPrompt OrgMode{ [Char]
    todoHeader :: OrgMode -> [Char]
    todoHeader :: [Char]
    todoHeader, [Char]
    orgFile :: OrgMode -> [Char]
    orgFile :: [Char]
    orgFile, ClipboardSupport
    clpSupport :: OrgMode -> ClipboardSupport
    clpSupport :: ClipboardSupport
    clpSupport } =
        [[Char]] -> [Char]
    forall a. Monoid a => [a] -> a
    mconcat [[Char]
    "Add ", [Char]
    todoHeader, [Char]
    clp, [Char]
    " to ", [Char]
    orgFile, [Char]
    ": "]
       where
        [Char]
    clp :: String = case ClipboardSupport
    clpSupport of
          ClipboardSupport
    NoClpSupport     -> [Char]
    ""
          ClipboardSupport
    PrimarySelection -> [Char]
    " + 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 -> [Char] -> [Char] -> X ()
    orgPrompt XPConfig
    xpc = (X Bool -> X ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (X Bool -> X ()) -> (OrgMode -> X Bool) -> OrgMode -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPConfig -> OrgMode -> X Bool
    mkOrgPrompt XPConfig
    xpc (OrgMode -> X ()) -> X OrgMode -> X ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (X OrgMode -> X ())
    -> ([Char] -> [Char] -> X OrgMode) -> [Char] -> [Char] -> X ()
    forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: ClipboardSupport -> [Char] -> [Char] -> X OrgMode
    mkOrgCfg 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 -> [Char] -> [Char] -> X ()
    orgPromptPrimary XPConfig
    xpc = (X Bool -> X ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (X Bool -> X ()) -> (OrgMode -> X Bool) -> OrgMode -> X ()
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . XPConfig -> OrgMode -> X Bool
    mkOrgPrompt XPConfig
    xpc (OrgMode -> X ()) -> X OrgMode -> X ()
    forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
    =<<) (X OrgMode -> X ())
    -> ([Char] -> [Char] -> X OrgMode) -> [Char] -> [Char] -> X ()
    forall a b c d. (a -> b) -> (c -> d -> a) -> c -> d -> b
    .: ClipboardSupport -> [Char] -> [Char] -> X OrgMode
    mkOrgCfg ClipboardSupport
    PrimarySelection

    -- | Internal type in order to generate a nice prompt in
    -- 'orgPromptRefile' and 'orgPromptRefileTo'.
    data RefilePrompt = Refile
    instance XPrompt RefilePrompt where
      showXPrompt :: RefilePrompt -> String
      showXPrompt :: RefilePrompt -> [Char]
    showXPrompt RefilePrompt
    Refile = [Char]
    "Refile note to: "

    -- | Like 'orgPrompt' (which see for the other arguments), but offer to
    -- refile the entered note afterwards.
    --
    -- Note that refiling is done by shelling out to Emacs, hence an @emacs@
    -- binary must be in @$PATH@.  One may customise this by following the
    -- instructions in "XMonad.Util.Run#g:EDSL"; more specifically, by
    -- changing the 'XMonad.Util.Run.emacs' field of
    -- 'XMonad.Util.Run.ProcessConfig'.
    orgPromptRefile :: XPConfig -> String -> FilePath -> X ()
    orgPromptRefile :: XPConfig -> [Char] -> [Char] -> X ()
    orgPromptRefile XPConfig
    xpc [Char]
    str [Char]
    fp = do
      OrgMode
    orgCfg <- ClipboardSupport -> [Char] -> [Char] -> X OrgMode
    mkOrgCfg ClipboardSupport
    NoClpSupport [Char]
    str [Char]
    fp

      -- NOTE: Ideally we would just use System.IO.readFile' here
      -- (especially because it also reads everything strictly), but this is
      -- only available starting in base 4.15.x.
      [Char]
    fileContents <- IO [Char] -> X [Char]
    forall (m :: * -> *) a. MonadIO m => IO a -> m a
    io (IO [Char] -> X [Char]) -> IO [Char] -> X [Char]
    forall a b. (a -> b) -> a -> b
    $ do
        Handle
    handle   <- [Char] -> IOMode -> IO Handle
    openFile (OrgMode -> [Char]
    orgFile OrgMode
    orgCfg) IOMode
    ReadMode
        [Char]
    contents <- Handle -> IO [Char]
    hGetContents Handle
    handle
        [Char]
    contents [Char] -> IO () -> IO [Char]
    forall a b. a -> IO b -> IO a
    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
    <$ ([Char]
    contents [Char] -> IO () -> IO ()
    forall a b. NFData a => a -> b -> b
    `deepseq` Handle -> IO ()
    hClose Handle
    handle)

      -- Save the entry as soon as possible.
      Bool
    notCancelled <- XPConfig -> OrgMode -> X Bool
    mkOrgPrompt XPConfig
    xpc OrgMode
    orgCfg
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    notCancelled (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $
        -- If the user didn't cancel, try to parse the org file and offer to
        -- refile the entry if possible.
        Maybe [Heading] -> ([Heading] -> X ()) -> X ()
    forall (m :: * -> *) a. Monad m => Maybe a -> (a -> m ()) -> m ()
    whenJust (Parser [Heading] -> [Char] -> Maybe [Heading]
    forall a. Parser a -> [Char] -> Maybe a
    runParser Parser [Heading]
    pOrgFile [Char]
    fileContents) (([Heading] -> X ()) -> X ()) -> ([Heading] -> X ()) -> X ()
    forall a b. (a -> b) -> a -> b
    $ \[Heading]
    headings ->
          RefilePrompt
    -> XPConfig
    -> ComplFunction
    -> ([Char] -> X [Char])
    -> X (Maybe [Char])
    forall p a.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> ([Char] -> X a) -> X (Maybe a)
    mkXPromptWithReturn RefilePrompt
    Refile XPConfig
    xpc ([Heading] -> ComplFunction
    completeHeadings [Heading]
    headings) [Char] -> X [Char]
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure X (Maybe [Char]) -> (Maybe [Char] -> X ()) -> X ()
    forall a b. X a -> (a -> X b) -> X b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \case
            Maybe [Char]
    Nothing     -> () -> X ()
    forall a. a -> X a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ()
            Just [Char]
    parent -> [Char] -> [Char] -> X ()
    refile [Char]
    parent (OrgMode -> [Char]
    orgFile OrgMode
    orgCfg)
     where
      completeHeadings :: [Heading] -> ComplFunction
      completeHeadings :: [Heading] -> ComplFunction
    completeHeadings = XPConfig -> [[Char]] -> ComplFunction
    mkComplFunFromList XPConfig
    xpc ([[Char]] -> ComplFunction)
    -> ([Heading] -> [[Char]]) -> [Heading] -> ComplFunction
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (Heading -> [Char]) -> [Heading] -> [[Char]]
    forall a b. (a -> b) -> [a] -> [b]
    map Heading -> [Char]
    headingText

    -- | Like 'orgPromptRefile', but with a fixed heading for refiling; no
    -- prompt will appear to query for a target.
    --
    -- Heading names may omit tags, but generally need to be prefixed by the
    -- correct todo keywords; e.g.,
    --
    -- > orgPromptRefileTo def "PROJECT Work" "TODO" "~/todos.org"
    --
    -- Will refile the created note @"TODO <text>"@ to the @"PROJECT Work"@
    -- heading, even with the actual name is @"PROJECT Work
    -- :work:other_tags:"@.  Just entering @"Work"@ will not work, as Emacs
    -- doesn't recognise @"PROJECT"@ as an Org keyword by default (i.e. when
    -- started in batch-mode).
    orgPromptRefileTo
      :: XPConfig
      -> String     -- ^ Heading to refile the entry under.
      -> String
      -> FilePath
      -> X ()
    orgPromptRefileTo :: XPConfig -> [Char] -> [Char] -> [Char] -> X ()
    orgPromptRefileTo XPConfig
    xpc [Char]
    refileHeading [Char]
    str [Char]
    fp = do
      OrgMode
    orgCfg       <- ClipboardSupport -> [Char] -> [Char] -> X OrgMode
    mkOrgCfg ClipboardSupport
    NoClpSupport [Char]
    str [Char]
    fp
      Bool
    notCancelled <- XPConfig -> OrgMode -> X Bool
    mkOrgPrompt XPConfig
    xpc OrgMode
    orgCfg
      Bool -> X () -> X ()
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
    when Bool
    notCancelled (X () -> X ()) -> X () -> X ()
    forall a b. (a -> b) -> a -> b
    $ [Char] -> [Char] -> X ()
    refile [Char]
    refileHeading (OrgMode -> [Char]
    orgFile OrgMode
    orgCfg)

    -- | Create the actual prompt.  Returns 'False' when the input was
    -- cancelled by the user (by, for example, pressing @Esc@ or @C-g@) and
    -- 'True' otherwise.
    mkOrgPrompt :: XPConfig -> OrgMode -> X Bool
    mkOrgPrompt :: XPConfig -> OrgMode -> X Bool
    mkOrgPrompt XPConfig
    xpc oc :: OrgMode
    oc@OrgMode{ [Char]
    todoHeader :: OrgMode -> [Char]
    todoHeader :: [Char]
    todoHeader, [Char]
    orgFile :: OrgMode -> [Char]
    orgFile :: [Char]
    orgFile, ClipboardSupport
    clpSupport :: OrgMode -> ClipboardSupport
    clpSupport :: ClipboardSupport
    clpSupport } =
      Maybe () -> Bool
    forall a. Maybe a -> Bool
    isJust (Maybe () -> Bool) -> X (Maybe ()) -> X Bool
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> OrgMode
    -> XPConfig -> ComplFunction -> ([Char] -> X ()) -> X (Maybe ())
    forall p a.
    XPrompt p =>
    p -> XPConfig -> ComplFunction -> ([Char] -> X a) -> X (Maybe a)
    mkXPromptWithReturn OrgMode
    oc XPConfig
    xpc (IO [[Char]] -> ComplFunction
    forall a b. a -> b -> a
    const ([[Char]] -> IO [[Char]]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure [])) [Char] -> 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 :: [Char] -> X ()
    appendNote [Char]
    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
    $ [Char] -> Clp
    Body [Char]
    ""
          ClipboardSupport
    PrimarySelection -> do
            [Char]
    sel <- IO [Char]
    forall (m :: * -> *). MonadIO m => m [Char]
    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   ([Char] -> Bool) -> [[Char]] -> Bool
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
    any ([Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    sel) [[Char]
    "http://", [Char]
    "https://"]
                   then [Char] -> Clp
    Header [Char]
    sel
                   else [Char] -> Clp
    Body   ([Char] -> Clp) -> [Char] -> Clp
    forall a b. (a -> b) -> a -> b
    $ [Char]
    "\n " [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    sel

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

    ------------------------------------------------------------------------
    -- Refiling

    -- | Let Emacs do the refiling, as this seems—and I know how this
    -- sounds—more robust than trying to do it ad-hoc in this module.
    refile :: String -> FilePath -> X ()
    refile :: [Char] -> [Char] -> X ()
    refile ([Char] -> [Char]
    asString -> [Char]
    parent) ([Char] -> [Char]
    asString -> [Char]
    fp) =
      X ([Char] -> [Char]) -> X ()
    proc (X ([Char] -> [Char]) -> X ()) -> X ([Char] -> [Char]) -> X ()
    forall a b. (a -> b) -> a -> b
    $ X ([Char] -> [Char])
    inEmacs
         X ([Char] -> [Char])
    -> X ([Char] -> [Char]) -> X ([Char] -> [Char])
    >-> X ([Char] -> [Char])
    asBatch
         X ([Char] -> [Char])
    -> X ([Char] -> [Char]) -> X ([Char] -> [Char])
    >-> [Char] -> X ([Char] -> [Char])
    eval ([[Char]] -> [Char]
    progn [ [Char]
    "find-file" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    fp
                         , [Char]
    "end-of-buffer"
                         , [Char]
    "org-refile nil nil"
                             [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [[Char]] -> [Char]
    list [ [Char]
    parent
                                     , [Char]
    fp
                                     , [Char]
    "nil"
                                     , [[Char]] -> [Char]
    saveExcursion [[Char]
    "org-find-exact-headline-in-buffer"
                                                        [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    parent]
                                     ]
                         , [Char]
    "save-buffer"
                         ])

    ------------------------------------------------------------------------
    -- 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 -> [Char] -> [Char]
    [Time] -> [Char] -> [Char]
    Time -> [Char]
    (Int -> Time -> [Char] -> [Char])
    -> (Time -> [Char]) -> ([Time] -> [Char] -> [Char]) -> Show Time
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Time -> [Char] -> [Char]
    showsPrec :: Int -> Time -> [Char] -> [Char]
    $cshow :: Time -> [Char]
    show :: Time -> [Char]
    $cshowList :: [Time] -> [Char] -> [Char]
    showList :: [Time] -> [Char] -> [Char]
    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 -> [Char]
    show (TimeOfDay Int
    h Int
    m) = Int -> [Char]
    pad Int
    h [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> [Char]
    ":" [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    pad Int
    m
       where
        pad :: Int -> String
        pad :: Int -> [Char]
    pad Int
    n = (if Int
    n Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    9 then [Char]
    "0" else [Char]
    "") [Char] -> [Char] -> [Char]
    forall a. Semigroup a => a -> a -> a
    <> Int -> [Char]
    forall a. Show a => a -> [Char]
    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 -> [Char] -> [Char]
    [Date] -> [Char] -> [Char]
    Date -> [Char]
    (Int -> Date -> [Char] -> [Char])
    -> (Date -> [Char]) -> ([Date] -> [Char] -> [Char]) -> Show Date
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Date -> [Char] -> [Char]
    showsPrec :: Int -> Date -> [Char] -> [Char]
    $cshow :: Date -> [Char]
    show :: Date -> [Char]
    $cshowList :: [Date] -> [Char] -> [Char]
    showList :: [Date] -> [Char] -> [Char]
    Show)

    toOrgFmt :: Maybe TimeOfDay -> Day -> String
    toOrgFmt :: Maybe TimeOfDay -> Day -> [Char]
    toOrgFmt Maybe TimeOfDay
    tod Day
    day =
      [[Char]] -> [Char]
    forall a. Monoid a => [a] -> a
    mconcat [[Char]
    "<", [Char]
    isoDay, [Char]
    " ", Int -> [Char] -> [Char]
    forall a. Int -> [a] -> [a]
    take Int
    3 ([Char] -> [Char]) -> [Char] -> [Char]
    forall a b. (a -> b) -> a -> b
    $ DayOfWeek -> [Char]
    forall a. Show a => a -> [Char]
    show (Day -> DayOfWeek
    dayOfWeek Day
    day), [Char]
    time, [Char]
    ">"]
     where
      [Char]
    time   :: String = [Char] -> (TimeOfDay -> [Char]) -> Maybe TimeOfDay -> [Char]
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe [Char]
    "" ((Char
    ' ' Char -> [Char] -> [Char]
    forall a. a -> [a] -> [a]
    :) ([Char] -> [Char]) -> (TimeOfDay -> [Char]) -> TimeOfDay -> [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . TimeOfDay -> [Char]
    forall a. Show a => a -> [Char]
    show) Maybe TimeOfDay
    tod
    #if MIN_VERSION_time(1, 9, 0)
      [Char]
    isoDay :: String = Day -> [Char]
    forall t. ISO8601 t => t -> [Char]
    iso8601Show Day
    day
    #else
      isoDay :: String = formatTime defaultTimeLocale (iso8601DateFormat Nothing) day
    #endif

    -- | Pretty print a 'Date' and an optional time to reflect the actual
    -- date.
    ppDate :: Time -> IO String
    ppDate :: Time -> IO [Char]
    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)

      [Char] -> IO [Char]
    forall a. a -> IO a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure ([Char] -> IO [Char]) -> (Day -> [Char]) -> Day -> IO [Char]
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Maybe TimeOfDay -> Day -> [Char]
    toOrgFmt Maybe TimeOfDay
    tod (Day -> IO [Char]) -> Day -> IO [Char]
    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 -> [Char] -> [Char]
    [DayOfWeek] -> [Char] -> [Char]
    DayOfWeek -> [Char]
    (Int -> DayOfWeek -> [Char] -> [Char])
    -> (DayOfWeek -> [Char])
    -> ([DayOfWeek] -> [Char] -> [Char])
    -> Show DayOfWeek
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> DayOfWeek -> [Char] -> [Char]
    showsPrec :: Int -> DayOfWeek -> [Char] -> [Char]
    $cshow :: DayOfWeek -> [Char]
    show :: DayOfWeek -> [Char]
    $cshowList :: [DayOfWeek] -> [Char] -> [Char]
    showList :: [DayOfWeek] -> [Char] -> [Char]
    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 -> [Char] -> [Char]
    [Note] -> [Char] -> [Char]
    Note -> [Char]
    (Int -> Note -> [Char] -> [Char])
    -> (Note -> [Char]) -> ([Note] -> [Char] -> [Char]) -> Show Note
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Note -> [Char] -> [Char]
    showsPrec :: Int -> Note -> [Char] -> [Char]
    $cshow :: Note -> [Char]
    show :: Note -> [Char]
    $cshowList :: [Note] -> [Char] -> [Char]
    showList :: [Note] -> [Char] -> [Char]
    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 -> [Char] -> [Char]
    [Priority] -> [Char] -> [Char]
    Priority -> [Char]
    (Int -> Priority -> [Char] -> [Char])
    -> (Priority -> [Char])
    -> ([Priority] -> [Char] -> [Char])
    -> Show Priority
    forall a.
    (Int -> a -> [Char] -> [Char])
    -> (a -> [Char]) -> ([a] -> [Char] -> [Char]) -> Show a
    $cshowsPrec :: Int -> Priority -> [Char] -> [Char]
    showsPrec :: Int -> Priority -> [Char] -> [Char]
    $cshow :: Priority -> [Char]
    show :: Priority -> [Char]
    $cshowList :: [Priority] -> [Char] -> [Char]
    showList :: [Priority] -> [Char] -> [Char]
    Show)

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

    ------------------------------------------------------------------------
    -- Note parsing

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

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

    -- | Parse a 'Priority'.
    pPriority :: Parser Priority
    pPriority :: Parser Priority
    pPriority = Priority -> Parser Priority -> Parser Priority
    forall a. a -> Parser a -> Parser a
    option Priority
    NoPriority (Parser Priority -> Parser Priority)
    -> Parser Priority -> Parser Priority
    forall a b. (a -> b) -> a -> b
    $
      Parser [Char]
    " " Parser [Char] -> 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 [Char]
    "#" Parser [Char] -> Parser [Char] -> Parser [Char]
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Char] -> Parser [Char]
    foldCase [Char]
    "a" Parser [Char] -> Priority -> Parser Priority
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Priority
    A
        , Parser [Char]
    "#" Parser [Char] -> Parser [Char] -> Parser [Char]
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Char] -> Parser [Char]
    foldCase [Char]
    "b" Parser [Char] -> Priority -> Parser Priority
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> Priority
    B
        , Parser [Char]
    "#" Parser [Char] -> Parser [Char] -> Parser [Char]
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> [Char] -> Parser [Char]
    foldCase [Char]
    "c" Parser [Char] -> 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 = Maybe TimeOfDay
    -> Parser (Maybe TimeOfDay) -> Parser (Maybe TimeOfDay)
    forall a. a -> Parser a -> Parser a
    option 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 (m :: * -> *) a b. Monad m => m a -> m b -> m b
    >> 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
    <$> [Parser TimeOfDay] -> Parser TimeOfDay
    forall a. [Parser a] -> Parser a
    choice
        [ 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 [Char] -> Parser (Int -> TimeOfDay)
    forall a b. Parser a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser [Char]
    ":" 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
        , Parser TimeOfDay
    pHHMM                                  -- HHMM
        , 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
      pHHMM :: Parser TimeOfDay
      pHHMM :: Parser TimeOfDay
    pHHMM = do
        let getTwo :: Parser [Char]
    getTwo = Int -> Parser Char -> Parser [Char]
    forall a. Int -> Parser a -> Parser [a]
    count Int
    2 ((Char -> Bool) -> Parser Char
    satisfy Char -> Bool
    isDigit)
        Int
    hh <- [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int) -> Parser [Char] -> Parser Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser [Char]
    getTwo
        Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Int
    hh Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    hh Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    23)
        Int
    mm <- [Char] -> Int
    forall a. Read a => [Char] -> a
    read ([Char] -> Int) -> Parser [Char] -> Parser Int
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Parser [Char]
    getTwo
        Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard (Int
    mm Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    >= Int
    0 Bool -> Bool -> Bool
    && Int
    mm Int -> Int -> Bool
    forall a. Ord a => a -> a -> Bool
    <= Int
    59)
        TimeOfDay -> Parser TimeOfDay
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure (TimeOfDay -> Parser TimeOfDay) -> TimeOfDay -> Parser TimeOfDay
    forall a b. (a -> b) -> a -> b
    $ Int -> Int -> TimeOfDay
    TimeOfDay Int
    hh Int
    mm
      Parser Int
    pHour   :: Parser Int = Int -> Int -> Parser Int
    pNumBetween Int
    0 Int
    23
      Parser Int
    pMinute :: Parser Int = Int -> Int -> Parser Int
    pNumBetween Int
    0 Int
    59

    -- | 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
      [ [Char] -> [Char] -> Date -> Parser Date
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "tod" [Char]
    "ay"    Date
    Today
      , [Char] -> [Char] -> Date -> Parser Date
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "tom" [Char]
    "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
        [ [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "m"  [Char]
    "onday"    DayOfWeek
    Monday   , [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "tu" [Char]
    "esday"  DayOfWeek
    Tuesday
        , [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "w"  [Char]
    "ednesday" DayOfWeek
    Wednesday, [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "th" [Char]
    "ursday" DayOfWeek
    Thursday
        , [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "f"  [Char]
    "riday"    DayOfWeek
    Friday   , [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "sa" [Char]
    "turday" DayOfWeek
    Saturday
        , [Char] -> [Char] -> DayOfWeek -> Parser DayOfWeek
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "su" [Char]
    "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
                   [ [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "ja"  [Char]
    "nuary"    Int
    1 , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "f"   [Char]
    "ebruary" Int
    2
                   , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "mar" [Char]
    "ch"       Int
    3 , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "ap"  [Char]
    "ril"     Int
    4
                   , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "may" [Char]
    ""         Int
    5 , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "jun" [Char]
    "e"       Int
    6
                   , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "jul" [Char]
    "y"        Int
    7 , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "au"  [Char]
    "gust"    Int
    8
                   , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "s"   [Char]
    "eptember" Int
    9 , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "o"   [Char]
    "ctober"  Int
    10
                   , [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "n"   [Char]
    "ovember"  Int
    11, [Char] -> [Char] -> Int -> Parser Int
    forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    "d"   [Char]
    "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 :: String -> String -> a -> Parser a
      pPrefix :: forall a. [Char] -> [Char] -> a -> Parser a
    pPrefix [Char]
    start ((Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower -> [Char]
    leftover) a
    ret = do
        Parser [Char] -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void ([Char] -> Parser [Char]
    foldCase [Char]
    start)
        [Char]
    l <- (Char -> Char) -> [Char] -> [Char]
    forall a b. (a -> b) -> [a] -> [b]
    map Char -> Char
    toLower ([Char] -> [Char]) -> Parser [Char] -> Parser [Char]
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Bool) -> Parser [Char]
    munch (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    ' ')
        Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ([Char]
    l [Char] -> [Char] -> Bool
    forall a. Eq a => [a] -> [a] -> Bool
    `isPrefixOf` [Char]
    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)

    -- Parse the given string case insensitively.
    foldCase :: String -> Parser String
    foldCase :: [Char] -> Parser [Char]
    foldCase = (Char -> Parser Char) -> [Char] -> Parser [Char]
    forall (t :: * -> *) (f :: * -> *) a b.
    (Traversable t, Applicative f) =>
    (a -> f b) -> t a -> f (t b)
    forall (f :: * -> *) a b.
    Applicative f =>
    (a -> f b) -> [a] -> f [b]
    traverse (\Char
    c -> Char -> Parser Char
    char (Char -> Char
    toLower Char
    c) Parser Char -> Parser Char -> Parser Char
    forall a. Parser a -> Parser a -> Parser a
    forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
    <|> Char -> Parser Char
    char (Char -> Char
    toUpper Char
    c))

    ------------------------------------------------------------------------
    -- File parsing

    data Heading = Heading
      { Heading -> Natural
    level       :: Natural
        -- ^ Level of the Org heading; i.e., the number of leading stars.
      , Heading -> [Char]
    headingText :: String
        -- ^ The heading text without its level.
      }

    -- | Naïvely parse an Org file.  At this point, only the headings are
    -- parsed into a non-nested list (ignoring parent-child relations); no
    -- further analysis is done on the individual lines themselves.
    pOrgFile :: Parser [Heading]
    pOrgFile :: Parser [Heading]
    pOrgFile = Parser Heading -> Parser [Heading]
    forall a. Parser a -> Parser [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many Parser Heading
    pHeading

    pHeading :: Parser Heading
    pHeading :: Parser Heading
    pHeading = Parser ()
    skipSpaces Parser () -> Parser Heading -> Parser Heading
    forall a b. Parser a -> Parser b -> Parser b
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
    *> do
      Natural
    level       <- [Char] -> Natural
    forall i a. Num i => [a] -> i
    genericLength ([Char] -> Natural) -> Parser [Char] -> Parser Natural
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> (Char -> Bool) -> Parser [Char]
    munch1 (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    == Char
    '*') Parser Natural -> Parser [Char] -> Parser Natural
    forall a b. Parser a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser [Char]
    " "
      [Char]
    headingText <- Parser [Char]
    pLine
      Parser [[Char]] -> Parser ()
    forall (f :: * -> *) a. Functor f => f a -> f ()
    void (Parser [[Char]] -> Parser ()) -> Parser [[Char]] -> Parser ()
    forall a b. (a -> b) -> a -> b
    $ Parser [Char] -> Parser [[Char]]
    forall a. Parser a -> Parser [a]
    forall (f :: * -> *) a. Alternative f => f a -> f [a]
    many (Parser [Char]
    pLine Parser [Char] -> ([Char] -> Parser [Char]) -> Parser [Char]
    forall a b. Parser a -> (a -> Parser b) -> Parser b
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
    >>= \[Char]
    line -> Bool -> Parser ()
    forall (f :: * -> *). Alternative f => Bool -> f ()
    guard ([Char] -> Bool
    isNotHeading [Char]
    line) Parser () -> [Char] -> Parser [Char]
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> [Char]
    line) -- skip body
      Heading -> Parser Heading
    forall a. a -> Parser a
    forall (f :: * -> *) a. Applicative f => a -> f a
    pure Heading{Natural
    [Char]
    headingText :: [Char]
    level :: Natural
    level :: Natural
    headingText :: [Char]
    ..}

    pLine :: Parser String
    pLine :: Parser [Char]
    pLine = (Char -> Bool) -> Parser [Char]
    munch (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '\n') Parser [Char] -> Parser [Char] -> Parser [Char]
    forall a b. Parser a -> Parser b -> Parser a
    forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
    <* Parser [Char]
    "\n"

    isNotHeading :: String -> Bool
    isNotHeading :: [Char] -> Bool
    isNotHeading [Char]
    str = case (Char -> Bool) -> [Char] -> ([Char], [Char])
    forall a. (a -> Bool) -> [a] -> ([a], [a])
    break (Char -> Char -> Bool
    forall a. Eq a => a -> a -> Bool
    /= Char
    '*') [Char]
    str of
      ([Char]
    "", [Char]
    _)       -> Bool
    True
      ([Char]
    _ , Char
    ' ' : [Char]
    _) -> Bool
    False
      ([Char], [Char])
    _             -> Bool
    True