{-# LANGUAGE BangPatterns       #-}
{-# LANGUAGE DeriveAnyClass     #-}
{-# LANGUAGE DeriveGeneric      #-}
{-# LANGUAGE DerivingStrategies #-}

-- |
-- 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(..)
  , 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.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           Text.Megaparsec.Char.Lexer (decimal)
import qualified Text.Megaparsec.Char.Lexer as L
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
(OrgFile -> OrgFile -> Bool)
-> (OrgFile -> OrgFile -> Bool) -> Eq OrgFile
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
Eq OrgFile
-> (OrgFile -> OrgFile -> Ordering)
-> (OrgFile -> OrgFile -> Bool)
-> (OrgFile -> OrgFile -> Bool)
-> (OrgFile -> OrgFile -> Bool)
-> (OrgFile -> OrgFile -> Bool)
-> (OrgFile -> OrgFile -> OrgFile)
-> (OrgFile -> OrgFile -> OrgFile)
-> Ord 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
$cp1Ord :: Eq OrgFile
Ord, Int -> OrgFile -> ShowS
[OrgFile] -> ShowS
OrgFile -> String
(Int -> OrgFile -> ShowS)
-> (OrgFile -> String) -> ([OrgFile] -> ShowS) -> Show OrgFile
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. OrgFile -> Rep OrgFile x)
-> (forall x. Rep OrgFile x -> OrgFile) -> Generic OrgFile
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 Map Text Text
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
(OrgDoc -> OrgDoc -> Bool)
-> (OrgDoc -> OrgDoc -> Bool) -> Eq OrgDoc
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
Eq OrgDoc
-> (OrgDoc -> OrgDoc -> Ordering)
-> (OrgDoc -> OrgDoc -> Bool)
-> (OrgDoc -> OrgDoc -> Bool)
-> (OrgDoc -> OrgDoc -> Bool)
-> (OrgDoc -> OrgDoc -> Bool)
-> (OrgDoc -> OrgDoc -> OrgDoc)
-> (OrgDoc -> OrgDoc -> OrgDoc)
-> Ord 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
$cp1Ord :: Eq OrgDoc
Ord, Int -> OrgDoc -> ShowS
[OrgDoc] -> ShowS
OrgDoc -> String
(Int -> OrgDoc -> ShowS)
-> (OrgDoc -> String) -> ([OrgDoc] -> ShowS) -> Show OrgDoc
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. OrgDoc -> Rep OrgDoc x)
-> (forall x. Rep OrgDoc x -> OrgDoc) -> Generic OrgDoc
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 = (Section -> Set Text) -> [Section] -> Set Text
forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap Section -> Set Text
allSectionTags ([Section] -> Set Text)
-> (OrgDoc -> [Section]) -> OrgDoc -> Set Text
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
(Block -> Block -> Bool) -> (Block -> Block -> Bool) -> Eq Block
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
Eq Block
-> (Block -> Block -> Ordering)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Bool)
-> (Block -> Block -> Block)
-> (Block -> Block -> Block)
-> Ord 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
$cp1Ord :: Eq Block
Ord, Int -> Block -> ShowS
[Block] -> ShowS
Block -> String
(Int -> Block -> ShowS)
-> (Block -> String) -> ([Block] -> ShowS) -> Show Block
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. Block -> Rep Block x)
-> (forall x. Rep Block x -> Block) -> Generic Block
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
(OrgDateTime -> OrgDateTime -> Bool)
-> (OrgDateTime -> OrgDateTime -> Bool) -> Eq OrgDateTime
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
(Int -> OrgDateTime -> ShowS)
-> (OrgDateTime -> String)
-> ([OrgDateTime] -> ShowS)
-> Show OrgDateTime
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 Day -> Day -> Ordering
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) -> OrgTime -> OrgTime -> Ordering
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
(OrgTime -> OrgTime -> Bool)
-> (OrgTime -> OrgTime -> Bool) -> Eq OrgTime
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
Eq OrgTime
-> (OrgTime -> OrgTime -> Ordering)
-> (OrgTime -> OrgTime -> Bool)
-> (OrgTime -> OrgTime -> Bool)
-> (OrgTime -> OrgTime -> Bool)
-> (OrgTime -> OrgTime -> Bool)
-> (OrgTime -> OrgTime -> OrgTime)
-> (OrgTime -> OrgTime -> OrgTime)
-> Ord 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
$cp1Ord :: Eq OrgTime
Ord, Int -> OrgTime -> ShowS
[OrgTime] -> ShowS
OrgTime -> String
(Int -> OrgTime -> ShowS)
-> (OrgTime -> String) -> ([OrgTime] -> ShowS) -> Show OrgTime
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
(Repeater -> Repeater -> Bool)
-> (Repeater -> Repeater -> Bool) -> Eq Repeater
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
Eq Repeater
-> (Repeater -> Repeater -> Ordering)
-> (Repeater -> Repeater -> Bool)
-> (Repeater -> Repeater -> Bool)
-> (Repeater -> Repeater -> Bool)
-> (Repeater -> Repeater -> Bool)
-> (Repeater -> Repeater -> Repeater)
-> (Repeater -> Repeater -> Repeater)
-> Ord 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
$cp1Ord :: Eq Repeater
Ord, Int -> Repeater -> ShowS
[Repeater] -> ShowS
Repeater -> String
(Int -> Repeater -> ShowS)
-> (Repeater -> String) -> ([Repeater] -> ShowS) -> Show Repeater
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
(RepeatMode -> RepeatMode -> Bool)
-> (RepeatMode -> RepeatMode -> Bool) -> Eq RepeatMode
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
Eq RepeatMode
-> (RepeatMode -> RepeatMode -> Ordering)
-> (RepeatMode -> RepeatMode -> Bool)
-> (RepeatMode -> RepeatMode -> Bool)
-> (RepeatMode -> RepeatMode -> Bool)
-> (RepeatMode -> RepeatMode -> Bool)
-> (RepeatMode -> RepeatMode -> RepeatMode)
-> (RepeatMode -> RepeatMode -> RepeatMode)
-> Ord 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
$cp1Ord :: Eq RepeatMode
Ord, Int -> RepeatMode -> ShowS
[RepeatMode] -> ShowS
RepeatMode -> String
(Int -> RepeatMode -> ShowS)
-> (RepeatMode -> String)
-> ([RepeatMode] -> ShowS)
-> Show RepeatMode
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
(Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool) -> Eq Interval
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
Eq Interval
-> (Interval -> Interval -> Ordering)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Bool)
-> (Interval -> Interval -> Interval)
-> (Interval -> Interval -> Interval)
-> Ord 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
$cp1Ord :: Eq Interval
Ord, Int -> Interval -> ShowS
[Interval] -> ShowS
Interval -> String
(Int -> Interval -> ShowS)
-> (Interval -> String) -> ([Interval] -> ShowS) -> Show Interval
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
(Delay -> Delay -> Bool) -> (Delay -> Delay -> Bool) -> Eq Delay
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
Eq Delay
-> (Delay -> Delay -> Ordering)
-> (Delay -> Delay -> Bool)
-> (Delay -> Delay -> Bool)
-> (Delay -> Delay -> Bool)
-> (Delay -> Delay -> Bool)
-> (Delay -> Delay -> Delay)
-> (Delay -> Delay -> Delay)
-> Ord 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
$cp1Ord :: Eq Delay
Ord, Int -> Delay -> ShowS
[Delay] -> ShowS
Delay -> String
(Int -> Delay -> ShowS)
-> (Delay -> String) -> ([Delay] -> ShowS) -> Show Delay
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
(DelayMode -> DelayMode -> Bool)
-> (DelayMode -> DelayMode -> Bool) -> Eq DelayMode
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
Eq DelayMode
-> (DelayMode -> DelayMode -> Ordering)
-> (DelayMode -> DelayMode -> Bool)
-> (DelayMode -> DelayMode -> Bool)
-> (DelayMode -> DelayMode -> Bool)
-> (DelayMode -> DelayMode -> Bool)
-> (DelayMode -> DelayMode -> DelayMode)
-> (DelayMode -> DelayMode -> DelayMode)
-> Ord 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
$cp1Ord :: Eq DelayMode
Ord, Int -> DelayMode -> ShowS
[DelayMode] -> ShowS
DelayMode -> String
(Int -> DelayMode -> ShowS)
-> (DelayMode -> String)
-> ([DelayMode] -> ShowS)
-> Show DelayMode
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
(Section -> Section -> Bool)
-> (Section -> Section -> Bool) -> Eq Section
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
Eq Section
-> (Section -> Section -> Ordering)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Bool)
-> (Section -> Section -> Section)
-> (Section -> Section -> Section)
-> Ord 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
$cp1Ord :: Eq Section
Ord, Int -> Section -> ShowS
[Section] -> ShowS
Section -> String
(Int -> Section -> ShowS)
-> (Section -> String) -> ([Section] -> ShowS) -> Show Section
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. Section -> Rep Section x)
-> (forall x. Rep Section x -> Section) -> Generic Section
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 Maybe Todo
forall a. Maybe a
Nothing Maybe Priority
forall a. Maybe a
Nothing (Words
wsWords -> [Words] -> NonEmpty Words
forall a. a -> [a] -> NonEmpty a
:|[]) [] Maybe OrgDateTime
forall a. Maybe a
Nothing Maybe OrgDateTime
forall a. Maybe a
Nothing Maybe OrgDateTime
forall a. Maybe a
Nothing Maybe OrgDateTime
forall a. Maybe a
Nothing Map Text Text
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) = [Text] -> Set Text
forall a. Ord a => [a] -> Set a
S.fromList [Text]
sts Set Text -> Set Text -> Set Text
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
(Todo -> Todo -> Bool) -> (Todo -> Todo -> Bool) -> Eq Todo
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
Eq Todo
-> (Todo -> Todo -> Ordering)
-> (Todo -> Todo -> Bool)
-> (Todo -> Todo -> Bool)
-> (Todo -> Todo -> Bool)
-> (Todo -> Todo -> Bool)
-> (Todo -> Todo -> Todo)
-> (Todo -> Todo -> Todo)
-> Ord 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
$cp1Ord :: Eq Todo
Ord, Int -> Todo -> ShowS
[Todo] -> ShowS
Todo -> String
(Int -> Todo -> ShowS)
-> (Todo -> String) -> ([Todo] -> ShowS) -> Show Todo
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. Todo -> Rep Todo x)
-> (forall x. Rep Todo x -> Todo) -> Generic Todo
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
(Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool) -> Eq Priority
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
Eq Priority
-> (Priority -> Priority -> Ordering)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Bool)
-> (Priority -> Priority -> Priority)
-> (Priority -> Priority -> Priority)
-> Ord 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
$cp1Ord :: Eq Priority
Ord, Int -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
(Int -> Priority -> ShowS)
-> (Priority -> String) -> ([Priority] -> ShowS) -> Show Priority
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. Priority -> Rep Priority x)
-> (forall x. Rep Priority x -> Priority) -> Generic Priority
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 @-@ characters.
--
-- @
-- - Feed the cat
--   - The good stuff
-- - Feed the dog
--   - He'll eat anything
-- - Feed the bird
-- - Feed the alligator
-- - Feed the elephant
-- @
newtype ListItems = ListItems (NonEmpty Item)
  deriving stock (ListItems -> ListItems -> Bool
(ListItems -> ListItems -> Bool)
-> (ListItems -> ListItems -> Bool) -> Eq ListItems
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
Eq ListItems
-> (ListItems -> ListItems -> Ordering)
-> (ListItems -> ListItems -> Bool)
-> (ListItems -> ListItems -> Bool)
-> (ListItems -> ListItems -> Bool)
-> (ListItems -> ListItems -> Bool)
-> (ListItems -> ListItems -> ListItems)
-> (ListItems -> ListItems -> ListItems)
-> Ord 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
$cp1Ord :: Eq ListItems
Ord, Int -> ListItems -> ShowS
[ListItems] -> ShowS
ListItems -> String
(Int -> ListItems -> ShowS)
-> (ListItems -> String)
-> ([ListItems] -> ShowS)
-> Show ListItems
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. ListItems -> Rep ListItems x)
-> (forall x. Rep ListItems x -> ListItems) -> Generic ListItems
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)

