-- | Parsers for Org objects.
module Org.Parser.Objects
  ( -- * Sets of markup
    minimalSet
  , standardSet

    -- * Marked parsers
  , Marked (..)
  , markupContext
  , plainMarkupContext

    -- * General purpose parsers
  , markup
  , rawMarkup

    -- * Objects
  , code
  , verbatim
  , italic
  , underline
  , bold
  , strikethrough
  , singleQuoted
  , doubleQuoted
  , entity
  , latexFragment
  , texMathFragment
  , exportSnippet
  , citation
  , inlBabel
  , inlSrc
  , linebreak
  , angleLink
  , regularLink
  , target
  , suscript
  , macro
  , footnoteReference
  , timestamp
  , statisticCookie

    -- * Auxiliary
  , linkToTarget
  , parseTimestamp
  )
where

import Data.Set qualified as Set
import Data.Text qualified as T
import Org.Builder qualified as B
import Org.Data.Entities (defaultEntitiesNames)
import Org.Parser.Common
import Org.Parser.Definitions
import Org.Parser.MarkupContexts
import Prelude hiding (many, some)

-- * Sets of objects

minimalSet :: Marked OrgParser OrgObjects
minimalSet :: Marked OrgParser OrgObjects
minimalSet =
  forall a. Monoid a => [a] -> a
mconcat
    [ Marked OrgParser OrgObjects
endline
    , Marked OrgParser OrgObjects
code
    , Marked OrgParser OrgObjects
verbatim
    , Marked OrgParser OrgObjects
italic
    , Marked OrgParser OrgObjects
underline
    , Marked OrgParser OrgObjects
bold
    , Marked OrgParser OrgObjects
strikethrough
    , Marked OrgParser OrgObjects
entity
    , Marked OrgParser OrgObjects
latexFragment
    , Marked OrgParser OrgObjects
texMathFragment
    , Marked OrgParser OrgObjects
singleQuoted
    , Marked OrgParser OrgObjects
doubleQuoted
    , Marked OrgParser OrgObjects
suscript
    , Marked OrgParser OrgObjects
statisticCookie
    , Marked OrgParser OrgObjects
macro
    ]

standardSet :: Marked OrgParser OrgObjects
standardSet :: Marked OrgParser OrgObjects
standardSet =
  forall a. Monoid a => [a] -> a
mconcat
    [ Marked OrgParser OrgObjects
minimalSet
    , Marked OrgParser OrgObjects
regularLink
    , Marked OrgParser OrgObjects
footnoteReference
    , Marked OrgParser OrgObjects
timestamp
    , Marked OrgParser OrgObjects
exportSnippet
    , Marked OrgParser OrgObjects
inlBabel
    , Marked OrgParser OrgObjects
inlSrc
    , Marked OrgParser OrgObjects
linebreak
    , Marked OrgParser OrgObjects
target
    , Marked OrgParser OrgObjects
angleLink
    , Marked OrgParser OrgObjects
citation
    ]

{- | Parse inside a "plain context", i.e., plain text not matched by any parsers
   gets converted to 'Plain' objects.

@
'plainMarkupContext' = 'markupContext' 'B.plain'
@
-}
plainMarkupContext :: Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext :: Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext = forall k.
Monoid k =>
(Text -> k) -> Marked OrgParser k -> OrgParser k
markupContext Text -> OrgObjects
B.plain

newlineAndClear :: OrgParser Char
newlineAndClear :: OrgParser Char
newlineAndClear = forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* OrgParser ()
clearLastChar

emphasisPreChars :: Set Char
emphasisPreChars :: Set Char
emphasisPreChars = forall l. IsList l => [Item l] -> l
fromList String
"-('\"{"

emphPreChar :: Char -> Bool
emphPreChar :: Char -> Bool
emphPreChar Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
emphasisPreChars

emphasisPre :: Char -> OrgParser ()
emphasisPre :: Char -> OrgParser ()
emphasisPre Char
s = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Maybe Char
lchar <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets OrgParserState -> Maybe Char
orgStateLastChar
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Char
lchar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
emphPreChar
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
s
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
spaceChar

emphasisPostChars :: Set Char
emphasisPostChars :: Set Char
emphasisPostChars = forall l. IsList l => [Item l] -> l
fromList String
"-.,;:!?'\")}\\["

emphPostChar :: Char -> Bool
emphPostChar :: Char -> Bool
emphPostChar Char
c = Char -> Bool
isSpace Char
c Bool -> Bool -> Bool
|| Char
c forall a. Ord a => a -> Set a -> Bool
`Set.member` Set Char
emphasisPostChars

