-- | Parsers for Org documents.
module Org.Parser.Document
  ( -- Document and sections
    orgDocument
  , section

    -- * Components
  , propertyDrawer
  ) where

import Data.Text qualified as T
import Org.Parser.Common
import Org.Parser.Definitions
import Org.Parser.Elements
import Org.Parser.MarkupContexts
import Org.Parser.Objects
import Prelude hiding (many, some)

-- | Parse an Org document.
orgDocument :: OrgParser OrgDocument
orgDocument :: OrgParser OrgDocument
orgDocument = do
  forall (m :: * -> *) a. MonadPlus m => m a -> m ()
skipMany OrgParser OrgElementData
commentLine
  Properties
properties <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty OrgParser Properties
propertyDrawer
  OrgElements
topLevel <- OrgParser OrgElements
elements
  [OrgSection]
sections <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Int -> OrgParser OrgSection
section Int
1)
  forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    OrgDocument
      { documentProperties :: Properties
documentProperties = Properties
properties
      , documentChildren :: [OrgElement]
documentChildren = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgElements
topLevel
      , documentSections :: [OrgSection]
documentSections = [OrgSection]
sections
      }

{- | Parse an Org section and its contents. @lvl@ gives the minimum acceptable
   level of the heading.
-}
section :: Int -> OrgParser OrgSection
section :: Int -> OrgParser OrgSection
section Int
lvl = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Int
level <- OrgParser Int
headingStart
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Int
lvl forall a. Ord a => a -> a -> Bool
<= Int
level)
  Maybe TodoKeyword
todoKw <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional OrgParser TodoKeyword
todoKeyword
  Bool
isComment <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Bool
False forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"COMMENT" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
  Maybe Priority
priority <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional OrgParser Priority
priorityCookie
  (OrgObjects
title, [Text]
tags, Text
titleTxt) <- OrgParser (OrgObjects, [Text], Text)
titleObjects
  PlanningInfo
planning <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option PlanningInfo
emptyPlanning OrgParser PlanningInfo
planningInfo
  Properties
properties <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty OrgParser Properties
propertyDrawer
  OrgElements
contents <- OrgParser OrgElements
elements
  [OrgSection]
children <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (Int -> OrgParser OrgSection
section (Int
level forall a. Num a => a -> a -> a
+ Int
1))
  forall (m :: * -> *) a. Monad m => a -> m a
return
    OrgSection
      { sectionLevel :: Int
sectionLevel = Int
level
      , sectionProperties :: Properties
sectionProperties = Properties
properties
      , sectionTodo :: Maybe TodoKeyword
sectionTodo = Maybe TodoKeyword
todoKw
      , sectionIsComment :: Bool
sectionIsComment = Bool
isComment
      , sectionPriority :: Maybe Priority
sectionPriority = Maybe Priority
priority
      , sectionTitle :: [OrgObject]
sectionTitle = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
title
      , sectionRawTitle :: Text
sectionRawTitle = Text
titleTxt
      , sectionAnchor :: Text
sectionAnchor = Text
"" -- Dealt with later
      , sectionTags :: [Text]
sectionTags = [Text]
tags
      , sectionPlanning :: PlanningInfo
sectionPlanning = PlanningInfo
planning
      , sectionChildren :: [OrgElement]
sectionChildren = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgElements
contents
      , sectionSubsections :: [OrgSection]
sectionSubsections = [OrgSection]
children
      }
  where
    titleObjects :: OrgParser (OrgObjects, [Tag], Text)
    titleObjects :: OrgParser (OrgObjects, [Text], Text)
titleObjects =
      forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty forall a b. (a -> b) -> a -> b
$
        forall a end skip.
OrgParser skip
-> OrgParser end -> OrgParser a -> OrgParser (a, end, Text)
withContext__
          (forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (\Token Text
c -> Bool -> Bool
not (Char -> Bool
isSpace Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
':')))
          OrgParser [Text]
endOfTitle
          (Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
standardSet)

    endOfTitle :: OrgParser [Tag]
    endOfTitle :: OrgParser [Text]
endOfTitle = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
      [Text]
tags <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option [] (OrgParser [Text]
headerTags forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace)
      forall (m :: * -> *). MonadParser m => m ()
newline'
      forall (m :: * -> *) a. Monad m => a -> m a
return [Text]
tags

    headerTags :: OrgParser [Tag]
    headerTags :: OrgParser [Text]
headerTags = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
      forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
endBy1 OrgParser Text
orgTagWord (forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':')

-- | Parse a to-do keyword that is registered in the state.
todoKeyword :: OrgParser TodoKeyword
todoKeyword :: OrgParser TodoKeyword
todoKeyword = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  TodoSequence
taskStates <- forall a. (OrgOptions -> a) -> OrgParser a
getsO OrgOptions -> TodoSequence
orgTodoKeywords
  forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map TodoKeyword -> OrgParser TodoKeyword
kwParser TodoSequence
taskStates)
  where
    kwParser :: TodoKeyword -> OrgParser TodoKeyword
    kwParser :: TodoKeyword -> OrgParser TodoKeyword