-- | 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
(Item -> Item -> Bool) -> (Item -> Item -> Bool) -> Eq Item
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
Eq Item
-> (Item -> Item -> Ordering)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Bool)
-> (Item -> Item -> Item)
-> (Item -> Item -> Item)
-> Ord 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
$cp1Ord :: Eq Item
Ord, Int -> Item -> ShowS
[Item] -> ShowS
Item -> String
(Int -> Item -> ShowS)
-> (Item -> String) -> ([Item] -> ShowS) -> Show Item
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. Item -> Rep Item x)
-> (forall x. Rep Item x -> Item) -> Generic Item
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
(Row -> Row -> Bool) -> (Row -> Row -> Bool) -> Eq Row
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
Eq Row
-> (Row -> Row -> Ordering)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Bool)
-> (Row -> Row -> Row)
-> (Row -> Row -> Row)
-> Ord 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
$cp1Ord :: Eq Row
Ord, Int -> Row -> ShowS
[Row] -> ShowS
Row -> String
(Int -> Row -> ShowS)
-> (Row -> String) -> ([Row] -> ShowS) -> Show Row
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. Row -> Rep Row x)
-> (forall x. Rep Row x -> Row) -> Generic Row
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
(Column -> Column -> Bool)
-> (Column -> Column -> Bool) -> Eq Column
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
Eq Column
-> (Column -> Column -> Ordering)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Bool)
-> (Column -> Column -> Column)
-> (Column -> Column -> Column)
-> Ord 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
$cp1Ord :: Eq Column
Ord, Int -> Column -> ShowS
[Column] -> ShowS
Column -> String
(Int -> Column -> ShowS)
-> (Column -> String) -> ([Column] -> ShowS) -> Show Column
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. Column -> Rep Column x)
-> (forall x. Rep Column x -> Column) -> Generic Column
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
(Words -> Words -> Bool) -> (Words -> Words -> Bool) -> Eq Words
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
Eq Words
-> (Words -> Words -> Ordering)
-> (Words -> Words -> Bool)
-> (Words -> Words -> Bool)
-> (Words -> Words -> Bool)
-> (Words -> Words -> Bool)
-> (Words -> Words -> Words)
-> (Words -> Words -> Words)
-> Ord 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
$cp1Ord :: Eq Words
Ord, Int -> Words -> ShowS
[Words] -> ShowS
Words -> String
(Int -> Words -> ShowS)
-> (Words -> String) -> ([Words] -> ShowS) -> Show Words
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. Words -> Rep Words x)
-> (forall x. Rep Words x -> Words) -> Generic Words
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
Eq Words
-> (Int -> Words -> Int) -> (Words -> Int) -> Hashable 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
$cp1Hashable :: Eq Words
Hashable)