emphasisPost :: Char -> OrgParser ()
emphasisPost :: Char -> OrgParser ()
emphasisPost Char
e = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Maybe Char
lchar <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets OrgParserState -> Maybe Char
orgStateLastChar
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Char
lchar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
e
  Char -> OrgParser ()
putLastChar Char
e
  forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
emphPostChar))

emphasisSkip :: Char -> OrgParser ()
emphasisSkip :: Char -> OrgParser ()
emphasisSkip Char
s = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Char -> OrgParser ()
putLastChar forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
  Text
t <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
s)
  Maybe Char -> OrgParser ()
setLastChar (forall a b. (a, b) -> b
snd forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Maybe (Text, Char)
T.unsnoc Text
t)

markup ::
  (OrgObjects -> OrgObjects) ->
  Char ->
  Marked OrgParser OrgObjects
markup :: (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
f Char
c = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked [Char
c] 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
$ do
    Char -> OrgParser ()
emphasisPre Char
c
    FullState
st <- OrgParser FullState
getFullState
    Char
s <- forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
    (Text
t, ()
_) <- forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' (Char -> OrgParser ()
emphasisSkip Char
c) (Char -> OrgParser ()
emphasisPost Char
c)
    OrgObjects -> OrgObjects
f forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. FullState -> Text -> OrgParser b -> OrgParser b
parseFromText FullState
st (Char -> Text -> Text
T.cons Char
s Text
t) (Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
standardSet)

rawMarkup ::
  (Text -> OrgObjects) ->
  Char ->
  Marked OrgParser OrgObjects
rawMarkup :: (Text -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
rawMarkup Text -> OrgObjects
f Char
d = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked [Char
d] 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
$ do
    Char -> OrgParser ()
emphasisPre Char
d
    Text -> OrgObjects
f forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' (Char -> OrgParser ()
emphasisSkip Char
d) (Char -> OrgParser ()
emphasisPost Char
d)

