{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE TupleSections      #-}
{-# OPTIONS_GHC -Wno-incomplete-patterns #-}

-- |
-- Module    : Data.Org
-- Copyright : (c) Colin Woodbury, 2020 - 2021
-- License   : BSD3
-- Maintainer: Colin Woodbury <colin@fosskers.ca>
--
-- This library parses text in the <https://orgmode.org/ Emacs Org Mode> format.
--
-- Use the `org` function to parse a `T.Text` value.

module Data.Org
  ( -- * Types
    -- ** Top-level
    OrgFile(..)
  , emptyOrgFile
  , OrgDoc(..)
  , emptyDoc
  , allDocTags
    -- ** Timestamps
  , OrgDateTime(..)
  , OrgTime(..)
  , Repeater(..)
  , RepeatMode(..)
  , Delay(..)
  , DelayMode(..)
  , Interval(..)
    -- ** Markup
  , Section(..)
  , titled
  , allSectionTags
  , Todo(..)
  , Priority(..)
  , Block(..)
  , Words(..)
  , ListItems(..)
  , ListType(..)
  , Item(..)
  , Row(..)
  , Column(..)
  , URL(..)
  , Language(..)
    -- * Parsing
  , org
    -- ** Internal Parsers
    -- | These are exposed for testing purposes.
  , orgFile
  , meta
  , orgP
  , section
  , properties
  , property
  , paragraph
  , table
  , list
  , line
  , timestamp
  , date
  , timeRange
  , repeater
    -- * Pretty Printing
  , prettyOrgFile
  , prettyOrg
  , prettyWords
  ) where

import           Control.Applicative.Combinators.NonEmpty
import           Control.Monad (void, when)
import           Data.Bool (bool)
import           Data.Char (isDigit)
import           Data.Functor (($>))
import           Data.Hashable (Hashable)
import           Data.List.NonEmpty (NonEmpty(..))
import qualified Data.List.NonEmpty as NEL
import qualified Data.Map.Strict as M
import           Data.Maybe (catMaybes, fromMaybe)
import           Data.Semigroup (sconcat)
import qualified Data.Set as S
import           Data.Text (Text)
import qualified Data.Text as T
import           Data.Time (Day, TimeOfDay(..), fromGregorian, showGregorian)
import           Data.Time.Calendar (DayOfWeek(..))
import           Data.Void (Void)
import           GHC.Generics (Generic)
import           System.FilePath (takeExtension)
import           Text.Megaparsec hiding (sepBy1, sepEndBy1, some, someTill)
import           Text.Megaparsec.Char
import qualified Text.Megaparsec.Char.Lexer as L
import           Text.Megaparsec.Char.Lexer (decimal)
import           Text.Printf (printf)

--------------------------------------------------------------------------------
-- Types

-- | A complete @.org@ file with metadata.
data OrgFile = OrgFile
  { OrgFile -> Map Text Text
orgMeta :: M.Map Text Text
  -- ^ Top-level fields like:
  --
  -- @
  -- #+TITLE: Curing Cancer with Haskell
  -- #+DATE: 2020-02-25
  -- #+AUTHOR: Colin
  -- @
  , OrgFile -> OrgDoc
orgDoc  :: OrgDoc }
  deriving stock (OrgFile -> OrgFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgFile -> OrgFile -> Bool
$c/= :: OrgFile -> OrgFile -> Bool
== :: OrgFile -> OrgFile -> Bool
$c== :: OrgFile -> OrgFile -> Bool
Eq, Eq OrgFile
OrgFile -> OrgFile -> Bool
OrgFile -> OrgFile -> Ordering
OrgFile -> OrgFile -> OrgFile
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
min :: OrgFile -> OrgFile -> OrgFile
$cmin :: OrgFile -> OrgFile -> OrgFile
max :: OrgFile -> OrgFile -> OrgFile
$cmax :: OrgFile -> OrgFile -> OrgFile
>= :: OrgFile -> OrgFile -> Bool
$c>= :: OrgFile -> OrgFile -> Bool
> :: OrgFile -> OrgFile -> Bool
$c> :: OrgFile -> OrgFile -> Bool
<= :: OrgFile -> OrgFile -> Bool
$c<= :: OrgFile -> OrgFile -> Bool
< :: OrgFile -> OrgFile -> Bool
$c< :: OrgFile -> OrgFile -> Bool
compare :: OrgFile -> OrgFile -> Ordering
$ccompare :: OrgFile -> OrgFile -> Ordering
Ord, Int -> OrgFile -> ShowS
[OrgFile] -> ShowS
OrgFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgFile] -> ShowS
$cshowList :: [OrgFile] -> ShowS
show :: OrgFile -> String
$cshow :: OrgFile -> String
showsPrec :: Int -> OrgFile -> ShowS
$cshowsPrec :: Int -> OrgFile -> ShowS
Show, forall x. Rep OrgFile x -> OrgFile
forall x. OrgFile -> Rep OrgFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgFile x -> OrgFile
$cfrom :: forall x. OrgFile -> Rep OrgFile x
Generic)

emptyOrgFile :: OrgFile
emptyOrgFile :: OrgFile
emptyOrgFile = Map Text Text -> OrgDoc -> OrgFile
OrgFile forall a. Monoid a => a
mempty OrgDoc
emptyDoc

-- | A recursive Org document. These are zero or more blocks of markup, followed
-- by zero or more subsections.
--
-- @
-- This is some top-level text.
--
-- * Important heading
--
-- ** Less important subheading
-- @
data OrgDoc = OrgDoc
  { OrgDoc -> [Block]
docBlocks   :: [Block]
  , OrgDoc -> [Section]
docSections :: [Section] }
  deriving stock (OrgDoc -> OrgDoc -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgDoc -> OrgDoc -> Bool
$c/= :: OrgDoc -> OrgDoc -> Bool
== :: OrgDoc -> OrgDoc -> Bool
$c== :: OrgDoc -> OrgDoc -> Bool
Eq, Eq OrgDoc
OrgDoc -> OrgDoc -> Bool
OrgDoc -> OrgDoc -> Ordering
OrgDoc -> OrgDoc -> OrgDoc
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
min :: OrgDoc -> OrgDoc -> OrgDoc
$cmin :: OrgDoc -> OrgDoc -> OrgDoc
max :: OrgDoc -> OrgDoc -> OrgDoc
$cmax :: OrgDoc -> OrgDoc -> OrgDoc
>= :: OrgDoc -> OrgDoc -> Bool
$c>= :: OrgDoc -> OrgDoc -> Bool
> :: OrgDoc -> OrgDoc -> Bool
$c> :: OrgDoc -> OrgDoc -> Bool
<= :: OrgDoc -> OrgDoc -> Bool
$c<= :: OrgDoc -> OrgDoc -> Bool
< :: OrgDoc -> OrgDoc -> Bool
$c< :: OrgDoc -> OrgDoc -> Bool
compare :: OrgDoc -> OrgDoc -> Ordering
$ccompare :: OrgDoc -> OrgDoc -> Ordering
Ord, Int -> OrgDoc -> ShowS
[OrgDoc] -> ShowS
OrgDoc -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgDoc] -> ShowS
$cshowList :: [OrgDoc] -> ShowS
show :: OrgDoc -> String
$cshow :: OrgDoc -> String
showsPrec :: Int -> OrgDoc -> ShowS
$cshowsPrec :: Int -> OrgDoc -> ShowS
Show, forall x. Rep OrgDoc x -> OrgDoc
forall x. OrgDoc -> Rep OrgDoc x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OrgDoc x -> OrgDoc
$cfrom :: forall x. OrgDoc -> Rep OrgDoc x
Generic)

emptyDoc :: OrgDoc
emptyDoc :: OrgDoc
emptyDoc = [Block] -> [Section] -> OrgDoc
OrgDoc [] []

-- | All unique section tags in the entire document.
--
-- Section tags appear on the same row as a header title, but right-aligned.
--
-- @
-- * This is a Heading                :tag1:tag2:
-- @
allDocTags :: OrgDoc -> S.Set Text
allDocTags :: OrgDoc -> Set Text
allDocTags = forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> Set Text
allSectionTags forall b c a. (b -> c) -> (a -> b) -> a -> c
. OrgDoc -> [Section]
docSections

-- | Some logically distinct block of Org content.
data Block
  = Quote Text
  | Example Text
  | Code (Maybe Language) Text
  | List ListItems
  | Table (NonEmpty Row)
  | Paragraph (NonEmpty Words)
  deriving stock (Block -> Block -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Block -> Block -> Bool
$c/= :: Block -> Block -> Bool
== :: Block -> Block -> Bool
$c== :: Block -> Block -> Bool
Eq, Eq Block
Block -> Block -> Bool
Block -> Block -> Ordering
Block -> Block -> Block
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
min :: Block -> Block -> Block
$cmin :: Block -> Block -> Block
max :: Block -> Block -> Block
$cmax :: Block -> Block -> Block
>= :: Block -> Block -> Bool
$c>= :: Block -> Block -> Bool
> :: Block -> Block -> Bool
$c> :: Block -> Block -> Bool
<= :: Block -> Block -> Bool
$c<= :: Block -> Block -> Bool
< :: Block -> Block -> Bool
$c< :: Block -> Block -> Bool
compare :: Block -> Block -> Ordering
$ccompare :: Block -> Block -> Ordering
Ord, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Block] -> ShowS
$cshowList :: [Block] -> ShowS
show :: Block -> String
$cshow :: Block -> String
showsPrec :: Int -> Block -> ShowS
$cshowsPrec :: Int -> Block -> ShowS
Show, forall x. Rep Block x -> Block
forall x. Block -> Rep Block x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Block x -> Block
$cfrom :: forall x. Block -> Rep Block x
Generic)

