module Org.Parser.Document
(
orgDocument
, section
, 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)
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
}
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
""
, 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
':')
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 =
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)
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
'_'])
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
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)
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