-- | Parse a code object.
code :: Marked OrgParser OrgObjects
code :: Marked OrgParser OrgObjects
code = (Text -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
rawMarkup Text -> OrgObjects
B.code Char
'~'

-- | Parse a verbatim object.
verbatim :: Marked OrgParser OrgObjects
verbatim :: Marked OrgParser OrgObjects
verbatim = (Text -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
rawMarkup Text -> OrgObjects
B.verbatim Char
'='

-- | Parse an italic object.
italic :: Marked OrgParser OrgObjects
italic :: Marked OrgParser OrgObjects
italic = (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
B.italic Char
'/'

-- | Parse an underline object.
underline :: Marked OrgParser OrgObjects
underline :: Marked OrgParser OrgObjects
underline = (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
B.underline Char
'_'

-- | Parse a bold object.
bold :: Marked OrgParser OrgObjects
bold :: Marked OrgParser OrgObjects
bold = (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
B.bold Char
'*'

-- | Parse a strikethrough object.
strikethrough :: Marked OrgParser OrgObjects
strikethrough :: Marked OrgParser OrgObjects
strikethrough = (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
B.strikethrough Char
'+'

-- | Parse a single-quoted object.
singleQuoted :: Marked OrgParser OrgObjects
singleQuoted :: Marked OrgParser OrgObjects
singleQuoted = (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
B.singleQuoted Char
'\''

-- | Parse a double-quoted object.
doubleQuoted :: Marked OrgParser OrgObjects
doubleQuoted :: Marked OrgParser OrgObjects
doubleQuoted = (OrgObjects -> OrgObjects) -> Char -> Marked OrgParser OrgObjects
markup OrgObjects -> OrgObjects
B.doubleQuoted Char
'"'

-- | An endline character that can be treated as a space, not a line break.
endline :: Marked OrgParser OrgObjects
endline :: Marked OrgParser OrgObjects
endline =
  forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"\n" 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
$
      OrgParser Char
newlineAndClear
        forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
        forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text -> OrgObjects
B.plain Text
"\n"

-- * Entities and LaTeX fragments

-- | Parse an entity object.
entity :: Marked OrgParser OrgObjects
entity :: Marked OrgParser OrgObjects
entity = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"\\" 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
$ do
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\'
  Text
name <- forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text]
defaultEntitiesNames)
  forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{}") forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy forall (m :: * -> *). MonadParser m => m Char
asciiAlpha
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> OrgObjects
B.entity Text
name

-- | Parse a LaTeX fragment object.
latexFragment :: Marked OrgParser OrgObjects
latexFragment :: Marked OrgParser OrgObjects
latexFragment = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"\\" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\'
  OrgParser OrgObjects
mathFragment forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). MonadParser m => m OrgObjects
rawFragment
  where
    mathFragment :: OrgParser OrgObjects
mathFragment = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
      Bool
inline <-
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'(' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
True
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'[' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Bool
False
      (Text
str, Token Text
_) <-
        forall end.
(Char -> Bool) -> OrgParser end -> OrgParser (Text, end)
findSkipping
          (forall a. Eq a => a -> a -> Bool
/= Char
'\\')
          (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) =>
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, Token s ~ Char) =>
Token s -> m (Token s)
char if Bool
inline then Char
')' else Char
']')
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
        if Bool
inline
          then Text -> OrgObjects
B.inlMath Text
str
          else Text -> OrgObjects
B.dispMath Text
str

    rawFragment :: MonadParser m => m OrgObjects
    rawFragment :: forall (m :: * -> *). MonadParser m => m OrgObjects
rawFragment = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Text
name <- forall (m :: * -> *). MonadParser m => m Text
someAsciiAlpha
      Text
text <- (Text
name forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" forall (m :: * -> *). MonadParser m => m Text
brackets
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> OrgObjects
B.fragment (Text
"\\" forall a. Semigroup a => a -> a -> a
<> Text
text)

    brackets :: MonadParser m => m Text
    brackets :: forall (m :: * -> *). MonadParser m => m Text
brackets = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Char
open <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'{' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'[')
      let close :: Char
close = if Char
open forall a. Eq a => a -> a -> Bool
== Char
'{' then Char
'}' else Char
']'
      Text
str <- 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 -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
close Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
close
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char
open Char -> Text -> Text
`T.cons` Text
str Text -> Char -> Text
`T.snoc` Char
close

-- | Parse a TeX math fragment object.
texMathFragment :: Marked OrgParser OrgObjects
texMathFragment :: Marked OrgParser OrgObjects
texMathFragment = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"$" 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
$ OrgParser OrgObjects
display forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OrgParser OrgObjects
inline
  where
    display :: OrgParser OrgObjects
display = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"$$"
      (Text
str, Tokens Text
_) <-
        forall end.
(Char -> Bool) -> OrgParser end -> OrgParser (Text, end)
findSkipping
          (forall a. Eq a => a -> a -> Bool
/= Char
'$')
          (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"$$")
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> OrgObjects
B.dispMath Text
str

    post :: OrgParser ()
post = do
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'$'
      forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ( forall (f :: * -> *) a. Functor f => f a -> f ()
void forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$
                forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
x -> Char -> Bool
isPunctuation Token Text
x Bool -> Bool -> Bool
|| Char -> Bool
isSpace Token Text
x Bool -> Bool -> Bool
|| Token Text
x forall a. Eq a => a -> a -> Bool
== Char
'"')
            )

    inline :: OrgParser OrgObjects
inline = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Maybe Char
lchar <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets OrgParserState -> Maybe Char
orgStateLastChar
      forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Char
lchar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
/= Char
'$')
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'$'
      Text
str <- OrgParser Text
singleChar forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OrgParser Text
moreChars
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> OrgObjects
B.inlMath Text
str

    moreChars :: OrgParser Text
moreChars = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Text
str <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"inside of inline math") (forall a. Eq a => a -> a -> Bool
/= Char
'$')
      forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall a b. (a -> b) -> a -> b
$ Char -> Bool
border1 (Text -> Char
T.head Text
str) Bool -> Bool -> Bool
&& Char -> Bool
border2 (Text -> Char
T.last Text
str)
      OrgParser ()
post
      forall (f :: * -> *) a. Applicative f => a -> f a
pure Text
str

    singleChar :: OrgParser Text
singleChar = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
      Token Text
c <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
x -> Bool -> Bool
not (Char -> Bool
isSpace Token Text
x) Bool -> Bool -> Bool
&& Token Text
x forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` String
disallowedCharsSet)
      OrgParser ()
post
      forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall x. One x => OneItem x -> x
one Token Text
c

    disallowedCharsSet :: [Char]
    disallowedCharsSet :: String
disallowedCharsSet = [Char
'.', Char
',', Char
'?', Char
';', Char
'"']

    border1 :: Char -> Bool
border1 Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` (String
".,;$" :: String)
    border2 :: Char -> Bool