-- | The url portion of a link.
newtype URL = URL Text
  deriving stock (URL -> URL -> Bool
(URL -> URL -> Bool) -> (URL -> URL -> Bool) -> Eq URL
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
Eq URL
-> (URL -> URL -> Ordering)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> Bool)
-> (URL -> URL -> URL)
-> (URL -> URL -> URL)
-> Ord 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
$cp1Ord :: Eq URL
Ord, Int -> URL -> ShowS
[URL] -> ShowS
URL -> String
(Int -> URL -> ShowS)
-> (URL -> String) -> ([URL] -> ShowS) -> Show URL
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. URL -> Rep URL x)
-> (forall x. Rep URL x -> URL) -> Generic URL
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
Eq URL -> (Int -> URL -> Int) -> (URL -> Int) -> Hashable 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
$cp1Hashable :: Eq URL
Hashable)

-- | The programming language some source code block was written in.
newtype Language = Language Text
  deriving stock (Language -> Language -> Bool
(Language -> Language -> Bool)
-> (Language -> Language -> Bool) -> Eq Language
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
Eq Language
-> (Language -> Language -> Ordering)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Bool)
-> (Language -> Language -> Language)
-> (Language -> Language -> Language)
-> Ord 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
$cp1Ord :: Eq Language
Ord, Int -> Language -> ShowS
[Language] -> ShowS
Language -> String
(Int -> Language -> ShowS)
-> (Language -> String) -> ([Language] -> ShowS) -> Show Language
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. Language -> Rep Language x)
-> (forall x. Rep Language x -> Language) -> Generic Language
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 = Parsec Void Text OrgFile -> Text -> Maybe OrgFile
forall e s a. (Ord e, Stream s) => Parsec e s a -> s -> Maybe a
parseMaybe Parsec Void Text OrgFile
orgFile

type Parser = Parsec Void Text

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

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

orgP :: Parser OrgDoc
orgP :: ParsecT Void Text Identity OrgDoc
orgP = Int -> ParsecT Void Text Identity OrgDoc
orgP' Int
1

orgP' :: Int -> Parser OrgDoc
orgP' :: Int -> ParsecT Void Text Identity OrgDoc
orgP' Int
depth = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity OrgDoc
-> ParsecT Void Text Identity OrgDoc
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity OrgDoc
 -> ParsecT Void Text Identity OrgDoc)
-> ParsecT Void Text Identity OrgDoc
-> ParsecT Void Text Identity OrgDoc
forall a b. (a -> b) -> a -> b
$ [Block] -> [Section] -> OrgDoc
OrgDoc
  ([Block] -> [Section] -> OrgDoc)
-> ParsecT Void Text Identity [Block]
-> ParsecT Void Text Identity ([Section] -> OrgDoc)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity [Block]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many ParsecT Void Text Identity Block
block
  ParsecT Void Text Identity ([Section] -> OrgDoc)
-> ParsecT Void Text Identity [Section]
-> ParsecT Void Text Identity OrgDoc
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity [Section]
forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Section
 -> ParsecT Void Text Identity Section)
-> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall a b. (a -> b) -> a -> b
$ Int -> ParsecT Void Text Identity Section
section Int
depth)
  where
    block :: Parser Block
    block :: ParsecT Void Text Identity Block