-- | An org-mode timestamp. Must contain at least a year-month-day and the day
-- of the week:
--
-- @
-- \<2021-04-27 Tue\>
-- @
--
-- but also may contain a time:
--
-- @
-- \<2021-04-27 Tue 12:00\>
-- @
--
-- or a time range:
--
-- @
-- \<2021-04-27 Tue 12:00-13:00\>
-- @
--
-- and/or a repeater value:
--
-- @
-- \<2021-04-27 Tue +1w\>
-- @
data OrgDateTime = OrgDateTime
  { OrgDateTime -> Day
dateDay       :: Day
  , OrgDateTime -> DayOfWeek
dateDayOfWeek :: DayOfWeek
  , OrgDateTime -> Maybe OrgTime
dateTime      :: Maybe OrgTime
  , OrgDateTime -> Maybe Repeater
dateRepeat    :: Maybe Repeater
  , OrgDateTime -> Maybe Delay
dateDelay     :: Maybe Delay }
  deriving stock (OrgDateTime -> OrgDateTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgDateTime -> OrgDateTime -> Bool
$c/= :: OrgDateTime -> OrgDateTime -> Bool
== :: OrgDateTime -> OrgDateTime -> Bool
$c== :: OrgDateTime -> OrgDateTime -> Bool
Eq, Int -> OrgDateTime -> ShowS
[OrgDateTime] -> ShowS
OrgDateTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgDateTime] -> ShowS
$cshowList :: [OrgDateTime] -> ShowS
show :: OrgDateTime -> String
$cshow :: OrgDateTime -> String
showsPrec :: Int -> OrgDateTime -> ShowS
$cshowsPrec :: Int -> OrgDateTime -> ShowS
Show)

-- | A lack of a specific `OrgTime` is assumed to mean @00:00@, the earliest
-- possible time for that day.
instance Ord OrgDateTime where
  compare :: OrgDateTime -> OrgDateTime -> Ordering
compare (OrgDateTime Day
d0 DayOfWeek
_ Maybe OrgTime
mt0 Maybe Repeater
_ Maybe Delay
_) (OrgDateTime Day
d1 DayOfWeek
_ Maybe OrgTime
mt1 Maybe Repeater
_ Maybe Delay
_) = case forall a. Ord a => a -> a -> Ordering
compare Day
d0 Day
d1 of
    Ordering
LT -> Ordering
LT
    Ordering
GT -> Ordering
GT
    Ordering
EQ -> case (Maybe OrgTime
mt0, Maybe OrgTime
mt1) of
      (Maybe OrgTime
Nothing, Maybe OrgTime
Nothing) -> Ordering
EQ
      (Just OrgTime
_, Maybe OrgTime
Nothing)  -> Ordering
GT
      (Maybe OrgTime
Nothing, Just OrgTime
_)  -> Ordering
LT
      (Just OrgTime
t0, Just OrgTime
t1) -> forall a. Ord a => a -> a -> Ordering
compare OrgTime
t0 OrgTime
t1

-- | The time portion of the full timestamp. May be a range, as seen in the
-- following full timestamp:
--
-- @
-- \<2021-04-27 Tue 12:00-13:00\>
-- @
data OrgTime = OrgTime
  { OrgTime -> TimeOfDay
timeStart :: TimeOfDay
  , OrgTime -> Maybe TimeOfDay
timeEnd   :: Maybe TimeOfDay }
  deriving stock (OrgTime -> OrgTime -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OrgTime -> OrgTime -> Bool
$c/= :: OrgTime -> OrgTime -> Bool
== :: OrgTime -> OrgTime -> Bool
$c== :: OrgTime -> OrgTime -> Bool
Eq, Eq OrgTime
OrgTime -> OrgTime -> Bool
OrgTime -> OrgTime -> Ordering
OrgTime -> OrgTime -> OrgTime
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
min :: OrgTime -> OrgTime -> OrgTime
$cmin :: OrgTime -> OrgTime -> OrgTime
max :: OrgTime -> OrgTime -> OrgTime
$cmax :: OrgTime -> OrgTime -> OrgTime
>= :: OrgTime -> OrgTime -> Bool
$c>= :: OrgTime -> OrgTime -> Bool
> :: OrgTime -> OrgTime -> Bool
$c> :: OrgTime -> OrgTime -> Bool
<= :: OrgTime -> OrgTime -> Bool
$c<= :: OrgTime -> OrgTime -> Bool
< :: OrgTime -> OrgTime -> Bool
$c< :: OrgTime -> OrgTime -> Bool
compare :: OrgTime -> OrgTime -> Ordering
$ccompare :: OrgTime -> OrgTime -> Ordering
Ord, Int -> OrgTime -> ShowS
[OrgTime] -> ShowS
OrgTime -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OrgTime] -> ShowS
$cshowList :: [OrgTime] -> ShowS
show :: OrgTime -> String
$cshow :: OrgTime -> String
showsPrec :: Int -> OrgTime -> ShowS
$cshowsPrec :: Int -> OrgTime -> ShowS
Show)

-- | An indication of how often a timestamp should be automatically reapplied in
-- the Org Agenda.
data Repeater = Repeater
  { Repeater -> RepeatMode
repMode     :: RepeatMode
  , Repeater -> Word
repValue    :: Word
  , Repeater -> Interval
repInterval :: Interval }
  deriving stock (Repeater -> Repeater -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Repeater -> Repeater -> Bool
$c/= :: Repeater -> Repeater -> Bool
== :: Repeater -> Repeater -> Bool
$c== :: Repeater -> Repeater -> Bool
Eq, Eq Repeater
Repeater -> Repeater -> Bool
Repeater -> Repeater -> Ordering
Repeater -> Repeater -> Repeater
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
min :: Repeater -> Repeater -> Repeater
$cmin :: Repeater -> Repeater -> Repeater
max :: Repeater -> Repeater -> Repeater
$cmax :: Repeater -> Repeater -> Repeater
>= :: Repeater -> Repeater -> Bool
$c>= :: Repeater -> Repeater -> Bool
> :: Repeater -> Repeater -> Bool
$c> :: Repeater -> Repeater -> Bool
<= :: Repeater -> Repeater -> Bool
$c<= :: Repeater -> Repeater -> Bool
< :: Repeater -> Repeater -> Bool
$c< :: Repeater -> Repeater -> Bool
compare :: Repeater -> Repeater -> Ordering
$ccompare :: Repeater -> Repeater -> Ordering
Ord, Int -> Repeater -> ShowS
[Repeater] -> ShowS
Repeater -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Repeater] -> ShowS
$cshowList :: [Repeater] -> ShowS
show :: Repeater -> String
$cshow :: Repeater -> String
showsPrec :: Int -> Repeater -> ShowS
$cshowsPrec :: Int -> Repeater -> ShowS
Show)

-- | The nature of the repitition.
data RepeatMode
  = Single     -- ^ Apply the interval value to the original timestamp once: @+@
  | Jump       -- ^ Apply the interval value as many times as necessary to arrive on a future date: @++@
  | FromToday  -- ^ Apply the interval value from today: @.+@
  deriving stock (RepeatMode -> RepeatMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RepeatMode -> RepeatMode -> Bool
$c/= :: RepeatMode -> RepeatMode -> Bool
== :: RepeatMode -> RepeatMode -> Bool
$c== :: RepeatMode -> RepeatMode -> Bool
Eq, Eq RepeatMode
RepeatMode -> RepeatMode -> Bool
RepeatMode -> RepeatMode -> Ordering
RepeatMode -> RepeatMode -> RepeatMode
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
min :: RepeatMode -> RepeatMode -> RepeatMode
$cmin :: RepeatMode -> RepeatMode -> RepeatMode
max :: RepeatMode -> RepeatMode -> RepeatMode
$cmax :: RepeatMode -> RepeatMode -> RepeatMode
>= :: RepeatMode -> RepeatMode -> Bool
$c>= :: RepeatMode -> RepeatMode -> Bool
> :: RepeatMode -> RepeatMode -> Bool
$c> :: RepeatMode -> RepeatMode -> Bool
<= :: RepeatMode -> RepeatMode -> Bool
$c<= :: RepeatMode -> RepeatMode -> Bool
< :: RepeatMode -> RepeatMode -> Bool
$c< :: RepeatMode -> RepeatMode -> Bool
compare :: RepeatMode -> RepeatMode -> Ordering
$ccompare :: RepeatMode -> RepeatMode -> Ordering
Ord, Int -> RepeatMode -> ShowS
[RepeatMode] -> ShowS
RepeatMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RepeatMode] -> ShowS
$cshowList :: [RepeatMode] -> ShowS
show :: RepeatMode -> String
$cshow :: RepeatMode -> String
showsPrec :: Int -> RepeatMode -> ShowS
$cshowsPrec :: Int -> RepeatMode -> ShowS
Show)

-- | The timestamp repitition unit.
data Interval = Hour | Day | Week | Month | Year
  deriving stock (Interval -> Interval -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Interval -> Interval -> Bool
$c/= :: Interval -> Interval -> Bool
== :: Interval -> Interval -> Bool
$c== :: Interval -> Interval -> Bool
Eq, Eq Interval
Interval -> Interval -> Bool
Interval -> Interval -> Ordering
Interval -> Interval -> Interval
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
min :: Interval -> Interval -> Interval
$cmin :: Interval -> Interval -> Interval
max :: Interval -> Interval -> Interval
$cmax :: Interval -> Interval -> Interval
>= :: Interval -> Interval -> Bool
$c>= :: Interval -> Interval -> Bool
> :: Interval -> Interval -> Bool
$c> :: Interval -> Interval -> Bool
<= :: Interval -> Interval -> Bool
$c<= :: Interval -> Interval -> Bool
< :: Interval -> Interval -> Bool
$c< :: Interval -> Interval -> Bool
compare :: Interval -> Interval -> Ordering
$ccompare :: Interval -> Interval -> Ordering
Ord, Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Interval] -> ShowS
$cshowList :: [Interval] -> ShowS
show :: Interval -> String
$cshow :: Interval -> String
showsPrec :: Int -> Interval -> ShowS
$cshowsPrec :: Int -> Interval -> ShowS
Show)

-- | Delay the appearance of a timestamp in the agenda.
data Delay = Delay
  { Delay -> DelayMode
delayMode     :: DelayMode
  , Delay -> Word
delayValue    :: Word
  , Delay -> Interval
delayInterval :: Interval }
  deriving stock (Delay -> Delay -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Delay -> Delay -> Bool
$c/= :: Delay -> Delay -> Bool
== :: Delay -> Delay -> Bool
$c== :: Delay -> Delay -> Bool
Eq, Eq Delay
Delay -> Delay -> Bool
Delay -> Delay -> Ordering
Delay -> Delay -> Delay
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
min :: Delay -> Delay -> Delay
$cmin :: Delay -> Delay -> Delay
max :: Delay -> Delay -> Delay
$cmax :: Delay -> Delay -> Delay
>= :: Delay -> Delay -> Bool
$c>= :: Delay -> Delay -> Bool
> :: Delay -> Delay -> Bool
$c> :: Delay -> Delay -> Bool
<= :: Delay -> Delay -> Bool
$c<= :: Delay -> Delay -> Bool
< :: Delay -> Delay -> Bool
$c< :: Delay -> Delay -> Bool
compare :: Delay -> Delay -> Ordering
$ccompare :: Delay -> Delay -> Ordering
Ord, Int -> Delay -> ShowS
[Delay] -> ShowS
Delay -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Delay] -> ShowS
$cshowList :: [Delay] -> ShowS
show :: Delay -> String
$cshow :: Delay -> String
showsPrec :: Int -> Delay -> ShowS
$cshowsPrec :: Int -> Delay -> ShowS
Show)

-- | When a repeater is also present, should the delay be for the first value or
-- all of them?
data DelayMode
  = DelayOne  -- ^ As in: @--2d@
  | DelayAll  -- ^ As in: @-2d@
  deriving stock (DelayMode -> DelayMode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DelayMode -> DelayMode -> Bool
$c/= :: DelayMode -> DelayMode -> Bool
== :: DelayMode -> DelayMode -> Bool
$c== :: DelayMode -> DelayMode -> Bool
Eq, Eq DelayMode
DelayMode -> DelayMode -> Bool
DelayMode -> DelayMode -> Ordering
DelayMode -> DelayMode -> DelayMode
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
min :: DelayMode -> DelayMode -> DelayMode
$cmin :: DelayMode -> DelayMode -> DelayMode
max :: DelayMode -> DelayMode -> DelayMode
$cmax :: DelayMode -> DelayMode -> DelayMode
>= :: DelayMode -> DelayMode -> Bool
$c>= :: DelayMode -> DelayMode -> Bool
> :: DelayMode -> DelayMode -> Bool
$c> :: DelayMode -> DelayMode -> Bool
<= :: DelayMode -> DelayMode -> Bool
$c<= :: DelayMode -> DelayMode -> Bool
< :: DelayMode -> DelayMode -> Bool
$c< :: DelayMode -> DelayMode -> Bool
compare :: DelayMode -> DelayMode -> Ordering
$ccompare :: DelayMode -> DelayMode -> Ordering
Ord, Int -> DelayMode -> ShowS
[DelayMode] -> ShowS
DelayMode -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DelayMode] -> ShowS
$cshowList :: [DelayMode] -> ShowS
show :: DelayMode -> String
$cshow :: DelayMode -> String
showsPrec :: Int -> DelayMode -> ShowS
$cshowsPrec :: Int -> DelayMode -> ShowS
Show)

-- | A subsection, marked by a heading line and followed recursively by an
-- `OrgDoc`.
--
-- @
-- * This is a Heading
--
-- This is content in the sub ~OrgDoc~.
-- @
data Section = Section
  { Section -> Maybe Todo
sectionTodo      :: Maybe Todo
  , Section -> Maybe Priority
sectionPriority  :: Maybe Priority
  , Section -> NonEmpty Words
sectionHeading   :: NonEmpty Words
  , Section -> [Text]
sectionTags      :: [Text]
  , Section -> Maybe OrgDateTime
sectionClosed    :: Maybe OrgDateTime
  , Section -> Maybe OrgDateTime
sectionDeadline  :: Maybe OrgDateTime
  , Section -> Maybe OrgDateTime
sectionScheduled :: Maybe OrgDateTime
  , Section -> Maybe OrgDateTime
sectionTimestamp :: Maybe OrgDateTime
    -- ^ A timestamp for general events that are neither a DEADLINE nor SCHEDULED.
  , Section -> Map Text Text
sectionProps     :: M.Map Text Text
  , Section -> OrgDoc
sectionDoc       :: OrgDoc }
  deriving stock (Section -> Section -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Section -> Section -> Bool
$c/= :: Section -> Section -> Bool
== :: Section -> Section -> Bool
$c== :: Section -> Section -> Bool
Eq, Eq Section
Section -> Section -> Bool
Section -> Section -> Ordering
Section -> Section -> Section
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
min :: Section -> Section -> Section
$cmin :: Section -> Section -> Section
max :: Section -> Section -> Section
$cmax :: Section -> Section -> Section
>= :: Section -> Section -> Bool
$c>= :: Section -> Section -> Bool
> :: Section -> Section -> Bool
$c> :: Section -> Section -> Bool
<= :: Section -> Section -> Bool
$c<= :: Section -> Section -> Bool
< :: Section -> Section -> Bool
$c< :: Section -> Section -> Bool
compare :: Section -> Section -> Ordering
$ccompare :: Section -> Section -> Ordering
Ord, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Section] -> ShowS
$cshowList :: [Section] -> ShowS
show :: Section -> String
$cshow :: Section -> String
showsPrec :: Int -> Section -> ShowS
$cshowsPrec :: Int -> Section -> ShowS
Show, forall x. Rep Section x -> Section
forall x. Section -> Rep Section x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Section x -> Section
$cfrom :: forall x. Section -> Rep Section x
Generic)

-- | A mostly empty invoking of a `Section`.
titled :: Words -> Section
titled :: Words -> Section
titled Words
ws = Maybe Todo
-> Maybe Priority
-> NonEmpty Words
-> [Text]
-> Maybe OrgDateTime
-> Maybe OrgDateTime
-> Maybe OrgDateTime
-> Maybe OrgDateTime
-> Map Text Text
-> OrgDoc
-> Section
Section forall a. Maybe a
Nothing forall a. Maybe a
Nothing (Words
wsforall a. a -> [a] -> NonEmpty a
:|[]) [] forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Monoid a => a
mempty OrgDoc
emptyDoc

-- | All unique tags with a section and its subsections.
allSectionTags :: Section -> S.Set Text
allSectionTags :: Section -> Set Text
allSectionTags (Section Maybe Todo
_ Maybe Priority
_ NonEmpty Words
_ [Text]
sts Maybe OrgDateTime
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Maybe OrgDateTime
_ Map Text Text
_ OrgDoc
doc) = forall a. Ord a => [a] -> Set a
S.fromList [Text]
sts forall a. Semigroup a => a -> a -> a
<> OrgDoc -> Set Text
allDocTags OrgDoc
doc

-- | The completion state of a heading that is considered a "todo" item.
data Todo = TODO | DONE
  deriving stock (Todo -> Todo -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Todo -> Todo -> Bool
$c/= :: Todo -> Todo -> Bool
== :: Todo -> Todo -> Bool
$c== :: Todo -> Todo -> Bool
Eq, Eq Todo
Todo -> Todo -> Bool
Todo -> Todo -> Ordering
Todo -> Todo -> Todo
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
min :: Todo -> Todo -> Todo
$cmin :: Todo -> Todo -> Todo
max :: Todo -> Todo -> Todo
$cmax :: Todo -> Todo -> Todo
>= :: Todo -> Todo -> Bool
$c>= :: Todo -> Todo -> Bool
> :: Todo -> Todo -> Bool
$c> :: Todo -> Todo -> Bool
<= :: Todo -> Todo -> Bool
$c<= :: Todo -> Todo -> Bool
< :: Todo -> Todo -> Bool
$c< :: Todo -> Todo -> Bool
compare :: Todo -> Todo -> Ordering
$ccompare :: Todo -> Todo -> Ordering
Ord, Int -> Todo -> ShowS
[Todo] -> ShowS
Todo -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Todo] -> ShowS
$cshowList :: [Todo] -> ShowS
show :: Todo -> String
$cshow :: Todo -> String
showsPrec :: Int -> Todo -> ShowS
$cshowsPrec :: Int -> Todo -> ShowS
Show, forall x. Rep Todo x -> Todo
forall x. Todo -> Rep Todo x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Todo x -> Todo
$cfrom :: forall x. Todo -> Rep Todo x
Generic)