border2 Char
c = Bool -> Bool
not (Char -> Bool
isSpace Char
c) Bool -> Bool -> Bool
&& Char
c forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` (String
".,$" :: String)

-- * Export snippets

-- | Parse an export snippet object.
exportSnippet :: Marked OrgParser OrgObjects
exportSnippet :: Marked OrgParser OrgObjects
exportSnippet = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"@" 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
$ do
    Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"@@"
    Text
backend <-
      forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
        (forall a. a -> Maybe a
Just String
"export snippet backend")
        (\Token Text
c -> Char -> Bool
isAsciiAlpha Token Text
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-')
    Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
    Text -> Text -> OrgObjects
B.exportSnippet Text
backend forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall end.
(Char -> Bool) -> OrgParser end -> OrgParser (Text, end)
findSkipping (forall a. Eq a => a -> a -> Bool
/= Char
'@') (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"@@")

-- * Citations

-- The following code for org-cite citations was adapted and improved upon pandoc's.

-- | Parse a citation object.
citation :: Marked OrgParser OrgObjects
citation :: Marked OrgParser OrgObjects
citation =
  forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"[" forall a b. (a -> b) -> a -> b
$
    Citation -> OrgObjects
B.citation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'[' Char
']' (forall a b. a -> b -> a
const Bool
True) OrgParser Citation
orgCite

-- | A citation in org-cite style
orgCite :: OrgParser Citation
orgCite :: OrgParser Citation
orgCite = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"cite"
  (Text
style, Text
variant) <- OrgParser (Tokens Text, Tokens Text)
citeStyle
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  OrgObjects
globalPrefix <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (OrgParser OrgObjects
citeSuffix 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
';'))
  [CiteReference]
items <- OrgParser [CiteReference]
citeItems
  OrgObjects
globalSuffix <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (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
*> OrgParser OrgObjects
citePrefix))
  forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
space
  forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
  forall (m :: * -> *) a. Monad m => a -> m a
return
    Citation
      { citationStyle :: Text
citationStyle = Text
style
      , citationVariant :: Text
citationVariant = Text
variant
      , citationPrefix :: [OrgObject]
citationPrefix = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
globalPrefix
      , citationSuffix :: [OrgObject]
citationSuffix = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
globalSuffix
      , citationReferences :: [CiteReference]
citationReferences = [CiteReference]
items
      }

citeStyle :: OrgParser (Tokens Text, Tokens Text)
citeStyle :: OrgParser (Tokens Text, Tokens Text)
citeStyle = do
  Text
sty <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try OrgParser (Tokens Text)
style
  Text
vars <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try OrgParser (Tokens Text)
variants
  forall (m :: * -> *) a. Monad m => a -> m a
return (Text
sty, Text
vars)
  where
    style :: OrgParser (Tokens Text)
style =
      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)
takeWhileP
          (forall a. a -> Maybe a
Just String
"alphaNum, '_' or '-' characters")
          (\Token Text
c -> Char -> Bool
isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-')
    variants :: OrgParser (Tokens Text)
variants =
      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)
takeWhileP
          (forall a. a -> Maybe a
Just String
"alphaNum, '_', '-' or '/' characters")
          (\Token Text
c -> Char -> Bool
isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'/')

citeItems :: OrgParser [CiteReference]
citeItems :: OrgParser [CiteReference]
citeItems = OrgParser CiteReference
citeItem forall {f :: * -> *} {e} {s} {a} {a}.
MonadParsec e s f =>
f a -> f a -> f [a]
`sepBy1'` forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
';'
  where
    sepBy1' :: f a -> f a -> f [a]
sepBy1' f a
p f a
sep = (:) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
p forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
many (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ f a
sep forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> f a
p)

citeItem :: OrgParser CiteReference
citeItem :: OrgParser CiteReference
citeItem = do
  OrgObjects
pref <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty OrgParser OrgObjects
citePrefix
  Text
itemKey <- OrgParser Text
orgCiteKey
  OrgObjects
suff <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty OrgParser OrgObjects
citeSuffix
  forall (m :: * -> *) a. Monad m => a -> m a
return
    CiteReference
      { refId :: Text
refId = Text
itemKey
      , refPrefix :: [OrgObject]
refPrefix = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
pref
      , refSuffix :: [OrgObject]
refSuffix = forall (t :: * -> *) a. Foldable t => t a -> [a]
toList OrgObjects
suff
      }

citePrefix :: OrgParser OrgObjects
citePrefix :: OrgParser OrgObjects
citePrefix = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  OrgParser ()
clearLastChar
  forall a end skip.
OrgParser skip -> OrgParser end -> OrgParser a -> OrgParser a
withContext
    (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
'@'))
    (forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@'))
    (Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
minimalSet)

citeSuffix :: OrgParser OrgObjects
citeSuffix :: OrgParser OrgObjects
citeSuffix = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  OrgParser ()
clearLastChar
  forall a end skip.
OrgParser skip -> OrgParser end -> OrgParser a -> OrgParser a
withContext
    (forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
';'))
    (forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
';'))
    (Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
minimalSet)

orgCiteKey :: OrgParser Text
orgCiteKey :: OrgParser Text
orgCiteKey = do
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'@'
  forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"citation key allowed chars") Char -> Bool
orgCiteKeyChar

orgCiteKeyChar :: Char -> Bool
orgCiteKeyChar :: Char -> Bool
orgCiteKeyChar Char
c =
  Char -> Bool
isAlphaNum Char
c Bool -> Bool -> Bool
|| Char
c forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`elem` (String
".:?!`\'/*@+|(){}<>&_^$#%~-" :: String)

-- * Inline Babel calls

-- | Parse an inline babel call object.
inlBabel :: Marked OrgParser OrgObjects
inlBabel :: Marked OrgParser OrgObjects
inlBabel = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"c" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"call_"
  Text
name <-
    forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
      (forall a. a -> Maybe a
Just String
"babel call name")
      (\Token Text
c -> Bool -> Bool
not (Char -> Bool
isSpace Token Text
c) Bool -> Bool -> Bool
&& Token Text
c forall (f :: * -> *) a.
(Foldable f, DisallowElem f, Eq a) =>
a -> f a -> Bool
`notElem` [Char
'[', Char
']', Char
'(', Char
')'])
  Text
header1 <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" OrgParser Text
header
  Text
args <- OrgParser Text
arguments
  Text
header2 <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" OrgParser Text
header
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> Text -> Text -> OrgObjects
B.inlBabel Text
name Text
header1 Text
header2 Text
args
  where
    header :: OrgParser Text
header = forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'[' Char
']' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
    arguments :: OrgParser Text
arguments = forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'(' Char
')' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall e s (m :: * -> *). MonadParsec e s m => m s
getInput

-- * Inline source blocks

-- | Parse an inline source object.
inlSrc :: Marked OrgParser OrgObjects
inlSrc :: Marked OrgParser OrgObjects
inlSrc = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"s" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"src_"
  Text
name <-
    forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
      (forall a. a -> Maybe a
Just String
"babel call name")
      (\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
'{' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'[')
  Text
headers <- forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Text
"" OrgParser Text
header
  Text -> Text -> Text -> OrgObjects
B.inlSrc Text
name Text
headers forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrgParser Text
body
  where
    header :: OrgParser Text
header = forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'[' Char
']' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
    body :: OrgParser Text
body = forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'{' Char
'}' (forall a. Eq a => a -> a -> Bool
/= Char
'\n') forall e s (m :: * -> *). MonadParsec e s m => m s
getInput

-- * Line breaks

-- | Parse a linebreak object.
linebreak :: Marked OrgParser OrgObjects
linebreak :: Marked OrgParser OrgObjects
linebreak =
  forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"\\" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
    OrgObjects
B.linebreak forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"\\\\" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadParser m => m ()
blankline' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* OrgParser ()
clearLastChar

-- * Links

-- | Parse a angle link object.
angleLink :: Marked OrgParser OrgObjects
angleLink :: Marked OrgParser OrgObjects
angleLink = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"<" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'<'
  Text
protocol <- OrgParser Text
manyAsciiAlpha
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
  Text
tgt <- forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \OrgParser Text
search -> do
    Text
partial <-
      forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
        (forall a. a -> Maybe a
Just String
"angle link target")
        (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'>')
    forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'>' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
partial
      forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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
*> ((Text -> Text
T.stripEnd Text
partial forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrgParser Text
search)
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> OrgObjects -> OrgObjects
B.uriLink Text
protocol Text
tgt (Text -> OrgObjects
B.plain forall a b. (a -> b) -> a -> b
$ Text
protocol forall a. Semigroup a => a -> a -> a
<> Text
":" forall a. Semigroup a => a -> a -> a
<> Text
tgt)

-- | Parse a regular link object.
regularLink :: Marked OrgParser OrgObjects
regularLink :: Marked OrgParser OrgObjects
regularLink =
  forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"[" forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
    do
      Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"[["
      Text
str <- forall (m :: * -> *). MonadParser m => m Text
linkTarget
      OrgObjects
descr <- OrgParser OrgObjects
linkDescr forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']' forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty
      Char -> OrgParser ()
putLastChar Char
']'
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ LinkTarget -> OrgObjects -> OrgObjects
B.link (Text -> LinkTarget
linkToTarget Text
str) OrgObjects
descr
  where
    linkTarget :: MonadParser m => m Text
    linkTarget :: forall (m :: * -> *). MonadParser m => m Text
linkTarget = forall a. (a -> a) -> a
fix forall a b. (a -> b) -> a -> b
$ \m Text
rest -> do
      Text
partial <-
        forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP
          (forall a. a -> Maybe a
Just String
"link target")
          (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
']' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'[' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\\' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
      forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'[', Char
']'] forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
partial
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'\\' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 Char -> Text -> Text
T.cons (forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option Char
'\\' forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'[', Char
']']) m Text
rest
        forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a b. Applicative f => f a -> f b -> f 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
*> ((Text -> Text
T.stripEnd Text
partial Text -> Char -> Text
`T.snoc` Char
' ' forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
rest)

    linkDescr :: OrgParser OrgObjects
    linkDescr :: OrgParser OrgObjects
linkDescr = 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
'['
      -- FIXME this is not the right set but... whatever
      forall a end skip.
OrgParser skip -> OrgParser end -> OrgParser a -> OrgParser a
withContext OrgParser (Tokens Text)
skip (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"]]") (Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
standardSet)
      where
        skip :: OrgParser (Tokens Text)
skip = forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle forall (m :: * -> *) a b. Monad m => m a -> m b -> m b
>> forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a. Eq a => a -> a -> Bool
/= Char
']')

-- TODO this will probably be replaced by the AST annotations.

-- | Transform the link text into a link target.
linkToTarget :: Text -> LinkTarget
linkToTarget :: Text -> LinkTarget
linkToTarget Text
link
  | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (Text -> Text -> Bool
`T.isPrefixOf` Text
link) [Text
"/", Text
"./", Text
"../"] =
      let link' :: Text
link' = forall a. ToText a => a -> Text
toText (forall a. ToString a => a -> String
toString Text
link)
       in Text -> Text -> LinkTarget
URILink Text
"file" Text
link'
  | (Text
prot, Text
rest) <- (Char -> Bool) -> Text -> (Text, Text)
T.break (forall a. Eq a => a -> a -> Bool
== Char
':') Text
link
  , Just (Char
_, Text
uri) <- Text -> Maybe (Char, Text)
T.uncons Text
rest =
      Text -> Text -> LinkTarget
URILink Text
prot Text
uri
  | Bool
otherwise = Text -> LinkTarget
UnresolvedLink Text
link

-- * Targets and radio targets

-- | Parse a target object.
target :: Marked OrgParser OrgObjects
target :: Marked OrgParser OrgObjects
target = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"<" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
  Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"<<"
  Text
str <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"dedicated target") (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'<' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'>' Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
'\n')
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Text -> Char
T.head Text
str))
  forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not (Char -> Bool
isSpace forall a b. (a -> b) -> a -> b
$ Text -> Char
T.last Text
str))
  Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
">>"
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> Text -> OrgObjects
B.target Text
"" Text
str

-- * Subscripts and superscripts

-- | Parse a subscript or a superscript object.
suscript :: Marked OrgParser OrgObjects
suscript :: Marked OrgParser OrgObjects
suscript = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"_^" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
  Maybe Char
lchar <- forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets OrgParserState -> Maybe Char
orgStateLastChar
  forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ Maybe Char
lchar forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace
  Char
start <- forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy \Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'^'
  OrgObjects
contents <- OrgParser OrgObjects
asterisk forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OrgParser OrgObjects
balanced forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OrgParser OrgObjects
plain
  forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$
    if Char
start forall a. Eq a => a -> a -> Bool
== Char
'_'
      then OrgObjects -> OrgObjects
B.subscript OrgObjects
contents
      else OrgObjects -> OrgObjects
B.superscript OrgObjects
contents
  where
    asterisk :: OrgParser OrgObjects
asterisk = Text -> OrgObjects
B.plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. One x => OneItem x -> x
one forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'*'

    balanced :: OrgParser OrgObjects
balanced =
      forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'{' Char
'}' (forall a b. a -> b -> a
const Bool
True) forall a b. (a -> b) -> a -> b
$
        Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
minimalSet

    sign :: OrgParser OrgObjects
sign = forall (m :: * -> *) a. Alternative m => a -> m a -> m a
option forall a. Monoid a => a
mempty (Text -> OrgObjects
B.plain forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall x. One x => OneItem x -> x
one forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'+', Char
'-'])

    plain :: OrgParser OrgObjects
plain =
      forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 forall a. Semigroup a => a -> a -> a
(<>) OrgParser OrgObjects
sign forall a b. (a -> b) -> a -> b
$
        forall a b.
(Char -> Bool)
-> (Char -> Bool) -> OrgParser b -> OrgParser a -> OrgParser a
withMContext (forall a b. a -> b -> a
const Bool
True) Char -> Bool
isAlphaNum OrgParser ()
plainEnd forall a b. (a -> b) -> a -> b
$
          Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext (Marked OrgParser OrgObjects
entity forall a. Semigroup a => a -> a -> a
<> Marked OrgParser OrgObjects
latexFragment)

    plainEnd :: OrgParser ()
    plainEnd :: OrgParser ()
plainEnd = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
      forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$
        forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try (forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
',', Char
'.', Char
'\\']) forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m ()
notFollowedBy (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isAlphaNum))
          forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
noneOf [Char
',', Char
'.', Char
'\\'])

-- * Macros

-- | Parse a macro object.
macro :: Marked OrgParser OrgObjects
macro :: Marked OrgParser OrgObjects
macro = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"{" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
  Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"{{{"
  Token Text
_ <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isAsciiAlpha
  Text
key <- forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P forall a. Maybe a
Nothing Char -> Bool
allowedKeyChar
  [Text]
args <-
    (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"}}}" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> []) forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> do
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'('
      Text
t <- forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall end.
(Char -> Bool) -> OrgParser end -> OrgParser (Text, end)
findSkipping (forall a. Eq a => a -> a -> Bool
/= Char
')') (forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
")}}}")
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ (Char -> Bool) -> Text -> [Text]
T.split (forall a. Eq a => a -> a -> Bool
== Char
',') Text
t
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> [Text] -> OrgObjects
B.macro Text
key [Text]
args
  where
    allowedKeyChar :: Char -> Bool
allowedKeyChar Char
c = Char -> Bool
isAsciiAlpha Char
c Bool -> Bool -> Bool
|| Char -> Bool
isDigit Char
c Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'_'

-- * Footnote references

-- | Parse a footnote reference object.
footnoteReference :: Marked OrgParser OrgObjects
footnoteReference :: Marked OrgParser OrgObjects
footnoteReference = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"[" forall a b. (a -> b) -> a -> b
$
  forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
'[' Char
']' (forall a b. a -> b -> a
const Bool
True) do
    Tokens Text
_ <- forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"fn:"
    Maybe Text
lbl <-
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> 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
"footnote ref label")
          (\Token Text
c -> Char -> Bool
isAlphaNum Token Text
c Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'-' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'_')
    Maybe OrgObjects
def <-
      forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
        Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
':'
        Marked OrgParser OrgObjects -> OrgParser OrgObjects
plainMarkupContext Marked OrgParser OrgObjects
standardSet
    case (Maybe Text
lbl, Maybe OrgObjects
def) of
      (Maybe Text
Nothing, Maybe OrgObjects
Nothing) -> forall (f :: * -> *) a. Alternative f => f a
empty
      (Just Text
lbl', Maybe OrgObjects
Nothing) ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Text -> OrgObjects
B.footnoteLabel Text
lbl'
      (Maybe Text
_, Just OrgObjects
def') ->
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Maybe Text -> OrgObjects -> OrgObjects
B.footnoteInlDef Maybe Text
lbl OrgObjects
def'

-- * Timestamps

-- | Parse a timestamp object.
timestamp :: Marked OrgParser OrgObjects
timestamp :: Marked OrgParser OrgObjects
timestamp = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"<[" forall a b. (a -> b) -> a -> b
$ TimestampData -> OrgObjects
B.timestamp forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrgParser TimestampData
parseTimestamp

-- | Parse a timestamp.
parseTimestamp :: OrgParser TimestampData
parseTimestamp :: OrgParser TimestampData
parseTimestamp = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
  Char
openChar <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy (\Token Text
c -> Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'<' Bool -> Bool -> Bool
|| Token Text
c forall a. Eq a => a -> a -> Bool
== Char
'[')
  let isActive :: Bool
isActive = Char
openChar forall a. Eq a => a -> a -> Bool
== Char
'<'
      closeChar :: Char
closeChar = if Bool
isActive then Char
'>' else Char
']'
      delims :: (Char, Char)
delims = (Char
openChar, Char
closeChar)
  (Date
d1, Maybe (Time, Maybe Time)
t1, Maybe TimestampMark
r1, Maybe TimestampMark
w1) <- (Char, Char)
-> OrgParser
     (Date, Maybe (Time, Maybe Time), Maybe TimestampMark,
      Maybe TimestampMark)
component (Char, Char)
delims
  forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string Tokens Text
"--" forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Char, Char)
-> OrgParser
     (Date, Maybe (Time, Maybe Time), Maybe TimestampMark,
      Maybe TimestampMark)
component (Char, Char)
delims)
    forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
      Just (Date
d2, Maybe (Time, Maybe Time)
t2, Maybe TimestampMark
r2, Maybe TimestampMark
w2) ->
        forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> DateTime -> DateTime -> TimestampData
TimestampRange Bool
isActive (Date
d1, forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Time, Maybe Time)
t1, Maybe TimestampMark
r1, Maybe TimestampMark
w1) (Date
d2, forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Time, Maybe Time)
t2, Maybe TimestampMark
r2, Maybe TimestampMark
w2)
      Maybe
  (Date, Maybe (Time, Maybe Time), Maybe TimestampMark,
   Maybe TimestampMark)
Nothing -> case Maybe (Time, Maybe Time)
t1 of
        Just (Time
t1', Just Time
t1'') ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> DateTime -> DateTime -> TimestampData
TimestampRange Bool
isActive (Date
d1, forall a. a -> Maybe a
Just Time
t1', Maybe TimestampMark
r1, Maybe TimestampMark
w1) (Date
d1, forall a. a -> Maybe a
Just Time
t1'', Maybe TimestampMark
r1, Maybe TimestampMark
w1)
        Maybe (Time, Maybe Time)
_ ->
          forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Bool -> DateTime -> TimestampData
TimestampData Bool
isActive (Date
d1, forall a b. (a, b) -> a
fst forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe (Time, Maybe Time)
t1, Maybe TimestampMark
r1, Maybe TimestampMark
w1)
  where
    component :: (Token Text, Token Text)
-> OrgParser
     (Date, Maybe (Time, Maybe Time), Maybe TimestampMark,
      Maybe TimestampMark)
component (Token Text, Token Text)
delims = do
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (forall a b. (a, b) -> a
fst (Token Text, Token Text)
delims)
      Date
date <- OrgParser Date
parseDate
      Maybe (Time, Maybe Time)
time <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
        Time
startTime <- OrgParser Time
parseTime
        Maybe Time
endTime <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'-' forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> OrgParser Time
parseTime
        forall (f :: * -> *) a. Applicative f => a -> f a
pure (Time
startTime, Maybe Time
endTime)
      Maybe TimestampMark
repeater <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> OrgParser TimestampMark
repeaterMark)
      Maybe TimestampMark
warning <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1 forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> OrgParser TimestampMark
warningMark)
      forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace
      Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char (forall a b. (a, b) -> b
snd (Token Text, Token Text)
delims)
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Date
date, Maybe (Time, Maybe Time)
time, Maybe TimestampMark
repeater, Maybe TimestampMark
warning)

    parseDate :: OrgParser Date
    parseDate :: OrgParser Date
parseDate = do
      Int
year <- Int -> OrgParser Int
number Int
4 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
'-'
      Int
month <- Int -> OrgParser Int
number Int
2 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
'-'
      Int
day <- Int -> OrgParser Int
number Int
2
      Maybe Text
dayName <- forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
        forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m ()
hspace1
        forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"dayname characters") Char -> Bool
isLetter
      forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
year, Int
month, Int
day, Maybe Text
dayName)

    repeaterMark :: OrgParser TimestampMark
repeaterMark = [Text] -> OrgParser TimestampMark
tsmark [Text
"++", Text
".+", Text
"+"]

    warningMark :: OrgParser TimestampMark
warningMark = [Text] -> OrgParser TimestampMark
tsmark [Text
"--", Text
"-"]

    tsmark :: [Text] -> OrgParser TimestampMark
    tsmark :: [Text] -> OrgParser TimestampMark
tsmark [Text]
marks = do
      Int -> Char -> TimestampMark
mtype <- (,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (f :: * -> *) (m :: * -> *) a.
(Foldable f, Alternative m) =>
f (m a) -> m a
choice (forall a b. (a -> b) -> [a] -> [b]
map forall e s (m :: * -> *).
MonadParsec e s m =>
Tokens s -> m (Tokens s)
string [Text]
marks)
      Int -> Char -> TimestampMark
mtype forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadParser m => m Int
integer forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall (f :: * -> *) e s (m :: * -> *).
(Foldable f, MonadParsec e s m) =>
f (Token s) -> m (Token s)
oneOf [Char
'h', Char
'd', Char
'w', Char
'm', Char
'y']

-- * Statistic Cookies

-- | Parse a statistic cookie object.
statisticCookie :: Marked OrgParser OrgObjects
statisticCookie :: Marked OrgParser OrgObjects
statisticCookie = forall (m :: * -> *) a. String -> m a -> Marked m a
Marked String
"[" forall a b. (a -> b) -> a -> b
$ forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
'['
  Either Time Int
res <- forall a b. a -> Either a b
Left forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrgParser Time
fra forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall a b. b -> Either a b
Right forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> OrgParser Int
pct
  Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
']'
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Either Time Int -> OrgObjects
B.statisticCookie Either Time Int
res
  where
    fra :: OrgParser Time
fra = 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 (,) forall (m :: * -> *). MonadParser m => m Int
integer (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 Int
integer)
    pct :: OrgParser Int
pct = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *). MonadParser m => m Int
integer 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
'%'