block = [ParsecT Void Text Identity Block]
-> ParsecT Void Text Identity Block
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
      [ ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
code
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
example
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
quote
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
list
      , ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try ParsecT Void Text Identity Block
table
      , ParsecT Void Text Identity 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 -> ParsecT Void Text Identity Text
someOf Char
'*' ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
' '
  (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 -> (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
-> Parser
     (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
stars, Maybe Todo
mtd, Maybe Priority
mpr, NonEmpty Words
ws, [])
    Just NonEmpty Text
ts -> (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
-> Parser
     (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
stars, Maybe Todo
mtd, Maybe Priority
mpr, NonEmpty Words
ws, NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Text
ts)

section :: Int -> Parser Section
section :: Int -> ParsecT Void Text Identity Section
section Int
depth = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Section
 -> ParsecT Void Text Identity Section)
-> ParsecT Void Text Identity Section
-> ParsecT Void Text Identity Section
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 --
  Bool
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Text -> Int
T.length Text
stars Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
depth) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text)) -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure Maybe (ErrorItem (Token Text))
forall a. Maybe a
Nothing Set (ErrorItem (Token Text))
forall a. Monoid a => a
mempty
  -- Otherwise continue --
  (Maybe OrgDateTime
cl, Maybe OrgDateTime
dl, Maybe OrgDateTime
sc) <- (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> Maybe (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
forall a. a -> Maybe a -> a
fromMaybe (Maybe OrgDateTime
forall a. Maybe a
Nothing, Maybe OrgDateTime
forall a. Maybe a
Nothing, Maybe OrgDateTime
forall a. Maybe a
Nothing) (Maybe (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
 -> (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime))
-> ParsecT
     Void
     Text
     Identity
     (Maybe (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime))
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT
  Void
  Text
  Identity
  (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> ParsecT
     Void
     Text
     Identity
     (Maybe (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT
  Void
  Text
  Identity
  (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT
   Void
   Text
   Identity
   (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
 -> ParsecT
      Void
      Text
      Identity
      (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime))
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
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 <- ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity (Maybe OrgDateTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity OrgDateTime
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity OrgDateTime
 -> ParsecT Void Text Identity OrgDateTime)
-> ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity OrgDateTime
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity OrgDateTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity OrgDateTime
stamp)
  Map Text Text
props <- Map Text Text -> Maybe (Map Text Text) -> Map Text Text
forall a. a -> Maybe a -> a
fromMaybe Map Text Text
forall a. Monoid a => a
mempty (Maybe (Map Text Text) -> Map Text Text)
-> ParsecT Void Text Identity (Maybe (Map Text Text))
-> ParsecT Void Text Identity (Map Text Text)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (Maybe (Map Text Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (Map Text Text)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity (Map Text Text)
 -> ParsecT Void Text Identity (Map Text Text))
-> ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (Map Text Text)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (Map Text Text)
-> ParsecT Void Text Identity (Map Text Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity (Map Text Text)
properties)
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
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 (OrgDoc -> Section)
-> ParsecT Void Text Identity OrgDoc
-> ParsecT Void Text Identity Section
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity OrgDoc
orgP' (Int -> Int
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 <- ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity (Maybe OrgDateTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity OrgDateTime
closed
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Maybe OrgDateTime
md <- ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity (Maybe OrgDateTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity OrgDateTime
deadline
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Maybe OrgDateTime
ms <- ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity (Maybe OrgDateTime)
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) -> Maybe (ErrorItem (Token Text))
-> Set (ErrorItem (Token Text))
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
forall e s (m :: * -> *) a.
MonadParsec e s m =>
Maybe (ErrorItem (Token s)) -> Set (ErrorItem (Token s)) -> m a
failure Maybe (ErrorItem (Token Text))
forall a. Maybe a
Nothing Set (ErrorItem (Token Text))
forall a. Monoid a => a
mempty
    (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
_                           -> (Maybe OrgDateTime, Maybe OrgDateTime, Maybe OrgDateTime)
-> ParsecT
     Void
     Text
     Identity
     (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 = ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity OrgDateTime
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'<') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'>') ParsecT Void Text Identity OrgDateTime
timestamp

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

deadline :: Parser OrgDateTime
deadline :: ParsecT Void Text Identity OrgDateTime
deadline = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DEADLINE: " ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity OrgDateTime
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 = Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"SCHEDULED: " ParsecT Void Text Identity Text
-> ParsecT Void Text Identity OrgDateTime
-> ParsecT Void Text Identity OrgDateTime
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
  (Day
 -> DayOfWeek
 -> Maybe OrgTime
 -> Maybe Repeater
 -> Maybe Delay
 -> OrgDateTime)
-> ParsecT Void Text Identity Day
-> ParsecT
     Void
     Text
     Identity
     (DayOfWeek
      -> Maybe OrgTime -> Maybe Repeater -> Maybe Delay -> OrgDateTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Day
date
  ParsecT
  Void
  Text
  Identity
  (DayOfWeek
   -> Maybe OrgTime -> Maybe Repeater -> Maybe Delay -> OrgDateTime)
-> ParsecT Void Text Identity DayOfWeek
-> ParsecT
     Void
     Text
     Identity
     (Maybe OrgTime -> Maybe Repeater -> Maybe Delay -> OrgDateTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 ParsecT Void Text Identity ()
-> ParsecT Void Text Identity DayOfWeek
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity DayOfWeek
dow)
  ParsecT
  Void
  Text
  Identity
  (Maybe OrgTime -> Maybe Repeater -> Maybe Delay -> OrgDateTime)
-> ParsecT Void Text Identity (Maybe OrgTime)
-> ParsecT
     Void Text Identity (Maybe Repeater -> Maybe Delay -> OrgDateTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity OrgTime
-> ParsecT Void Text Identity (Maybe OrgTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity OrgTime
-> ParsecT Void Text Identity OrgTime
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity OrgTime
 -> ParsecT Void Text Identity OrgTime)
-> ParsecT Void Text Identity OrgTime
-> ParsecT Void Text Identity OrgTime
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 ParsecT Void Text Identity ()
-> ParsecT Void Text Identity OrgTime
-> ParsecT Void Text Identity OrgTime
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity OrgTime
timeRange)
  ParsecT
  Void Text Identity (Maybe Repeater -> Maybe Delay -> OrgDateTime)
-> ParsecT Void Text Identity (Maybe Repeater)
-> ParsecT Void Text Identity (Maybe Delay -> OrgDateTime)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Repeater
-> ParsecT Void Text Identity (Maybe Repeater)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Repeater
-> ParsecT Void Text Identity Repeater
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Repeater
 -> ParsecT Void Text Identity Repeater)
-> ParsecT Void Text Identity Repeater
-> ParsecT Void Text Identity Repeater
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Repeater
-> ParsecT Void Text Identity Repeater
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Repeater
repeater)
  ParsecT Void Text Identity (Maybe Delay -> OrgDateTime)
-> ParsecT Void Text Identity (Maybe Delay)
-> ParsecT Void Text Identity OrgDateTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Delay
-> ParsecT Void Text Identity (Maybe Delay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Delay
-> ParsecT Void Text Identity Delay
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Delay
delay)

date :: Parser Day
date :: ParsecT Void Text Identity Day
date = Integer -> Int -> Int -> Day
fromGregorian (Integer -> Int -> Int -> Day)
-> ParsecT Void Text Identity Integer
-> ParsecT Void Text Identity (Int -> Int -> Day)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Integer
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal ParsecT Void Text Identity (Int -> Int -> Day)
-> ParsecT Void Text Identity Int
-> ParsecT Void Text Identity (Int -> Day)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal) ParsecT Void Text Identity (Int -> Day)
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Day
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Int -> ParsecT Void Text Identity Int
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity Int
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 = [ParsecT Void Text Identity DayOfWeek]
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ DayOfWeek
Monday    DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Mon"
  , DayOfWeek
Tuesday   DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Tue"
  , DayOfWeek
Wednesday DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Wed"
  , DayOfWeek
Thursday  DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Thu"
  , DayOfWeek
Friday    DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Fri"
  , DayOfWeek
Saturday  DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"Sat"
  , DayOfWeek
Sunday    DayOfWeek
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity DayOfWeek
forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
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 (TimeOfDay -> Maybe TimeOfDay -> OrgTime)
-> ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity (Maybe TimeOfDay -> OrgTime)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity TimeOfDay
t ParsecT Void Text Identity (Maybe TimeOfDay -> OrgTime)
-> ParsecT Void Text Identity (Maybe TimeOfDay)
-> ParsecT Void Text Identity OrgTime
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity (Maybe TimeOfDay)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'-' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity TimeOfDay
-> ParsecT Void Text Identity TimeOfDay
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity TimeOfDay
t)
  where
    t :: Parser TimeOfDay
    t :: ParsecT Void Text Identity TimeOfDay
t = do
      Int
h <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
      Int
m <- ParsecT Void Text Identity Int
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      Maybe Pico
s <- ParsecT Void Text Identity Pico
-> ParsecT Void Text Identity (Maybe Pico)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Pico
 -> ParsecT Void Text Identity (Maybe Pico))
-> ParsecT Void Text Identity Pico
-> ParsecT Void Text Identity (Maybe Pico)
forall a b. (a -> b) -> a -> b
$ do
        ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
        ParsecT Void Text Identity Pico
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
      TimeOfDay -> ParsecT Void Text Identity TimeOfDay
forall (f :: * -> *) a. Applicative f => a -> f a
pure (TimeOfDay -> ParsecT Void Text Identity TimeOfDay)
-> TimeOfDay -> ParsecT Void Text Identity TimeOfDay
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Pico -> TimeOfDay
TimeOfDay Int
h Int
m (Pico -> Maybe Pico -> Pico
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
  (RepeatMode -> Word -> Interval -> Repeater)
-> ParsecT Void Text Identity RepeatMode
-> ParsecT Void Text Identity (Word -> Interval -> Repeater)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [ParsecT Void Text Identity RepeatMode]
-> ParsecT Void Text Identity RepeatMode
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice [ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
".+" ParsecT Void Text Identity Text
-> RepeatMode -> ParsecT Void Text Identity RepeatMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RepeatMode
FromToday, Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"++" ParsecT Void Text Identity Text
-> RepeatMode -> ParsecT Void Text Identity RepeatMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RepeatMode
Jump, Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+' ParsecT Void Text Identity Char
-> RepeatMode -> ParsecT Void Text Identity RepeatMode
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> RepeatMode
Single ]
  ParsecT Void Text Identity (Word -> Interval -> Repeater)
-> ParsecT Void Text Identity Word
-> ParsecT Void Text Identity (Interval -> Repeater)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Word
forall e s (m :: * -> *) a.
(MonadParsec e s m, Token s ~ Char, Num a) =>
m a
decimal
  ParsecT Void Text Identity (Interval -> Repeater)
-> ParsecT Void Text Identity Interval
-> ParsecT Void Text Identity Repeater
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ParsecT Void Text Identity Interval
interval

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

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

properties :: Parser (M.Map Text Text)
properties :: ParsecT Void Text Identity (Map Text Text)
properties = do
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":PROPERTIES:"
  ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  [(Text, Text)]
ps <- (ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace ParsecT Void Text Identity ()
-> Parser (Text, Text) -> Parser (Text, Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Text)
property Parser (Text, Text)
-> ParsecT Void Text Identity Char -> Parser (Text, Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline Parser (Text, Text)
-> ParsecT Void Text Identity () -> Parser (Text, Text)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace) Parser (Text, Text)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity [(Text, Text)]
forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
`manyTill` Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
":END:"
  Map Text Text -> ParsecT Void Text Identity (Map Text Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Map Text Text -> ParsecT Void Text Identity (Map Text Text))
-> Map Text Text -> ParsecT Void Text Identity (Map Text Text)
forall a b. (a -> b) -> a -> b
$ [(Text, Text)] -> Map Text Text
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
  ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  Text
key <- Char -> ParsecT Void Text Identity Text
someTill' Char
':' -- TODO Newlines?
  ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Char -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
':'
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Text
val <- Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"Property Value") (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  (Text, Text) -> Parser (Text, Text)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text
key, Text
val)

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

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

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

list :: Parser Block
list :: ParsecT Void Text Identity Block
list = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ ListItems -> Block
List (ListItems -> Block)
-> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> ParsecT Void Text Identity ListItems
listItems Int
0

listItems :: Int -> Parser ListItems
listItems :: Int -> ParsecT Void Text Identity ListItems
listItems Int
indent = NonEmpty Item -> ListItems
ListItems
  (NonEmpty Item -> ListItems)
-> ParsecT Void Text Identity (NonEmpty Item)
-> ParsecT Void Text Identity ListItems
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Item
-> ParsecT Void Text Identity ()
-> ParsecT Void Text Identity (NonEmpty Item)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepBy1 (Int -> ParsecT Void Text Identity Item
item Int
indent) (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (Int -> ParsecT Void Text Identity ()
nextItem Int
indent))

nextItem :: Int -> Parser ()
nextItem :: Int -> ParsecT Void Text Identity ()
nextItem Int
indent = do
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> (Text -> ParsecT Void Text Identity Text)
-> Text
-> ParsecT Void Text Identity ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ParsecT Void Text Identity Text
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Text -> ParsecT Void Text Identity ())
-> Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
indent Text
" "
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"- "

-- | 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 are "- ".
item :: Int -> Parser Item
item :: Int -> ParsecT Void Text Identity Item
item Int
indent = do
  Text
leading <- Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (Tokens Text -> ParsecT Void Text Identity (Tokens Text))
-> Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
indent Text
" "
  ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Void Text Identity Text -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity Text -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"- "
  NonEmpty Words
l <- Parser (NonEmpty Words)
bullet
  let !nextInd :: Int
nextInd = Text -> Int
T.length Text
leading Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2
  NonEmpty Words -> Maybe ListItems -> Item
Item NonEmpty Words
l (Maybe ListItems -> Item)
-> ParsecT Void Text Identity (Maybe ListItems)
-> ParsecT Void Text Identity Item
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity (Maybe ListItems)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity ListItems
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity ListItems
 -> ParsecT Void Text Identity ListItems)
-> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity ListItems
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline ParsecT Void Text Identity Char
-> ParsecT Void Text Identity ListItems
-> ParsecT Void Text Identity ListItems
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Int -> ParsecT Void Text Identity ListItems
listItems Int
nextInd)
  where
    bullet :: Parser (NonEmpty Words)
    bullet :: Parser (NonEmpty Words)
bullet = do
      NonEmpty Words
l <- Char -> Parser (NonEmpty Words)
line Char
'\n'
      Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead ParsecT Void Text Identity ()
keepGoing ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space ParsecT Void Text Identity ()
-> Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ((NonEmpty Words
l NonEmpty Words -> NonEmpty Words -> NonEmpty Words
forall a. Semigroup a => a -> a -> a
<>) (NonEmpty Words -> NonEmpty Words)
-> Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty Words)
bullet)) Parser (NonEmpty Words)
-> Parser (NonEmpty Words) -> Parser (NonEmpty Words)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> NonEmpty Words -> Parser (NonEmpty Words)
forall (f :: * -> *) a. Applicative f => a -> f a
pure NonEmpty Words
l

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

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

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

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

paragraph :: Parser Block
paragraph :: ParsecT Void Text Identity Block
paragraph = ParsecT Void Text Identity ()
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall e s (m :: * -> *) a. MonadParsec e s m => m () -> m a -> m a
L.lexeme ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space (ParsecT Void Text Identity Block
 -> ParsecT Void Text Identity Block)
-> ParsecT Void Text Identity Block
-> ParsecT Void Text Identity Block
forall a b. (a -> b) -> a -> b
$ do
  Parser (Text, Maybe Todo, Maybe Priority, NonEmpty Words, [Text])
-> ParsecT Void Text Identity ()
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 (NonEmpty Words -> Block)
-> (NonEmpty (NonEmpty Words) -> NonEmpty Words)
-> NonEmpty (NonEmpty Words)
-> Block
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonEmpty (NonEmpty Words) -> NonEmpty Words
forall a. Semigroup a => NonEmpty a -> a
sconcat (NonEmpty (NonEmpty Words) -> Block)
-> ParsecT Void Text Identity (NonEmpty (NonEmpty Words))
-> ParsecT Void Text Identity Block
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (NonEmpty Words)
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity (NonEmpty (NonEmpty Words))
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
sepEndBy1 (Char -> Parser (NonEmpty Words)
line Char
'\n') ParsecT Void Text Identity Char
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 <- ParsecT Void Text Identity Todo
-> ParsecT Void Text Identity (Maybe Todo)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Todo
 -> ParsecT Void Text Identity (Maybe Todo))
-> (ParsecT Void Text Identity Todo
    -> ParsecT Void Text Identity Todo)
-> ParsecT Void Text Identity Todo
-> ParsecT Void Text Identity (Maybe Todo)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Todo -> ParsecT Void Text Identity Todo
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Todo
 -> ParsecT Void Text Identity (Maybe Todo))
-> ParsecT Void Text Identity Todo
-> ParsecT Void Text Identity (Maybe Todo)
forall a b. (a -> b) -> a -> b
$ (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"TODO" ParsecT Void Text Identity Text
-> Todo -> ParsecT Void Text Identity Todo
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Todo
TODO) ParsecT Void Text Identity Todo
-> ParsecT Void Text Identity Todo
-> ParsecT Void Text Identity Todo
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> (Tokens Text -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"DONE" ParsecT Void Text Identity Text
-> Todo -> ParsecT Void Text Identity Todo
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Todo
DONE)
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  Maybe Priority
pr <- ParsecT Void Text Identity Priority
-> ParsecT Void Text Identity (Maybe Priority)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ParsecT Void Text Identity Priority
 -> ParsecT Void Text Identity (Maybe Priority))
-> (ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Priority)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Priority)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ParsecT Void Text Identity Priority
-> ParsecT Void Text Identity Priority
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity Priority
 -> ParsecT Void Text Identity Priority)