-- | A priority value, usually associated with a @TODO@ marking, as in:
--
-- @
-- *** TODO [#A] Cure cancer with Haskell
-- *** TODO [#B] Eat lunch
-- @
newtype Priority = Priority { Priority -> Text
priority :: Text }
  deriving stock (Priority -> Priority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq, Eq Priority
Priority -> Priority -> Bool
Priority -> Priority -> Ordering
Priority -> Priority -> Priority
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
min :: Priority -> Priority -> Priority
$cmin :: Priority -> Priority -> Priority
max :: Priority -> Priority -> Priority
$cmax :: Priority -> Priority -> Priority
>= :: Priority -> Priority -> Bool
$c>= :: Priority -> Priority -> Bool
> :: Priority -> Priority -> Bool
$c> :: Priority -> Priority -> Bool
<= :: Priority -> Priority -> Bool
$c<= :: Priority -> Priority -> Bool
< :: Priority -> Priority -> Bool
$c< :: Priority -> Priority -> Bool
compare :: Priority -> Priority -> Ordering
$ccompare :: Priority -> Priority -> Ordering
Ord, Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: Int -> Priority -> ShowS
$cshowsPrec :: Int -> Priority -> ShowS
Show, forall x. Rep Priority x -> Priority
forall x. Priority -> Rep Priority x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Priority x -> Priority
$cfrom :: forall x. Priority -> Rep Priority x
Generic)

-- | An org list constructed of @-@ or @+@ characters, or numbers.
--
-- @
-- 1. Feed the cat
--    - The good stuff
-- 2. Feed the dog
--    - He'll eat anything
-- 3. Feed the bird
-- 4. Feed the alligator
-- 5. Feed the elephant
-- @
data ListItems = ListItems ListType (NonEmpty Item)
  deriving stock (ListItems -> ListItems -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListItems -> ListItems -> Bool
$c/= :: ListItems -> ListItems -> Bool
== :: ListItems -> ListItems -> Bool
$c== :: ListItems -> ListItems -> Bool
Eq, Eq ListItems
ListItems -> ListItems -> Bool
ListItems -> ListItems -> Ordering
ListItems -> ListItems -> ListItems
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
min :: ListItems -> ListItems -> ListItems
$cmin :: ListItems -> ListItems -> ListItems
max :: ListItems -> ListItems -> ListItems
$cmax :: ListItems -> ListItems -> ListItems
>= :: ListItems -> ListItems -> Bool
$c>= :: ListItems -> ListItems -> Bool
> :: ListItems -> ListItems -> Bool
$c> :: ListItems -> ListItems -> Bool
<= :: ListItems -> ListItems -> Bool
$c<= :: ListItems -> ListItems -> Bool
< :: ListItems -> ListItems -> Bool
$c< :: ListItems -> ListItems -> Bool
compare :: ListItems -> ListItems -> Ordering
$ccompare :: ListItems -> ListItems -> Ordering
Ord, Int -> ListItems -> ShowS
[ListItems] -> ShowS
ListItems -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListItems] -> ShowS
$cshowList :: [ListItems] -> ShowS
show :: ListItems -> String
$cshow :: ListItems -> String
showsPrec :: Int -> ListItems -> ShowS
$cshowsPrec :: Int -> ListItems -> ShowS
Show, forall x. Rep ListItems x -> ListItems
forall x. ListItems -> Rep ListItems x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListItems x -> ListItems
$cfrom :: forall x. ListItems -> Rep ListItems x
Generic)

data ListType = Bulleted | Plussed | Numbered
  deriving stock (ListType -> ListType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListType -> ListType -> Bool
$c/= :: ListType -> ListType -> Bool
== :: ListType -> ListType -> Bool
$c== :: ListType -> ListType -> Bool
Eq, Eq ListType
ListType -> ListType -> Bool
ListType -> ListType -> Ordering
ListType -> ListType -> ListType
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
min :: ListType -> ListType -> ListType
$cmin :: ListType -> ListType -> ListType
max :: ListType -> ListType -> ListType
$cmax :: ListType -> ListType -> ListType
>= :: ListType -> ListType -> Bool
$c>= :: ListType -> ListType -> Bool
> :: ListType -> ListType -> Bool
$c> :: ListType -> ListType -> Bool
<= :: ListType -> ListType -> Bool
$c<= :: ListType -> ListType -> Bool
< :: ListType -> ListType -> Bool
$c< :: ListType -> ListType -> Bool
compare :: ListType -> ListType -> Ordering
$ccompare :: ListType -> ListType -> Ordering
Ord, Int -> ListType -> ShowS
[ListType] -> ShowS
ListType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListType] -> ShowS
$cshowList :: [ListType] -> ShowS
show :: ListType -> String
$cshow :: ListType -> String
showsPrec :: Int -> ListType -> ShowS
$cshowsPrec :: Int -> ListType -> ShowS
Show, forall x. Rep ListType x -> ListType
forall x. ListType -> Rep ListType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListType x -> ListType
$cfrom :: forall x. ListType -> Rep ListType x
Generic)

-- | A line in a bullet-list. Can contain sublists, as shown in `ListItems`.
data Item = Item (NonEmpty Words) (Maybe ListItems)
  deriving stock (Item -> Item -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Item -> Item -> Bool
$c/= :: Item -> Item -> Bool
== :: Item -> Item -> Bool
$c== :: Item -> Item -> Bool
Eq, Eq Item
Item -> Item -> Bool
Item -> Item -> Ordering
Item -> Item -> Item
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
min :: Item -> Item -> Item
$cmin :: Item -> Item -> Item
max :: Item -> Item -> Item
$cmax :: Item -> Item -> Item
>= :: Item -> Item -> Bool
$c>= :: Item -> Item -> Bool
> :: Item -> Item -> Bool
$c> :: Item -> Item -> Bool
<= :: Item -> Item -> Bool
$c<= :: Item -> Item -> Bool
< :: Item -> Item -> Bool
$c< :: Item -> Item -> Bool
compare :: Item -> Item -> Ordering
$ccompare :: Item -> Item -> Ordering
Ord, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Item] -> ShowS
$cshowList :: [Item] -> ShowS
show :: Item -> String
$cshow :: Item -> String
showsPrec :: Int -> Item -> ShowS
$cshowsPrec :: Int -> Item -> ShowS
Show, forall x. Rep Item x -> Item
forall x. Item -> Rep Item x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Item x -> Item
$cfrom :: forall x. Item -> Rep Item x
Generic)

-- | A row in an org table. Can have content or be a horizontal rule.
--
-- @
-- | A | B | C |
-- |---+---+---|
-- | D | E | F |
-- @
data Row = Break | Row (NonEmpty Column)
  deriving stock (Row -> Row -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Row -> Row -> Bool
$c/= :: Row -> Row -> Bool
== :: Row -> Row -> Bool
$c== :: Row -> Row -> Bool
Eq, Eq Row
Row -> Row -> Bool
Row -> Row -> Ordering
Row -> Row -> Row
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
min :: Row -> Row -> Row
$cmin :: Row -> Row -> Row
max :: Row -> Row -> Row
$cmax :: Row -> Row -> Row
>= :: Row -> Row -> Bool
$c>= :: Row -> Row -> Bool
> :: Row -> Row -> Bool
$c> :: Row -> Row -> Bool
<= :: Row -> Row -> Bool
$c<= :: Row -> Row -> Bool
< :: Row -> Row -> Bool
$c< :: Row -> Row -> Bool
compare :: Row -> Row -> Ordering
$ccompare :: Row -> Row -> Ordering
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Row] -> ShowS
$cshowList :: [Row] -> ShowS
show :: Row -> String
$cshow :: Row -> String
showsPrec :: Int -> Row -> ShowS
$cshowsPrec :: Int -> Row -> ShowS
Show, forall x. Rep Row x -> Row
forall x. Row -> Rep Row x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Row x -> Row
$cfrom :: forall x. Row -> Rep Row x
Generic)

-- | A possibly empty column in an org table.
data Column = Empty | Column (NonEmpty Words)
  deriving stock (Column -> Column -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Column -> Column -> Bool
$c/= :: Column -> Column -> Bool
== :: Column -> Column -> Bool
$c== :: Column -> Column -> Bool
Eq, Eq Column
Column -> Column -> Bool
Column -> Column -> Ordering
Column -> Column -> Column
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
min :: Column -> Column -> Column
$cmin :: Column -> Column -> Column
max :: Column -> Column -> Column
$cmax :: Column -> Column -> Column
>= :: Column -> Column -> Bool
$c>= :: Column -> Column -> Bool
> :: Column -> Column -> Bool
$c> :: Column -> Column -> Bool
<= :: Column -> Column -> Bool
$c<= :: Column -> Column -> Bool
< :: Column -> Column -> Bool
$c< :: Column -> Column -> Bool
compare :: Column -> Column -> Ordering
$ccompare :: Column -> Column -> Ordering
Ord, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Column] -> ShowS
$cshowList :: [Column] -> ShowS
show :: Column -> String
$cshow :: Column -> String
showsPrec :: Int -> Column -> ShowS
$cshowsPrec :: Int -> Column -> ShowS
Show, forall x. Rep Column x -> Column
forall x. Column -> Rep Column x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Column x -> Column
$cfrom :: forall x. Column -> Rep Column x
Generic)

-- | The fundamental unit of Org text content. `Plain` units are split
-- word-by-word.
data Words
  = Bold Text
  | Italic Text
  | Highlight Text
  | Underline Text
  | Verbatim Text
  | Strike Text
  | Link URL (Maybe Text)
  | Image URL
  | Punct Char
  | Plain Text
  deriving stock (Words -> Words -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Words -> Words -> Bool
$c/= :: Words -> Words -> Bool
== :: Words -> Words -> Bool
$c== :: Words -> Words -> Bool
Eq, Eq Words
Words -> Words -> Bool
Words -> Words -> Ordering
Words -> Words -> Words
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
min :: Words -> Words -> Words
$cmin :: Words -> Words -> Words
max :: Words -> Words -> Words
$cmax :: Words -> Words -> Words
>= :: Words -> Words -> Bool
$c>= :: Words -> Words -> Bool
> :: Words -> Words -> Bool
$c> :: Words -> Words -> Bool
<= :: Words -> Words -> Bool
$c<= :: Words -> Words -> Bool
< :: Words -> Words -> Bool
$c< :: Words -> Words -> Bool
compare :: Words -> Words -> Ordering
$ccompare :: Words -> Words -> Ordering
Ord, Int -> Words -> ShowS
[Words] -> ShowS
Words -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Words] -> ShowS
$cshowList :: [Words] -> ShowS
show :: Words -> String
$cshow :: Words -> String
showsPrec :: Int -> Words -> ShowS
$cshowsPrec :: Int -> Words -> ShowS
Show, forall x. Rep Words x -> Words
forall x. Words -> Rep Words x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Words x -> Words
$cfrom :: forall x. Words -> Rep Words x
Generic)
  deriving anyclass (Eq Words
Int -> Words -> Int
Words -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Words -> Int
$chash :: Words -> Int
hashWithSalt :: Int -> Words -> Int
$chashWithSalt :: Int -> Words -> Int
Hashable)

-- | The url portion of a link.
newtype URL = URL Text
  deriving stock (URL -> URL -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: URL -> URL -> Bool
$c/= :: URL -> URL -> Bool
== :: URL -> URL -> Bool
$c== :: URL -> URL -> Bool
Eq, Eq URL
URL -> URL -> Bool
URL -> URL -> Ordering
URL -> URL -> URL
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
min :: URL -> URL -> URL
$cmin :: URL -> URL -> URL
max :: URL -> URL -> URL
$cmax :: URL -> URL -> URL
>= :: URL -> URL -> Bool
$c>= :: URL -> URL -> Bool
> :: URL -> URL -> Bool
$c> :: URL -> URL -> Bool
<= :: URL -> URL -> Bool
$c<= :: URL -> URL -> Bool
< :: URL -> URL -> Bool
$c< :: URL -> URL -> Bool
compare :: URL -> URL -> Ordering
$ccompare :: URL -> URL -> Ordering
Ord, Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [URL] -> ShowS
$cshowList :: [URL] -> ShowS
show :: URL -> String
$cshow :: URL -> String
showsPrec :: Int -> URL -> ShowS
$cshowsPrec :: Int -> URL -> ShowS
Show, forall x. Rep URL x -> URL
forall x. URL -> Rep URL x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep URL x -> URL
$cfrom :: forall x. URL -> Rep URL x
Generic)
  deriving anyclass (Eq URL
Int -> URL -> Int
URL -> Int
forall a. Eq a -> (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: URL -> Int
$chash :: URL -> Int
hashWithSalt :: Int -> URL -> Int
$chashWithSalt :: Int -> URL -> Int
Hashable)

-- | The programming language some source code block was written in.
newtype Language = Language Text
  deriving stock (Language -> Language -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Language -> Language -> Bool
$c/= :: Language -> Language -> Bool
== :: Language -> Language -> Bool
$c== :: Language -> Language -> Bool
Eq, Eq Language
Language -> Language -> Bool
Language -> Language -> Ordering
Language -> Language -> Language
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
min :: Language -> Language -> Language
$cmin :: Language -> Language -> Language
max :: Language -> Language -> Language
$cmax :: Language -> Language -> Language
>= :: Language -> Language -> Bool
$c>= :: Language -> Language -> Bool
> :: Language -> Language -> Bool
$c> :: Language -> Language -> Bool
<= :: Language -> Language -> Bool
$c<= :: Language -> Language -> Bool
< :: Language -> Language -> Bool
$c< :: Language -> Language -> Bool
compare :: Language -> Language -> Ordering
$ccompare :: Language -> Language -> Ordering
Ord, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Language] -> ShowS
$cshowList :: [Language] -> ShowS
show :: Language -> String
$cshow :: Language -> String
showsPrec :: Int -> Language -> ShowS
$cshowsPrec :: Int -> Language -> ShowS
Show, forall x. Rep Language x -> Language
forall x. Language -> Rep Language x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Language x -> Language
$cfrom :: forall x. Language -> Rep Language x
Generic)

--------------------------------------------------------------------------------
-- Parser

-- | Attempt to parse an `OrgFile`.
org :: Text -> Maybe OrgFile
org :: Text -> Maybe OrgFile
org = forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parser OrgFile
orgFile

type Parser = Parsec Void Text

orgFile :: Parser OrgFile
orgFile :: Parser OrgFile
orgFile = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (Map Text Text -> OrgDoc -> OrgFile
OrgFile forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Map Text Text)
meta forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser OrgDoc
orgP) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

meta :: Parser (M.Map Text Text)
meta :: Parser (Map Text Text)
meta = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Text)
keyword forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`sepEndBy` forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  where
    keyword :: Parser (Text, Text)
    keyword :: Parser (Text, Text)
keyword = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+"
      Text
key <- Char -> Parser Text
someTill' Char
':'
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
": "
      Text
val <- Parser Text
someTillEnd
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
val)

orgP :: Parser OrgDoc
orgP :: Parser OrgDoc
orgP = Int -> Parser OrgDoc
orgP' Int
1

orgP' :: Int -> Parser OrgDoc
orgP' :: Int -> Parser OrgDoc
orgP' Int
depth = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ [Block] -> [Section] -> OrgDoc
OrgDoc
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many Parser Block
block
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Int -> ParsecT Void Text Identity Section
section Int
depth)
  where
    block :: Parser Block
    block :: Parser Block
block = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Block
code
      , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Block
example
      , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Block
quote
      , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Block
list
      , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Block
table
      , Parser Block
paragraph ]  -- TODO Paragraph needs to fail if it detects a heading.

-- | If a line starts with @*@ and a space, it is a `Section` heading.
heading :: Parser (T.Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
heading :: Parser (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
heading = do
  Text
stars <- Char -> Parser Text
someOf Char
'*' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
' '
  (Maybe Todo
mtd, Maybe Priority
mpr, NonEmpty Words
ws, Maybe (NonEmpty Text)
mts) <- Parser
  (Maybe Todo, Maybe Priority, NonEmpty Words, Maybe (NonEmpty Text))
headerLine
  case Maybe (NonEmpty Text)
mts of
    Maybe (NonEmpty Text)
Nothing -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
stars, Maybe Todo
mtd, Maybe Priority
mpr, NonEmpty Words
ws, [])
    Just NonEmpty Text
ts -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
stars, Maybe Todo
mtd, Maybe Priority
mpr, NonEmpty Words
ws, forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Text
ts)

section :: Int -> Parser Section
section :: Int -> ParsecT Void Text Identity Section
section Int
depth = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ do
  (Text
stars, Maybe Todo
td, Maybe Priority
pr, NonEmpty Words
ws, [Text]
ts) <- Parser (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
heading
  -- Fail if we've found a parent heading --
  forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
T.length Text
stars forall a. Ord a => a -> a -> Bool
< Int
depth) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure forall a. Maybe a
Nothing forall a. Monoid a => a
mempty
  -- Otherwise continue --
  (Maybe OrgDateTime
cl, Maybe OrgDateTime
dl, Maybe OrgDateTime
sc) <- forall a. a -> Maybe a -> a
fromMaybe (forall a. Maybe a
Nothing, forall a. Maybe a
Nothing, forall a. Maybe a
Nothing) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT
  Void
  Text
  Identity
  (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
timestamps)
  Maybe OrgDateTime
tm <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity OrgDateTime
stamp)
  Map Text Text
props <- forall a. a -> Maybe a -> a
fromMaybe forall a. Monoid a => a
mempty forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Map Text Text)
properties)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  Maybe Todo
-> Maybe Priority
-> NonEmpty Words
-> [Text]
-> Maybe OrgDateTime
-> Maybe OrgDateTime
-> Maybe OrgDateTime
-> Maybe OrgDateTime
-> Map Text Text
-> OrgDoc
-> Section
Section Maybe Todo
td Maybe Priority
pr NonEmpty Words
ws [Text]
ts Maybe OrgDateTime
cl Maybe OrgDateTime
dl Maybe OrgDateTime
sc Maybe OrgDateTime
tm Map Text Text
props forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Parser OrgDoc
orgP' (forall a. Enum a => a -> a
succ Int
depth)

timestamps :: Parser (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
timestamps :: ParsecT
  Void
  Text
  Identity
  (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
timestamps = do
  Maybe OrgDateTime
mc <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity OrgDateTime
closed
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Maybe OrgDateTime
md <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity OrgDateTime
deadline
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Maybe OrgDateTime
ms <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity OrgDateTime
scheduled
  case (Maybe OrgDateTime
mc, Maybe OrgDateTime
md, Maybe OrgDateTime
ms) of
    (Maybe OrgDateTime
Nothing, Maybe OrgDateTime
Nothing, Maybe OrgDateTime
Nothing) -> forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure forall a. Maybe a
Nothing forall a. Monoid a => a
mempty
    (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
_                           -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe OrgDateTime
mc, Maybe OrgDateTime
md, Maybe OrgDateTime
ms)

-- | An active timestamp.
stamp :: Parser OrgDateTime
stamp :: ParsecT Void Text Identity OrgDateTime
stamp = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'<') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>') ParsecT Void Text Identity OrgDateTime
timestamp

closed :: Parser OrgDateTime
closed :: ParsecT Void Text Identity OrgDateTime
closed = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"CLOSED: " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') ParsecT Void Text Identity OrgDateTime
timestamp

deadline :: Parser OrgDateTime
deadline :: ParsecT Void Text Identity OrgDateTime
deadline = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DEADLINE: " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity OrgDateTime
stamp

scheduled :: Parser OrgDateTime
scheduled :: ParsecT Void Text Identity OrgDateTime
scheduled = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"SCHEDULED: " forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity OrgDateTime
stamp

timestamp :: Parser OrgDateTime
timestamp :: ParsecT Void Text Identity OrgDateTime
timestamp = Day
-> DayOfWeek
-> Maybe OrgTime
-> Maybe Repeater
-> Maybe Delay
-> OrgDateTime
OrgDateTime
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Day
date
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity DayOfWeek
dow)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity OrgTime
timeRange)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Repeater
repeater)
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Delay
delay)

date :: Parser Day
date :: Parser Day
date = Year -> Int -> Int -> Day
fromGregorian forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal)

dow :: Parser DayOfWeek
dow :: ParsecT Void Text Identity DayOfWeek
dow = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ DayOfWeek
Monday    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Mon"
  , DayOfWeek
Tuesday   forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Tue"
  , DayOfWeek
Wednesday forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Wed"
  , DayOfWeek
Thursday  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Thu"
  , DayOfWeek
Friday    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Fri"
  , DayOfWeek
Saturday  forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Sat"
  , DayOfWeek
Sunday    forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Sun" ]

timeRange :: Parser OrgTime
timeRange :: ParsecT Void Text Identity OrgTime
timeRange = TimeOfDay -> Maybe TimeOfDay -> OrgTime
OrgTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser TimeOfDay
t forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser TimeOfDay
t)
  where
    t :: Parser TimeOfDay
    t :: Parser TimeOfDay
t = do
      Int
h <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
      Int
m <- forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Maybe Pico
s <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ do
        forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
        forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m (forall a. a -> Maybe a -> a
fromMaybe Pico
0 Maybe Pico
s)

repeater :: Parser Repeater
repeater :: ParsecT Void Text Identity Repeater
repeater = RepeatMode -> Word -> Interval -> Repeater
Repeater
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
".+" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RepeatMode
FromToday, forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"++" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RepeatMode
Jump, forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RepeatMode
Single ]
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Interval
interval

delay :: Parser Delay
delay :: ParsecT Void Text Identity Delay
delay = DelayMode -> Word -> Interval -> Delay
Delay
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DelayMode
DelayOne, forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> DelayMode
DelayAll ]
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Parser Interval
interval

interval :: Parser Interval
interval :: Parser Interval
interval = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'h' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Interval
Hour, forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'd' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Interval
Day, forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'w' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Interval
Week, forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'm' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Interval
Month, forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'y' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Interval
Year ]

properties :: Parser (M.Map Text Text)
properties :: Parser (Map Text Text)
properties = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":PROPERTIES:"
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  [(Text, Text)]
ps <- (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Text)
property forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace) forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`manyTill` forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":END:"
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall k a. Ord k => [(k, a)] -> Map k a
M.fromList [(Text, Text)]
ps

property :: Parser (Text, Text)
property :: Parser (Text, Text)
property = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
  Text
key <- Char -> Parser Text
someTill' Char
':' -- TODO Newlines?
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Text
val <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"Property Value") (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
val)

quote :: Parser Block
quote :: Parser Block
quote = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
top forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [Text]
ls <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (Parser Text
manyTillEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text Identity (Tokens Text)
bot
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Block
Quote forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
  where
    top :: ParsecT Void Text Identity (Tokens Text)
top = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BEGIN_QUOTE" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"begin_quote")
    bot :: ParsecT Void Text Identity (Tokens Text)
bot = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"END_QUOTE" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end_quote")

example :: Parser Block
example :: Parser Block
example = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (Tokens Text)
top forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [Text]
ls <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (Parser Text
manyTillEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text Identity (Tokens Text)
bot
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Block
Example forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
  where
    top :: ParsecT Void Text Identity (Tokens Text)
top = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BEGIN_EXAMPLE" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"begin_example")
    bot :: ParsecT Void Text Identity (Tokens Text)
bot = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"END_EXAMPLE" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end_example")

code :: Parser Block
code :: Parser Block
code = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ do
  Maybe Text
lang <- ParsecT Void Text Identity (Tokens Text)
top forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser Text
lng forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  [Text]
ls <- forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill (Parser Text
manyTillEnd forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline) ParsecT Void Text Identity (Tokens Text)
bot
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Language -> Text -> Block
Code (Text -> Language
Language forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
lang) forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> Text
T.intercalate Text
"\n" [Text]
ls
  where
    top :: ParsecT Void Text Identity (Tokens Text)
top = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"BEGIN_SRC" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"begin_src")
    bot :: ParsecT Void Text Identity (Tokens Text)
bot = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"#+" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"END_SRC" forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"end_src")
    lng :: Parser Text
lng = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
' '  forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
someTillEnd

list :: Parser Block
list :: Parser Block
list = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap ListItems -> Block
List forall a b. (a -> b) -> a -> b
$ Int -> Parser ListItems
itemChoice Int
0

itemChoice :: Int -> Parser ListItems
itemChoice :: Int -> Parser ListItems
itemChoice Int
indent = Int -> Parser ListItems
bulleted
 Int
indent forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser ListItems
starred Int
indent forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> Parser ListItems
numbered Int
indent

bulleted :: Int -> Parser ListItems
bulleted :: Int -> Parser ListItems
bulleted
 Int
indent = ListType -> NonEmpty Item -> ListItems
ListItems ListType
Bulleted forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Int -> Parser (NonEmpty Item)
listItems (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"- ") Int
indent

starred :: Int -> Parser ListItems
starred :: Int -> Parser ListItems
starred Int
indent = ListType -> NonEmpty Item -> ListItems
ListItems ListType
Plussed forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Int -> Parser (NonEmpty Item)
listItems (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"+ ") Int
indent

numbered :: Int -> Parser ListItems
numbered :: Int -> Parser ListItems
numbered Int
indent = ListType -> NonEmpty Item -> ListItems
ListItems ListType
Numbered forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Parser a -> Int -> Parser (NonEmpty Item)
listItems Parser Text
numd Int
indent
  where
    numd :: ParsecT Void Text Identity (Tokens Text)
numd = (forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal :: Parser Word) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
". "

listItems :: Parser a -> Int -> Parser (NonEmpty Item)
listItems :: forall a. Parser a -> Int -> Parser (NonEmpty Item)
listItems Parser a
tick Int
indent = forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepBy1 (forall a. Parser a -> Int -> Parser Item
item Parser a
tick Int
indent) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser a
next
  where
    next :: Parser a
next = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall a. Parser a -> Int -> Parser a
nextItem Parser a
tick Int
indent)

nextItem :: Parser a -> Int -> Parser a
nextItem :: forall a. Parser a -> Int -> Parser a
nextItem Parser a
tick Int
indent = forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Int -> Text -> Text
T.replicate Int
indent Text
" ") forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser a
tick

-- | Conditions for ending the current bullet:
--
-- 1. You find two '\n' at the end of a line.
-- 2. The first two non-space characters of the next line mark the start of a point, like "- ".
item :: Parser a -> Int -> Parser Item
item :: forall a. Parser a -> Int -> Parser Item
item Parser a
tick Int
indent = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
indent Text
" "
  forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser a
tick
  NonEmpty Words
l <- Parser (NonEmpty Words)
content
  let !nextInd :: Int
nextInd = Int
indent forall a. Num a => a -> a -> a
+ Int
2
  NonEmpty Words -> Maybe ListItems -> Item
Item NonEmpty Words
l forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> Parser ListItems
itemChoice Int
nextInd)
  where
    content :: Parser (NonEmpty Words)
    content :: Parser (NonEmpty Words)
content = do
      NonEmpty Words
l <- Char -> Parser (NonEmpty Words)
line Char
'\n'
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void Text Identity ()
keepGoing forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((NonEmpty Words
l forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty Words)
content)) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty Words
l

    keepGoing :: Parser ()
    keepGoing :: ParsecT Void Text Identity ()
keepGoing = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text
manyOf Char
' ' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
notItem

    notItem :: Char -> Bool
    notItem :: Char -> Bool
notItem Char
c = Char
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'-' Bool -> Bool -> Bool
&& Char
c forall a. Eq a => a -> a -> Bool
/= Char
'+' Bool -> Bool -> Bool
&& Bool -> Bool
not (Char -> Bool
isDigit Char
c)

table :: Parser Block
table :: Parser Block
table = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ NonEmpty Row -> Block
Table forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 Parser Row
row (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n')
  where
    row :: Parser Row
    row :: Parser Row
row = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'|'
      Parser Row
brk forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NonEmpty Column -> Row
Row forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 Parser Column
column (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'|'))

    -- | If the line starts with @|-@, assume its a break regardless of what
    -- chars come after that.
    brk :: Parser Row
    brk :: Parser Row
brk = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser Text
manyTillEnd forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Row
Break

    column :: Parser Column
    column :: Parser Column
column = do
      forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ Char -> Parser Text
someOf Char
' '
      (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'|') forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Column
Empty) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (NonEmpty Words -> Column
Column forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser (NonEmpty Words)
line Char
'|')

paragraph :: Parser Block
paragraph :: Parser Block
paragraph = forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space forall a b. (a -> b) -> a -> b
$ do
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy Parser (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
heading
  NonEmpty Words -> Block
Paragraph forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Semigroup a => NonEmpty a -> a
sconcat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 (Char -> Parser (NonEmpty Words)
line Char
'\n') forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline

headerLine :: Parser (Maybe Todo, Maybe Priority, NonEmpty Words, Maybe (NonEmpty Text))
headerLine :: Parser
  (Maybe Todo, Maybe Priority, NonEmpty Words, Maybe (NonEmpty Text))
headerLine = do
  Maybe Todo
td <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"TODO" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Todo
TODO) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DONE" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Todo
DONE)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Maybe Priority
pr <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Priority
Priority forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'#' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> Parser Text
someTill' Char
']')
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  NonEmpty Words
ws <- (Char -> ParsecT Void Text Identity Words
wordChunk Char
'\n' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace) forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`someTill` forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void Parser (NonEmpty Text)
tags forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\n') forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
  Maybe (NonEmpty Text)
ts <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional Parser (NonEmpty Text)
tags
  forall (f :: * -> *) a. Applicative f => a -> f a
pure (Maybe Todo
td, Maybe Priority
pr, NonEmpty Words
ws, Maybe (NonEmpty Text)
ts)

line :: Char -> Parser (NonEmpty Words)
line :: Char -> Parser (NonEmpty Words)
line Char
end = Char -> ParsecT Void Text Identity Words
wordChunk Char
end forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepEndBy1` Char -> Parser Text
manyOf Char
' '

-- | RULES
--
-- 1. In-lined markup is not recognized: This is not*bold*. Neither is *this*here.
-- 2. Punctuation immediately after markup close /is/ allowed: *This*, in fact, is bold.
-- 3. Otherwise, a space, newline or EOF is necessary after the close.
-- 4. Any char after a link is fine.
-- 5. When rerendering, a space must not appear between the end of a markup close and
--    a punctuation/newline character.
-- 6. But any other character must have a space before it.
wordChunk :: Char -> Parser Words
wordChunk :: Char -> ParsecT Void Text Identity Words
wordChunk Char
end = forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Text -> Words
Bold      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*') (Char -> Parser Text
someTill' Char
'*') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Text -> Words
Italic    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'/') (Char -> Parser Text
someTill' Char
'/') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Text -> Words
Highlight forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'~') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'~') (Char -> Parser Text
someTill' Char
'~') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Text -> Words
Verbatim  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'=') (Char -> Parser Text
someTill' Char
'=') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Text -> Words
Underline forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_') (Char -> Parser Text
someTill' Char
'_') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Text -> Words
Strike    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'+') (Char -> Parser Text
someTill' Char
'+') forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Words
image
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Words
link
  , forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ Char -> Words
Punct     forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
punc
  , Text -> Words
Plain           forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"plain text") (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
end) ]
  where
    -- | Punctuation, space, or the end of the file.
    pOrS :: Parser ()
    pOrS :: ParsecT Void Text Identity ()
pOrS = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf forall a b. (a -> b) -> a -> b
$ Char
end forall a. a -> [a] -> [a]
: Char
' ' forall a. a -> [a] -> [a]
: String
punc) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

punc :: String
punc :: String
punc = String
".,!?():;'"

tags :: Parser (NonEmpty Text)
tags :: Parser (NonEmpty Text)
tags = do
  forall (f :: * -> *) a. Functor f => f a -> f ()
void forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
  (String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonEmpty a -> [a]
NEL.toList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Alternative m => m a -> m (NonEmpty a)
some (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
alphaNumChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'_' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@')) forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepEndBy1` forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'

image :: Parser Words
image :: ParsecT Void Text Identity Words
image = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') forall a b. (a -> b) -> a -> b
$
  forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') forall a b. (a -> b) -> a -> b
$ do
    Text
path <- Char -> Parser Text
someTill' Char
']'
    let !ext :: String
ext = ShowS
takeExtension forall a b. (a -> b) -> a -> b
$ Text -> String
T.unpack Text
path
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (String
ext forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String
".jpg", String
".jpeg", String
".png"]) forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure forall a. Maybe a
Nothing forall a. Monoid a => a
mempty
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. URL -> Words
Image forall a b. (a -> b) -> a -> b
$ Text -> URL
URL Text
path

link :: Parser Words
link :: ParsecT Void Text Identity Words
link = forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') forall a b. (a -> b) -> a -> b
$ URL -> Maybe Text -> Words
Link
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') (Text -> URL
URL forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Char -> Parser Text
someTill' Char
']')
  forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[') (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']') (Char -> Parser Text
someTill' Char
']'))

someTillEnd :: Parser Text
someTillEnd :: Parser Text
someTillEnd = Char -> Parser Text
someTill' Char
'\n'

manyTillEnd :: Parser Text
manyTillEnd :: Parser Text
manyTillEnd = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"many until the end of the line") (forall a. Eq a => a -> a -> Bool
/= Char
'\n')

someTill' :: Char -> Parser Text
someTill' :: Char -> Parser Text
someTill' Char
c = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"some until " forall a. Semigroup a => a -> a -> a
<> [Char
c]) (forall a. Eq a => a -> a -> Bool
/= Char
c)

-- | Fast version of `some` specialized to `Text`.
someOf :: Char -> Parser Text
someOf :: Char -> Parser Text
someOf Char
c = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"some of " forall a. Semigroup a => a -> a -> a
<> [Char
c]) (forall a. Eq a => a -> a -> Bool
== Char
c)

manyOf :: Char -> Parser Text
manyOf :: Char -> Parser Text
manyOf Char
c = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ String
"many of " forall a. Semigroup a => a -> a -> a
<> [Char
c]) (forall a. Eq a => a -> a -> Bool
== Char
c)

--------------------------------------------------------------------------------
-- Pretty Printing

prettyOrgFile :: OrgFile -> Text
prettyOrgFile :: OrgFile -> Text
prettyOrgFile (OrgFile Map Text Text
m OrgDoc
os) = Text
metas forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" forall a. Semigroup a => a -> a -> a
<> OrgDoc -> Text
prettyOrg OrgDoc
os
  where
    metas :: Text
metas = Text -> [Text] -> Text
T.intercalate Text
"\n"
      forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map (\(Text
l, Text
t) -> Text
"#+" forall a. Semigroup a => a -> a -> a
<> Text
l forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
t)
      forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
m

prettyOrg :: OrgDoc -> Text
prettyOrg :: OrgDoc -> Text
prettyOrg  = Int -> OrgDoc -> Text
prettyOrg' Int
1

prettyOrg' :: Int -> OrgDoc -> Text
prettyOrg' :: Int -> OrgDoc -> Text
prettyOrg' Int
depth (OrgDoc [Block]
bs [Section]
ss) =
  Text -> [Text] -> Text
T.intercalate Text
"\n\n" forall a b. (a -> b) -> a -> b
$ forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
prettyBlock [Block]
bs forall a. Semigroup a => a -> a -> a
<> forall a b. (a -> b) -> [a] -> [b]
map (Int -> Section -> Text
prettySection Int
depth) [Section]
ss

prettySection :: Int -> Section -> Text
prettySection :: Int -> Section -> Text
prettySection Int
depth (Section Maybe Todo
td Maybe Priority
pr NonEmpty Words
ws [Text]
ts Maybe OrgDateTime
cl Maybe OrgDateTime
dl Maybe OrgDateTime
sc Maybe OrgDateTime
tm Map Text Text
ps OrgDoc
od) =
  Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes
  [ forall a. a -> Maybe a
Just Text
headig
  , Maybe Text
stamps
  , OrgDateTime -> Text
time forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OrgDateTime
tm
  , Maybe Text
props
  , forall a. a -> Maybe a
Just Text
subdoc ]
  where
    pr' :: Priority -> Text
    pr' :: Priority -> Text
pr' (Priority Text
t) = Text
"[#" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"]"

    -- TODO There is likely a punctuation bug here.
    --
    -- Sun Apr 25 09:59:01 AM PDT 2021: I wish you had elaborated.
    headig :: Text
headig = [Text] -> Text
T.unwords
      forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
depth Text
"*"
      forall a. a -> [a] -> [a]
: forall a. [Maybe a] -> [a]
catMaybes [ String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Todo
td, Priority -> Text
pr' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
pr ]
      forall a. Semigroup a => a -> a -> a
<> forall a. NonEmpty a -> [a]
NEL.toList (forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Words -> Text
prettyWords NonEmpty Words
ws)
      forall a. Semigroup a => a -> a -> a
<> forall a. a -> a -> Bool -> a
bool [Text
":" forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
":" [Text]
ts forall a. Semigroup a => a -> a -> a
<> Text
":"] [] (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts)

    indent :: Text
    indent :: Text
indent = Int -> Text -> Text
T.replicate (Int
depth forall a. Num a => a -> a -> a
+ Int
1) Text
" "

    -- | The order of "special" timestamps is CLOSED, DEADLINE, then SCHEDULED.
    -- Any permutation of these may appear.
    stamps :: Maybe Text
    stamps :: Maybe Text
stamps = case forall a. [Maybe a] -> [a]
catMaybes [forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrgDateTime -> Text
cl' Maybe OrgDateTime
cl, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrgDateTime -> Text
dl' Maybe OrgDateTime
dl, forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrgDateTime -> Text
sc' Maybe OrgDateTime
sc] of
      [] -> forall a. Maybe a
Nothing
      [Text]
xs -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ Text
indent forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
xs

    cl' :: OrgDateTime -> Text
    cl' :: OrgDateTime -> Text
cl' OrgDateTime
x = Text
"CLOSED: [" forall a. Semigroup a => a -> a -> a
<> OrgDateTime -> Text
prettyDateTime OrgDateTime
x forall a. Semigroup a => a -> a -> a
<> Text
"]"

    dl' :: OrgDateTime -> Text
    dl' :: OrgDateTime -> Text
dl' OrgDateTime
x = Text
"DEADLINE: <" forall a. Semigroup a => a -> a -> a
<> OrgDateTime -> Text
prettyDateTime OrgDateTime
x forall a. Semigroup a => a -> a -> a
<> Text
">"

    sc' :: OrgDateTime -> Text
    sc' :: OrgDateTime -> Text
sc' OrgDateTime
x = Text
"SCHEDULED: " forall a. Semigroup a => a -> a -> a
<> OrgDateTime -> Text
time OrgDateTime
x

    time :: OrgDateTime -> Text
    time :: OrgDateTime -> Text
time OrgDateTime
x = Text
"<" forall a. Semigroup a => a -> a -> a
<> OrgDateTime -> Text
prettyDateTime OrgDateTime
x forall a. Semigroup a => a -> a -> a
<> Text
">"

    props :: Maybe Text
    props :: Maybe Text
props
      | forall (t :: * -> *) a. Foldable t => t a -> Bool
null Map Text Text
ps = forall a. Maybe a
Nothing
      | Bool
otherwise = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> [Text] -> Text
T.intercalate Text
"\n" forall a b. (a -> b) -> a -> b
$ (Text
indent forall a. Semigroup a => a -> a -> a
<> Text
":PROPERTIES:") forall a. a -> [a] -> [a]
: [Text]
items forall a. Semigroup a => a -> a -> a
<> [Text
indent forall a. Semigroup a => a -> a -> a
<> Text
":END:"]
      where
        items :: [Text]
        items :: [Text]