kwParser TodoKeyword
tdm =
      -- NOTE to self: space placement - "TO" is subset of "TODOKEY"
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string (TodoKeyword -> Text
todoName TodoKeyword
tdm) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> TodoKeyword
tdm)

-- | Parse a priority cookie like @[#A]@.
priorityCookie :: OrgParser Priority
priorityCookie :: OrgParser Priority
priorityCookie =
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
    forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[#"
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> OrgParser Priority
priorityFromChar
      forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']'
  where
    priorityFromChar :: OrgParser Priority
    priorityFromChar :: OrgParser Priority
priorityFromChar =
      Int -> Priority
NumericPriority forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadParser m => m Int
digitIntChar
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Char -> Priority
LetterPriority forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadParser m => m Char
upperAscii

orgTagWord :: OrgParser Text
orgTagWord :: OrgParser Text
orgTagWord =
  forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
    (forall a. a -> Maybe a
Just String
"tag characters (alphanumeric, @, %, # or _)")
    (\Token Text
c -> Char -> Bool
isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` [Char
'@', Char
'%', Char
'#', Char
'_'])

-- | TODO READ ABOUT PLANNING
emptyPlanning :: PlanningInfo
emptyPlanning :: PlanningInfo
emptyPlanning = Maybe TimestampData
-> Maybe TimestampData -> Maybe TimestampData -> PlanningInfo
PlanningInfo forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Parse a single planning-related and timestamped line.
planningInfo :: OrgParser PlanningInfo
planningInfo :: OrgParser PlanningInfo
planningInfo = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  [PlanningInfo -> PlanningInfo]
updaters <- forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some OrgParser (PlanningInfo -> PlanningInfo)
planningDatum forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadParser m => m Text
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr forall a b. (a -> b) -> a -> b
($) PlanningInfo
emptyPlanning [PlanningInfo -> PlanningInfo]
updaters
  where
    planningDatum :: OrgParser (PlanningInfo -> PlanningInfo)
planningDatum =
      forall (m :: * -> *). MonadParser m => m Text
skipSpaces
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice
          [ forall {b}. (TimestampData -> b) -> Text -> OrgParser b
updateWith (\TimestampData
s PlanningInfo
p -> PlanningInfo
p {planningScheduled :: Maybe TimestampData
planningScheduled = forall a. a -> Maybe a
Just TimestampData
s}) Text
"SCHEDULED"
          , forall {b}. (TimestampData -> b) -> Text -> OrgParser b
updateWith (\TimestampData
d PlanningInfo
p -> PlanningInfo
p {planningDeadline :: Maybe TimestampData
planningDeadline = forall a. a -> Maybe a
Just TimestampData
d}) Text
"DEADLINE"
          , forall {b}. (TimestampData -> b) -> Text -> OrgParser b
updateWith (\TimestampData
c PlanningInfo
p -> PlanningInfo
p {planningClosed :: Maybe TimestampData
planningClosed = forall a. a -> Maybe a
Just TimestampData
c}) Text
"CLOSED"
          ]
    updateWith :: (TimestampData -> b) -> Tokens Text -> OrgParser b
updateWith TimestampData -> b
fn Tokens Text
cs = TimestampData -> b
fn forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
cs forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (m :: * -> *). MonadParser m => m Text
skipSpaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> OrgParser TimestampData
parseTimestamp)

-- | Parse a :PROPERTIES: drawer and return the key/value pairs contained within.
propertyDrawer :: OrgParser Properties
propertyDrawer :: OrgParser Properties
propertyDrawer = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Text
_ <- forall (m :: * -> *). MonadParser m => m Text
skipSpaces
  Tokens Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
":properties:"
  Text
_ <- forall (m :: * -> *). MonadParser m => m Text
skipSpaces
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
  forall l. IsList l => [Item l] -> l
fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a sep. MonadPlus m => m a -> m sep -> m [a]
manyTill OrgParser (Text, Text)
nodeProperty (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try OrgParser Text
endOfDrawer)
  where
    endOfDrawer :: OrgParser Text
    endOfDrawer :: OrgParser Text
endOfDrawer =
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, FoldCase (Tokens s)) =>
Tokens s -> m (Tokens s)
string' Tokens Text
":end:" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadParser m => m ()
blankline'

    nodeProperty :: OrgParser (Text, Text)
    nodeProperty :: OrgParser (Text, Text)
nodeProperty = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) OrgParser Text
name OrgParser Text
value

    name :: OrgParser Text
    name :: OrgParser Text
name =
      forall (m :: * -> *). MonadParser m => m Text
skipSpaces
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"node property name") (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
        forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text -> Maybe Text
T.stripSuffix Text
":"
        forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= forall (m :: * -> *) a.
(MonadFail m, MonadParser m) =>
String -> Maybe a -> m a
guardMaybe String
"expecting ':' at end of node property name"
        forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.toLower

    value :: OrgParser Text
    value :: OrgParser Text
value =
      forall (m :: * -> *). MonadParser m => m Text
skipSpaces
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ( forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"node property value") (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
              forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> Text -> Text
T.stripEnd
           )
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline