module Org.Parser.MarkupContexts where
import Data.Set (notMember)
import Data.Text qualified as T
import Org.Parser.Common
import Org.Parser.Definitions
skipManyTill' ::
forall skip end m.
MonadParser m =>
m skip ->
m end ->
m (Text, end)
skipManyTill' :: forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' m skip
skip m end
end = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
Int
o0 <- forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset
Text
s0 <- forall e s (m :: * -> *). MonadParsec e s m => m s
getInput
(Int
o1, end
final) <- forall (m :: * -> *) a end. MonadPlus m => m a -> m end -> m end
skipManyTill m skip
skip (forall (f :: * -> *) a b c.
Applicative f =>
(a -> b -> c) -> f a -> f b -> f c
liftA2 (,) forall e s (m :: * -> *). MonadParsec e s m => m Int
getOffset m end
end)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int -> Text -> Text
T.take (Int
o1 forall a. Num a => a -> a -> a
- Int
o0) Text
s0, end
final)
{-# INLINEABLE skipManyTill' #-}
findSkipping ::
forall end.
(Char -> Bool) ->
OrgParser end ->
OrgParser (Text, end)
findSkipping :: forall end.
(Char -> Bool) -> OrgParser end -> OrgParser (Text, end)
findSkipping Char -> Bool
skip = forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' OrgParser (Tokens Text)
toSkip
where
toSkip :: OrgParser (Tokens Text)
toSkip = 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 Char -> Bool
skip
{-# INLINEABLE findSkipping #-}
withContext__ ::
forall a end skip.
OrgParser skip ->
OrgParser end ->
OrgParser a ->
OrgParser (a, end, Text)
withContext__ :: forall a end skip.
OrgParser skip
-> OrgParser end -> OrgParser a -> OrgParser (a, end, Text)
withContext__ OrgParser skip
skip OrgParser end
end OrgParser a
p = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
OrgParser ()
clearLastChar
FullState
st <- OrgParser FullState
getFullState
(Text
str, end
final) <- forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' OrgParser skip
skip OrgParser end
end
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
str)
(,end
final,Text
str) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall b. FullState -> Text -> OrgParser b -> OrgParser b
parseFromText FullState
st Text
str OrgParser a
p
{-# INLINEABLE withContext__ #-}
withContext_ ::
forall a end skip.
OrgParser skip ->
OrgParser end ->
OrgParser a ->
OrgParser (a, end)
withContext_ :: forall a end skip.
OrgParser skip
-> OrgParser end -> OrgParser a -> OrgParser (a, end)
withContext_ OrgParser skip
skip OrgParser end
end OrgParser a
p =
forall a end skip.
OrgParser skip
-> OrgParser end -> OrgParser a -> OrgParser (a, end, Text)
withContext__ OrgParser skip
skip OrgParser end
end OrgParser a
p forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(a
x, end
y, Text
_) -> (a
x, end
y)
{-# INLINEABLE withContext_ #-}
withContext ::
forall a end skip.
OrgParser skip ->
OrgParser end ->
OrgParser a ->
OrgParser a
withContext :: forall a end skip.
OrgParser skip -> OrgParser end -> OrgParser a -> OrgParser a
withContext OrgParser skip
skip OrgParser end
end = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. (a, b) -> a
fst forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a end skip.
OrgParser skip
-> OrgParser end -> OrgParser a -> OrgParser (a, end)
withContext_ OrgParser skip
skip OrgParser end
end
{-# INLINEABLE withContext #-}
withMContext ::
forall a b.
(Char -> Bool) ->
(Char -> Bool) ->
OrgParser b ->
OrgParser a ->
OrgParser a
withMContext :: forall a b.
(Char -> Bool)
-> (Char -> Bool) -> OrgParser b -> OrgParser a -> OrgParser a
withMContext Char -> Bool
allowed Char -> Bool
skip OrgParser b
end OrgParser a
p = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
OrgParser ()
clearLastChar
FullState
st <- OrgParser FullState
getFullState
Text
prelim <- 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 -> Char -> Bool
skip Token Text
c Bool -> Bool -> Bool
&& Char -> Bool
allowed Token Text
c
((Text
prelim forall a. Semigroup a => a -> a -> a
<>) -> Text
str, b
_) <- forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' OrgParser (Tokens Text)
toSkip OrgParser b
end
forall (f :: * -> *). Alternative f => Bool -> f ()
guard (Bool -> Bool
not forall a b. (a -> b) -> a -> b
$ Text -> Bool
T.null Text
str)
forall b. FullState -> Text -> OrgParser b -> OrgParser b
parseFromText FullState
st Text
str OrgParser a
p
where
toSkip :: OrgParser (Tokens Text)
toSkip = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
allowed 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 -> Char -> Bool
skip Token Text
c Bool -> Bool -> Bool
&& Char -> Bool
allowed Token Text
c
{-# INLINEABLE withMContext #-}
withBalancedContext ::
Char ->
Char ->
(Char -> Bool) ->
OrgParser a ->
OrgParser a
withBalancedContext :: forall a.
Char -> Char -> (Char -> Bool) -> OrgParser a -> OrgParser a
withBalancedContext Char
lchar Char
rchar Char -> Bool
allowed OrgParser a
p = 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
lchar
let skip :: StateT Int OrgParser ()
skip :: StateT Int OrgParser ()
skip = do
Tokens Text
_ <-
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP
(forall a. a -> Maybe a
Just String
"insides of markup")
(\Token Text
c -> Char -> Bool
allowed Token Text
c Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
lchar Bool -> Bool -> Bool
&& Token Text
c forall a. Eq a => a -> a -> Bool
/= Char
rchar)
Char
c <- forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
lookAhead (forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
allowed) forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"balanced delimiters"
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
c forall a. Eq a => a -> a -> Bool
== Char
lchar) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Num a => a -> a -> a
+ Int
1)
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Char
c forall a. Eq a => a -> a -> Bool
== Char
rchar) forall a b. (a -> b) -> a -> b
$ forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify (forall a. Num a => a -> a -> a
subtract Int
1)
forall s (m :: * -> *). MonadState s m => m s
get forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
Int
balance
| Int
balance forall a. Ord a => a -> a -> Bool
< Int
0 -> forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
"unbalaced delimiters"
| Int
balance forall a. Eq a => a -> a -> Bool
== Int
0 -> forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
| Bool
otherwise -> forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
end :: StateT Int OrgParser ()
end = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try do
forall (f :: * -> *). Alternative f => Bool -> f ()
guard forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a. Eq a => a -> a -> Bool
== Int
0) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall s (m :: * -> *). MonadState s m => m s
get
Token Text
_ <- forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
Token s -> m (Token s)
char Char
rchar
forall (t :: (* -> *) -> * -> *) (m :: * -> *) a.
(MonadTrans t, Monad m) =>
m a -> t m a
lift forall a b. (a -> b) -> a -> b
$ Char -> OrgParser ()
putLastChar Char
rchar
FullState
st <- OrgParser FullState
getFullState
(Text
str, ()
_) <- forall (m :: * -> *) s a. Monad m => StateT s m a -> s -> m a
evalStateT (forall skip end (m :: * -> *).
MonadParser m =>
m skip -> m end -> m (Text, end)
skipManyTill' StateT Int OrgParser ()
skip StateT Int OrgParser ()
end) Int
1
forall b. FullState -> Text -> OrgParser b -> OrgParser b
parseFromText FullState
st Text
str OrgParser a
p
markupContext ::
Monoid k =>
(Text -> k) ->
Marked OrgParser k ->
OrgParser k
markupContext :: forall k.
Monoid k =>
(Text -> k) -> Marked OrgParser k -> OrgParser k
markupContext Text -> k
f Marked OrgParser k
elems = OrgParser k
go
where
go :: OrgParser k
go = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
let Set Char
specials :: Set Char = forall l. IsList l => [Item l] -> l
fromList forall a b. (a -> b) -> a -> b
$ forall (m :: * -> *) a. Marked m a -> String
getMarks Marked OrgParser k
elems
Maybe Text
str <-
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. Maybe a
Nothing
(forall a. Ord a => a -> Set a -> Bool
`notMember` Set Char
specials)
let self :: k
self = forall b a. b -> (a -> b) -> Maybe a -> b
maybe forall a. Monoid a => a
mempty Text -> k
f Maybe Text
str
Maybe Char -> OrgParser ()
setLastChar (Text -> Char
T.last forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Maybe Text
str)
(k
self forall a. Semigroup a => a -> a -> a
<>) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (OrgParser k
finishSelf forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OrgParser k
anotherEl forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> OrgParser k
nextChar)
where
finishSelf :: OrgParser k
finishSelf = forall e s (m :: * -> *). MonadParsec e s m => m ()
eof forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> forall a. Monoid a => a
mempty
anotherEl :: OrgParser k
anotherEl = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
k
el <- forall (m :: * -> *) a. Marked m a -> m a
getParser Marked OrgParser k
elems
k
rest <- OrgParser k
go
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ k
el forall a. Semigroup a => a -> a -> a
<> k
rest
nextChar :: OrgParser k
nextChar = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
Char
c <- forall e s (m :: * -> *). MonadParsec e s m => m (Token s)
anySingle
Char -> OrgParser ()
putLastChar Char
c
k
rest <- OrgParser k
go
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Text -> k
f (forall x. One x => OneItem x -> x
one Char
c) forall a. Semigroup a => a -> a -> a
<> k
rest