-> (ParsecT Void Text Identity Text
    -> ParsecT Void Text Identity Priority)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Priority
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Priority)
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Priority
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Priority
Priority (ParsecT Void Text Identity Text
 -> ParsecT Void Text Identity (Maybe Priority))
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity (Maybe Priority)
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'[') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
']') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'#' ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Char -> ParsecT Void Text Identity Text
someTill' Char
']')
  ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
  NonEmpty Words
ws <- (Char -> Parser Words
wordChunk Char
'\n' Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace) Parser Words
-> ParsecT Void Text Identity () -> Parser (NonEmpty Words)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`someTill` ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity (NonEmpty Text)
-> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ParsecT Void Text Identity (NonEmpty Text)
tags ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'\n') ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof)
  Maybe (NonEmpty Text)
ts <- ParsecT Void Text Identity (NonEmpty Text)
-> ParsecT Void Text Identity (Maybe (NonEmpty Text))
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional ParsecT Void Text Identity (NonEmpty Text)
tags
  (Maybe Todo, Maybe Priority, NonEmpty Words, Maybe (NonEmpty Text))
-> Parser
     (Maybe Todo, Maybe Priority, NonEmpty Words, Maybe (NonEmpty Text))
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 -> Parser Words
wordChunk Char
end Parser Words
-> ParsecT Void Text Identity Text -> Parser (NonEmpty Words)
forall (m :: * -> *) a sep.
Alternative m =>
m a -> m sep -> m (NonEmpty a)
`sepEndBy1` Char -> ParsecT Void Text Identity 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 -> Parser Words
wordChunk Char
end = [Parser Words] -> Parser Words
forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
  [ Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Bold      (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'*') (Char -> ParsecT Void Text Identity Text
someTill' Char
'*') Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Italic    (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'/') (Char -> ParsecT Void Text Identity Text
someTill' Char
'/') Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Highlight (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'~') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'~') (Char -> ParsecT Void Text Identity Text
someTill' Char
'~') Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Verbatim  (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'=') (Char -> ParsecT Void Text Identity Text
someTill' Char
'=') Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Underline (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'_') (Char -> ParsecT Void Text Identity Text
someTill' Char
'_') Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Text -> Words
Strike    (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Char
-> ParsecT Void Text Identity Text
-> ParsecT Void Text Identity Text
forall (m :: * -> *) open close a.
Applicative m =>
m open -> m close -> m a -> m a
between (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+') (Token Text -> ParsecT Void Text Identity (Token Text)
forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
Token Text
'+') (Char -> ParsecT Void Text Identity Text
someTill' Char
'+') Parser Words -> ParsecT Void Text Identity () -> Parser Words
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* ParsecT Void Text Identity ()
pOrS
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Words
image
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try Parser Words
link
  , Parser Words -> Parser Words
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (Parser Words -> Parser Words) -> Parser Words -> Parser Words
forall a b. (a -> b) -> a -> b
$ Char -> Words
Punct     (Char -> Words) -> ParsecT Void Text Identity Char -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf String
[Token Text]
punc
  , Text -> Words
Plain           (Text -> Words) -> ParsecT Void Text Identity Text -> Parser Words
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (String -> Maybe String
forall a. a -> Maybe a
Just String
"plain text") (\Token Text
c -> Char
Token Text
c Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
/= Char
' ' Bool -> Bool -> Bool
&& Char
Token Text
c Char -> Char -> Bool
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 = ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (ParsecT Void Text Identity () -> ParsecT Void Text Identity ())
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Void Text Identity Char -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ([Token Text] -> ParsecT Void Text Identity (Token Text)
forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf ([Token Text] -> ParsecT Void Text Identity (Token Text))
-> [Token Text] -> ParsecT Void Text Identity (Token Text)
forall a b. (a -> b) -> a -> b
$ Char
end Char -> ShowS
forall a. a -> [a] -> [a]
: Char
' ' Char -> ShowS
forall a. a -> [a] -> [a]
: String
punc) ParsecT Void Text Identity ()
-> ParsecT Void Text Identity () -> ParsecT Void Text Identity ()
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ParsecT Void Text Identity ()
forall e s (m :: * -> *). MonadParsec e s m => m ()
eof

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

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

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

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

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

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

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

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

manyOf :: Char -> Parser Text
manyOf :: Char -> ParsecT Void Text Identity Text
manyOf Char
c = Maybe String
-> (Token Text -> Bool) -> ParsecT Void Text Identity (Tokens Text)
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ String
"many of " String -> ShowS
forall a. Semigroup a => a -> a -> a
<> [Char
c]) (Char -> Char -> Bool
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> OrgDoc -> Text
prettyOrg OrgDoc
os
  where
    metas :: Text
metas = Text -> [Text] -> Text
T.intercalate Text
"\n"
      ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ ((Text, Text) -> Text) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (\(Text
l, Text
t) -> Text
"#+" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t)
      ([(Text, Text)] -> [Text]) -> [(Text, Text)] -> [Text]
forall a b. (a -> b) -> a -> b
$ Map Text Text -> [(Text, Text)]
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" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ (Block -> Text) -> [Block] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Block -> Text
prettyBlock [Block]
bs [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> (Section -> Text) -> [Section] -> [Text]
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" ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes
  [ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
headig
  , Maybe Text
stamps
  , OrgDateTime -> Text
time (OrgDateTime -> Text) -> Maybe OrgDateTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OrgDateTime
tm
  , Maybe Text
props
  , Text -> Maybe Text
forall a. a -> Maybe a
Just Text
subdoc ]
  where
    pr' :: Priority -> Text
    pr' :: Priority -> Text
pr' (Priority Text
t) = Text
"[#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
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
      ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ Int -> Text -> Text
T.replicate Int
depth Text
"*"
      Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [ String -> Text
T.pack (String -> Text) -> (Todo -> String) -> Todo -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Todo -> String
forall a. Show a => a -> String
show (Todo -> Text) -> Maybe Todo -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Todo
td, Priority -> Text
pr' (Priority -> Text) -> Maybe Priority -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Priority
pr ]
      [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> NonEmpty Text -> [Text]
forall a. NonEmpty a -> [a]
NEL.toList ((Words -> Text) -> NonEmpty Words -> NonEmpty Text
forall a b. (a -> b) -> NonEmpty a -> NonEmpty b
NEL.map Words -> Text
prettyWords NonEmpty Words
ws)
      [Text] -> [Text] -> [Text]
forall a. Semigroup a => a -> a -> a
<> [Text] -> [Text] -> Bool -> [Text]
forall a. a -> a -> Bool -> a
bool [Text
":" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> [Text] -> Text
T.intercalate Text
":" [Text]
ts Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
":"] [] ([Text] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Text]
ts)

    indent :: Text
    indent :: Text
indent = Int -> Text -> Text
T.replicate (Int
depth Int -> Int -> Int
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 [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [(OrgDateTime -> Text) -> Maybe OrgDateTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrgDateTime -> Text
cl' Maybe OrgDateTime
cl, (OrgDateTime -> Text) -> Maybe OrgDateTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrgDateTime -> Text
dl' Maybe OrgDateTime
dl, (OrgDateTime -> Text) -> Maybe OrgDateTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap OrgDateTime -> Text
sc' Maybe OrgDateTime
sc] of
      [] -> Maybe Text
forall a. Maybe a
Nothing
      [Text]
xs -> Text -> Maybe Text
forall a. a -> Maybe a
Just (Text -> Maybe Text) -> Text -> Maybe Text
forall a b. (a -> b) -> a -> b
$ Text
indent Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Text] -> Text
T.unwords [Text]
xs

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

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

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

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

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

    subdoc :: Text
    subdoc :: Text
subdoc = Int -> OrgDoc -> Text
prettyOrg' (Int -> Int
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 ([Text] -> Text) -> [Text] -> Text
forall a b. (a -> b) -> a -> b
$ [Maybe Text] -> [Text]
forall a. [Maybe a] -> [a]
catMaybes [ Text -> Maybe Text
forall a. a -> Maybe a
Just Text
d', Text -> Maybe Text
forall a. a -> Maybe a
Just Text
w', OrgTime -> Text
prettyTime (OrgTime -> Text) -> Maybe OrgTime -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe OrgTime
t, Repeater -> Text
prettyRepeat (Repeater -> Text) -> Maybe Repeater -> Maybe Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Repeater
rep, Delay -> Text
prettyDelay (Delay -> Text) -> Maybe Delay -> Maybe Text
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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ Day -> String
showGregorian Day
d

    w' :: Text
    w' :: Text
w' = String -> Text
T.pack (String -> Text) -> ShowS -> String -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> ShowS
forall a. Int -> [a] -> [a]
take Int
3 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ DayOfWeek -> String
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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (TimeOfDay -> Text) -> Maybe TimeOfDay -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\TimeOfDay
e -> Text
"-" Text -> Text -> 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 (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$ String -> Int -> Int -> String
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' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
v) Text -> Text -> Text
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' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Word -> String
forall a. Show a => a -> String
show Word
v) Text -> Text -> Text
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"

prettyBlock :: Block -> Text
prettyBlock :: Block -> Text
prettyBlock Block
o = case Block
o of
  Code Maybe Language
l Text
t -> Text
"#+begin_src" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (Language -> Text) -> Maybe Language -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\(Language Text
l') -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
l' Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n") Maybe Language
l
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t
    Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_src"
  Quote Text
t -> Text
"#+begin_quote\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_quote"
  Example Text
t -> Text
"#+begin_example\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
t Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"\n#+end_example"
  Paragraph NonEmpty Words
ht -> NonEmpty Words -> Text
par NonEmpty Words
ht
  List ListItems
items -> Int -> ListItems -> Text
lis Int
0 ListItems
items
  Table NonEmpty Row
rows -> Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Row] -> [Text]) -> [Row] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Row -> Text) -> [Row] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Row -> Text
row ([Row] -> Text) -> [Row] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Row -> [Row]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Row
rows
  where
    lis :: Int -> ListItems -> Text
    lis :: Int -> ListItems -> Text
lis Int
indent (ListItems NonEmpty Item
is) = Text -> [Text] -> Text
T.intercalate Text
"\n" ([Text] -> Text) -> ([Item] -> [Text]) -> [Item] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Item -> Text) -> [Item] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map (Int -> Item -> Text
f Int
indent) ([Item] -> Text) -> [Item] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Item -> [Item]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Item
is

    f :: Int -> Item -> Text
    f :: Int -> Item -> Text