items = forall a b. (a -> b) -> [a] -> [b]
map (\(Text
k, Text
v) -> Text
indent forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
k forall a. Semigroup a => a -> a -> a
<> Text
": " forall a. Semigroup a => a -> a -> a
<> Text
v) forall a b. (a -> b) -> a -> b
$ forall k a. Map k a -> [(k, a)]
M.toList Map Text Text
ps

    subdoc :: Text
    subdoc :: Text
subdoc = Int -> OrgDoc -> Text
prettyOrg' (forall a. Enum a => a -> a
succ Int
depth) OrgDoc
od

prettyDateTime :: OrgDateTime -> Text
prettyDateTime :: OrgDateTime -> Text
prettyDateTime (OrgDateTime Day
d DayOfWeek
w Maybe OrgTime
t Maybe Repeater
rep Maybe Delay
del) =
  [Text] -> Text
T.unwords forall a b. (a -> b) -> a -> b
$ forall a. [Maybe a] -> [a]
catMaybes [ forall a. a -> Maybe a
Just Text
d', forall a. a -> Maybe a
Just Text
w', OrgTime -> Text
prettyTime forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OrgTime
t, Repeater -> Text
prettyRepeat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Repeater
rep, Delay -> Text
prettyDelay forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Delay
del ]
  where
    d' :: Text
    d' :: Text
d' = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ Day -> String
showGregorian Day
d

    w' :: Text
    w' :: Text
w' = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
3 forall a b. (a -> b) -> a -> b
$ forall a. Show a => a -> String
show DayOfWeek
w

prettyTime :: OrgTime -> Text
prettyTime :: OrgTime -> Text
prettyTime (OrgTime TimeOfDay
s Maybe TimeOfDay
me) = TimeOfDay -> Text
tod TimeOfDay
s forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\TimeOfDay
e -> Text
"-" forall a. Semigroup a => a -> a -> a
<> TimeOfDay -> Text
tod TimeOfDay
e) Maybe TimeOfDay
me
  where
    tod :: TimeOfDay -> Text
    tod :: TimeOfDay -> Text
tod (TimeOfDay Int
h Int
m Pico
_) = String -> Text
T.pack forall a b. (a -> b) -> a -> b
$ forall r. PrintfType r => String -> r
printf String
"%02d:%02d" Int
h Int
m

prettyRepeat :: Repeater -> Text
prettyRepeat :: Repeater -> Text
prettyRepeat (Repeater RepeatMode
m Word
v Interval
i) = Text
m' forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Word
v) forall a. Semigroup a => a -> a -> a
<> Interval -> Text
prettyInterval Interval
i
  where
    m' :: Text
    m' :: Text
m' = case RepeatMode
m of
      RepeatMode
Single    -> Text
"+"
      RepeatMode
Jump      -> Text
"++"
      RepeatMode
FromToday -> Text
".+"

prettyDelay :: Delay -> Text
prettyDelay :: Delay -> Text
prettyDelay (Delay DelayMode
m Word
v Interval
i) = Text
m' forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (forall a. Show a => a -> String
show Word
v) forall a. Semigroup a => a -> a -> a
<> Interval -> Text
prettyInterval Interval
i
  where
    m' :: Text
    m' :: Text
m' = case DelayMode
m of
      DelayMode
DelayOne -> Text
"--"
      DelayMode
DelayAll -> Text
"-"

prettyInterval :: Interval -> Text
prettyInterval :: Interval -> Text
prettyInterval Interval
i = case Interval
i of
  Interval
Hour  -> Text
"h"
  Interval
Day   -> Text
"d"
  Interval
Week  -> Text
"w"
  Interval
Month -> Text
"m"
  Interval
Year  -> Text
"y"

-- | Render a `Block` into the original text form it was parsed from (or equivalent).
prettyBlock :: Block -> Text
prettyBlock :: Block -> Text
prettyBlock Block
o = case Block
o of
  Code Maybe Language
l Text
t -> Text
"#+begin_src" forall a. Semigroup a => a -> a -> a
<> forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(Language Text
l') -> Text
" " forall a. Semigroup a => a -> a -> a
<> Text
l' forall a. Semigroup a => a -> a -> a
<> Text
"\n") Maybe Language
l
    forall a. Semigroup a => a -> a -> a
<> Text
t
    forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_src"
  Quote Text
t -> Text
"#+begin_quote\n" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_quote"
  Example Text
t -> Text
"#+begin_example\n" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_example"
  Paragraph NonEmpty Words
ht -> NonEmpty Words -> Text
prettyWordGroups NonEmpty Words
ht
  List ListItems
items -> ListItems -> Text
prettyList ListItems
items
  Table NonEmpty Row
rows -> Text -> [Text] -> Text
T.intercalate Text
"\n" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Row -> Text
row forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Row
rows
  where
    row :: Row -> Text
    row :: Row -> Text
row Row
Break    = Text
"|-|"
    row (Row NonEmpty Column
cs) = Text
"| " forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
" | " forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Column -> Text
col forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Column
cs) forall a. Semigroup a => a -> a -> a
<> Text
" |"

    col :: Column -> Text
    col :: Column -> Text
col Column
Empty       = Text
""
    col (Column NonEmpty Words
ws) = [Text] -> Text
T.unwords forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map Words -> Text
prettyWords forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Words
ws

prettyList :: ListItems -> Text
prettyList :: ListItems -> Text
prettyList = [Text] -> Text
T.unlines forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ListItems -> [Text]
prettyListWork Int
0

prettyListWork :: Int -> ListItems -> [Text]
prettyListWork :: Int -> ListItems -> [Text]
prettyListWork Int
indent (ListItems ListType
t NonEmpty Item
is) = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Item -> [Text]
prettyItem) forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Item] -> [(Text, Item)]
relabel forall a b. (a -> b) -> a -> b
$ forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Item
is
  where
    relabel :: [Item] -> [(Text, Item)]
    relabel :: [Item] -> [(Text, Item)]
relabel = case ListType
t of
      ListType
Bulleted -> forall a b. (a -> b) -> [a] -> [b]
map (Text
"-",)
      ListType
Plussed  -> forall a b. (a -> b) -> [a] -> [b]
map (Text
"+",)
      ListType
Numbered -> forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith (\Int
n Item
i -> (forall a. Show a => a -> Text
tshow Int
n forall a. Semigroup a => a -> a -> a
<> Text
".", Item
i)) ([Int
1..] :: [Int])

    prettyItem :: Text -> Item -> [Text]
    prettyItem :: Text -> Item -> [Text]
prettyItem Text
lbl (Item NonEmpty Words
ws Maybe ListItems
sub) = Text
real forall a. a -> [a] -> [a]
: forall b a. b -> (a -> b) -> Maybe a -> b
maybe [] (Int -> ListItems -> [Text]
prettyListWork forall a b. (a -> b) -> a -> b
$ forall a. Enum a => a -> a
succ Int
indent) Maybe ListItems
sub
      where
        real :: Text
real = Text
prefix forall a. Semigroup a => a -> a -> a
<> Text
lbl forall a. Semigroup a => a -> a -> a
<> Text
" " forall a. Semigroup a => a -> a -> a
<> NonEmpty Words -> Text
prettyWordGroups NonEmpty Words
ws

    prefix :: Text
    prefix :: Text
prefix = Int -> Text -> Text
T.replicate (Int
2 forall a. Num a => a -> a -> a
* Int
indent) Text
" "

prettyWordGroups :: NonEmpty Words -> Text
prettyWordGroups :: NonEmpty Words -> Text
prettyWordGroups (Words
h :| [Words]
t) = Words -> Text
prettyWords Words
h forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
h [Words]
t
  where
    -- | Stick punctuation directly behind the chars in front of it, while
    -- paying special attention to parentheses.
    para :: Words -> [Words] -> Text
    para :: Words -> [Words] -> Text
para Words
_ []      = Text
""
    para Words
pr (Words
w:[Words]
ws) = case Words
pr of
      Punct Char
'(' -> Words -> Text
prettyWords Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
      Words
_ -> case Words
w of
        Punct Char
'(' -> Text
" " forall a. Semigroup a => a -> a -> a
<> Words -> Text
prettyWords Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
        Punct Char
_   -> Words -> Text
prettyWords Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
        Words
_         -> Text
" " forall a. Semigroup a => a -> a -> a
<> Words -> Text
prettyWords Words
w forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws

prettyWords :: Words -> Text
prettyWords :: Words -> Text
prettyWords Words
w = case Words
w of
  Bold Text
t                  -> Text
"*" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"*"
  Italic Text
t                -> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"/"
  Highlight Text
t             -> Text
"~" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"~"
  Underline Text
t             -> Text
"_" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"_"
  Verbatim Text
t              -> Text
"=" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"="
  Strike Text
t                -> Text
"+" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"+"
  Link (URL Text
url) Maybe Text
Nothing  -> Text
"[[" forall a. Semigroup a => a -> a -> a
<> Text
url forall a. Semigroup a => a -> a -> a
<> Text
"]]"
  Link (URL Text
url) (Just Text
t) -> Text
"[[" forall a. Semigroup a => a -> a -> a
<> Text
url forall a. Semigroup a => a -> a -> a
<> Text
"][" forall a. Semigroup a => a -> a -> a
<> Text
t forall a. Semigroup a => a -> a -> a
<> Text
"]]"
  Image (URL Text
url)         -> Text
"[[" forall a. Semigroup a => a -> a -> a
<> Text
url forall a. Semigroup a => a -> a -> a
<> Text
"]]"
  Punct Char
c                 -> Char -> Text
T.singleton Char
c
  Plain Text
t                 -> Text
t

tshow :: Show a => a -> Text
tshow :: forall a. Show a => a -> Text
tshow = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show