f Int
indent (Item NonEmpty Words
ws Maybe ListItems
li) =
      Int -> Text -> Text
T.replicate Int
indent Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"- " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> NonEmpty Words -> Text
par NonEmpty Words
ws
      Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> (ListItems -> Text) -> Maybe ListItems -> Text
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Text
"" (\ListItems
is -> Text
"\n" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Int -> ListItems -> Text
lis (Int
indent Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2) ListItems
is) Maybe ListItems
li

    par :: NonEmpty Words -> Text
    par :: NonEmpty Words -> Text
par (Words
h :| [Words]
t) = Words -> Text
prettyWords Words
h Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
h [Words]
t

    -- | 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 Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
      Words
_ -> case Words
w of
        Punct Char
'(' -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
        Punct Char
_   -> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws
        Words
_         -> Text
" " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> Text
prettyWords Words
w Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Words -> [Words] -> Text
para Words
w [Words]
ws

    row :: Row -> Text
    row :: Row -> Text
row Row
Break    = Text
"|-|"
    row (Row NonEmpty Column
cs) = Text
"| " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> (Text -> [Text] -> Text
T.intercalate Text
" | " ([Text] -> Text) -> ([Column] -> [Text]) -> [Column] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Column -> Text) -> [Column] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Column -> Text
col ([Column] -> Text) -> [Column] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Column -> [Column]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Column
cs) Text -> Text -> Text
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 ([Text] -> Text) -> ([Words] -> [Text]) -> [Words] -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Words -> Text) -> [Words] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Words -> Text
prettyWords ([Words] -> Text) -> [Words] -> Text
forall a b. (a -> b) -> a -> b
$ NonEmpty Words -> [Words]
forall a. NonEmpty a -> [a]
NEL.toList NonEmpty Words
ws

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