module Org.Parser.Common where
import Data.Char (digitToInt, isAsciiLower, isAsciiUpper)
import Data.Text qualified as T
import Org.Parser.Definitions
import Prelude hiding (State, many, some)
headingStart :: OrgParser Int
headingStart :: OrgParser Int
headingStart =
forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$
(Text -> Int
T.length forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> 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
"heading bullets") (forall a. Eq a => a -> a -> Bool
== Char
'*'))
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
' '
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadParser m => m Text
skipSpaces
parseTime :: OrgParser Time
parseTime :: OrgParser Time
parseTime = do
Int
hour <- (Int -> OrgParser Int
number Int
2 forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Int -> OrgParser Int
number Int
1) 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
minute <- Int -> OrgParser Int
number Int
2
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Int
hour, Int
minute)
string'' :: MonadParser m => Text -> m Text
string'' :: forall (m :: * -> *). MonadParser m => Text -> m Text
string'' = forall e s (m :: * -> *).
MonadParsec e s m =>
(Tokens s -> Tokens s -> Bool) -> Tokens s -> m (Tokens s)
tokens (forall a. Eq a => a -> a -> Bool
(==) forall b c a. (b -> b -> c) -> (a -> b) -> a -> a -> c
`on` Text -> Text
T.toLower)
{-# INLINE string'' #-}
digitIntChar :: MonadParser m => m Int
digitIntChar :: forall (m :: * -> *). MonadParser m => m Int
digitIntChar = Char -> Int
digitToInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
digitChar
digits :: MonadParser m => m Text
digits :: forall (m :: * -> *). MonadParser m => m Text
digits = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"digits") Char -> Bool
isDigit
digits1 :: MonadParser m => m Text
digits1 :: forall (m :: * -> *). MonadParser m => m Text
digits1 = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"digits") Char -> Bool
isDigit
integer :: MonadParser m => m Int
integer :: forall (m :: * -> *). MonadParser m => m Int
integer = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
[Int]
digits' <- forall a. [a] -> [a]
reverse forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) a. MonadPlus m => m a -> m [a]
some forall (m :: * -> *). MonadParser m => m Int
digitIntChar
let toInt :: [a] -> a
toInt (a
x : [a]
xs) = a
10 forall a. Num a => a -> a -> a
* [a] -> a
toInt [a]
xs forall a. Num a => a -> a -> a
+ a
x
toInt [] = a
0
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ forall {a}. Num a => [a] -> a
toInt [Int]
digits'
number ::
Int ->
OrgParser Int
number :: Int -> OrgParser Int
number Int
1 = forall (m :: * -> *). MonadParser m => m Int
digitIntChar
number Int
n | Int
n forall a. Ord a => a -> a -> Bool
> Int
1 = forall e s (m :: * -> *) a. MonadParsec e s m => m a -> m a
try forall a b. (a -> b) -> a -> b
$ do
Int
d <- forall (m :: * -> *). MonadParser m => m Int
digitIntChar
(Int
10 forall a b. (Num a, Integral b) => a -> b -> a
^ (Int
n forall a. Num a => a -> a -> a
- Int
1) forall a. Num a => a -> a -> a
* Int
d forall a. Num a => a -> a -> a
+) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> OrgParser Int
number (Int
n forall a. Num a => a -> a -> a
- Int
1)
number Int
_ = forall a t. (HasCallStack, IsText t) => t -> a
error Text
"Number of digits to parse must be positive!"
isAsciiAlpha :: Char -> Bool
isAsciiAlpha :: Char -> Bool
isAsciiAlpha Char
c = Char -> Bool
isAsciiLower Char
c Bool -> Bool -> Bool
|| Char -> Bool
isAsciiUpper Char
c
upperAscii' :: MonadParser m => m Int
upperAscii' :: forall (m :: * -> *). MonadParser m => m Int
upperAscii' = do
Char
c <- forall (m :: * -> *). MonadParser m => m Char
upperAscii
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'A' forall a. Num a => a -> a -> a
+ Int
1
lowerAscii' :: MonadParser m => m Int
lowerAscii' :: forall (m :: * -> *). MonadParser m => m Int
lowerAscii' = do
Char
c <- forall (m :: * -> *). MonadParser m => m Char
lowerAscii
forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Char -> Int
ord Char
c forall a. Num a => a -> a -> a
- Char -> Int
ord Char
'a' forall a. Num a => a -> a -> a
+ Int
1
asciiAlpha' :: MonadParser m => m Int
asciiAlpha' :: forall (m :: * -> *). MonadParser m => m Int
asciiAlpha' = forall (m :: * -> *). MonadParser m => m Int
lowerAscii' forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall (m :: * -> *). MonadParser m => m Int
upperAscii'
upperAscii :: MonadParser m => m Char
upperAscii :: forall (m :: * -> *). MonadParser m => m Char
upperAscii =
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isAsciiUpper
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"uppercase A-Z character"
lowerAscii :: MonadParser m => m Char
lowerAscii :: forall (m :: * -> *). MonadParser m => m Char
lowerAscii =
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isAsciiLower
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"lowercase a-z character"
asciiAlpha :: MonadParser m => m Char
asciiAlpha :: forall (m :: * -> *). MonadParser m => m Char
asciiAlpha =
forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isAsciiAlpha
forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"a-z or A-Z character"
manyAsciiAlpha :: OrgParser Text
manyAsciiAlpha :: OrgParser Text
manyAsciiAlpha =
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP
(forall a. a -> Maybe a
Just String
"a-z or A-Z characters")
Char -> Bool
isAsciiAlpha
someAsciiAlpha :: MonadParser m => m Text
someAsciiAlpha :: forall (m :: * -> *). MonadParser m => m Text
someAsciiAlpha =
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P
(forall a. a -> Maybe a
Just String
"a-z or A-Z characters")
Char -> Bool
isAsciiAlpha
someNonSpace :: OrgParser Text
someNonSpace :: OrgParser Text
someNonSpace = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"not whitespace") (Bool -> Bool
not forall b c a. (b -> c) -> (a -> b) -> a -> c
. Char -> Bool
isSpace)
isSpaceOrTab :: Char -> Bool
isSpaceOrTab :: Char -> Bool
isSpaceOrTab Char
c = Char
c forall a. Eq a => a -> a -> Bool
== Char
' ' Bool -> Bool -> Bool
|| Char
c forall a. Eq a => a -> a -> Bool
== Char
'\t'
spaceOrTab :: OrgParser Char
spaceOrTab :: OrgParser Char
spaceOrTab = forall e s (m :: * -> *).
MonadParsec e s m =>
(Token s -> Bool) -> m (Token s)
satisfy Char -> Bool
isSpaceOrTab forall e s (m :: * -> *) a.
MonadParsec e s m =>
m a -> String -> m a
<?> String
"space or tab character"
countSpaces :: Int -> Text -> Int
countSpaces :: Int -> Text -> Int
countSpaces Int
tabWidth = forall a. (Char -> a -> a) -> a -> Text -> a
T.foldr Char -> Int -> Int
go Int
0
where
go :: Char -> Int -> Int
go Char
' ' = (forall a. Num a => a -> a -> a
+ Int
1)
go Char
'\t' = (forall a. Num a => a -> a -> a
+ Int
tabWidth)
go Char
_ = forall a. a -> a
id
spacesOrTabs :: OrgParser Int
spacesOrTabs :: OrgParser Int
spacesOrTabs = do
Int
tw <- forall a. (OrgOptions -> a) -> OrgParser a
getsO OrgOptions -> Int
orgSrcTabWidth
Int -> Text -> Int
countSpaces Int
tw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadParser m => m Text
skipSpaces
spacesOrTabs1 :: OrgParser Int
spacesOrTabs1 :: OrgParser Int
spacesOrTabs1 = do
Int
tw <- forall a. (OrgOptions -> a) -> OrgParser a
getsO OrgOptions -> Int
orgSrcTabWidth
Int -> Text -> Int
countSpaces Int
tw forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *). MonadParser m => m Text
skipSpaces1
skipSpaces1 :: MonadParser m => m Text
skipSpaces1 :: forall (m :: * -> *). MonadParser m => m Text
skipSpaces1 = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhile1P (forall a. a -> Maybe a
Just String
"at least one space or tab whitespace") Char -> Bool
isSpaceOrTab
skipSpaces :: MonadParser m => m Text
skipSpaces :: forall (m :: * -> *). MonadParser m => m Text
skipSpaces = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"spaces or tabs") Char -> Bool
isSpaceOrTab
guardMaybe :: (MonadFail m, MonadParser m) => String -> Maybe a -> m a
guardMaybe :: forall (m :: * -> *) a.
(MonadFail m, MonadParser m) =>
String -> Maybe a -> m a
guardMaybe String
_ (Just a
x) = forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x
guardMaybe String
err Maybe a
_ = forall (m :: * -> *) a. MonadFail m => String -> m a
fail String
err
newline' :: MonadParser m => m ()
newline' :: forall (m :: * -> *). MonadParser m => m ()
newline' = forall (f :: * -> *) a. Functor f => f a -> f ()
void forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> forall e s (m :: * -> *). MonadParsec e s m => m ()
eof
anyLine :: MonadParser m => m (Tokens Text)
anyLine :: forall (m :: * -> *). MonadParser m => m (Tokens Text)
anyLine =
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"rest of line") (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
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
{-# INLINE anyLine #-}
anyLine' :: MonadParser m => m (Tokens Text)
anyLine' :: forall (m :: * -> *). MonadParser m => m (Tokens Text)
anyLine' =
forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP (forall a. a -> Maybe a
Just String
"rest of line") (forall a. Eq a => a -> a -> Bool
/= Char
'\n')
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f a
<* forall (m :: * -> *). MonadParser m => m ()
newline'
takeInput :: MonadParser m => m Text
takeInput :: forall (m :: * -> *). MonadParser m => m Text
takeInput = forall e s (m :: * -> *).
MonadParsec e s m =>
Maybe String -> (Token s -> Bool) -> m (Tokens s)
takeWhileP forall a. Maybe a
Nothing (forall a b. a -> b -> a
const Bool
True)
blankline :: MonadParser m => m ()
blankline :: forall (m :: * -> *). MonadParser m => m ()
blankline = 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 a
<* forall e s (m :: * -> *).
(MonadParsec e s m, Token s ~ Char) =>
m (Token s)
newline
blankline' :: MonadParser m => m ()
blankline' :: forall (m :: * -> *). MonadParser m => m ()
blankline' = 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 a
<* forall (m :: * -> *). MonadParser m => m ()
newline'
parseFromText :: FullState -> Text -> OrgParser b -> OrgParser b
parseFromText :: forall b. FullState -> Text -> OrgParser b -> OrgParser b
parseFromText (State Text Void
prevPS, OrgParserState
prevOS) Text
txt OrgParser b
parser = do
(State Text Void
cPS, OrgParserState
cOS) <- OrgParser FullState
getFullState
FullState -> OrgParser ()
setFullState
( State Text Void
prevPS {stateInput :: Text
stateInput = Text
txt},
OrgParserState
cOS
{ orgStateLastChar :: Maybe Char
orgStateLastChar = OrgParserState -> Maybe Char
orgStateLastChar OrgParserState
prevOS
}
)
b
result <- OrgParser b
parser
(State Text Void
aPS, OrgParserState
aOS) <- OrgParser FullState
getFullState
FullState -> OrgParser ()
setFullState
( State Text Void
cPS
{ stateParseErrors :: [ParseError Text Void]
stateParseErrors =
forall s e. State s e -> [ParseError s e]
stateParseErrors State Text Void
cPS
forall a. [a] -> [a] -> [a]
++ forall s e. State s e -> [ParseError s e]
stateParseErrors State Text Void
aPS
},
OrgParserState
aOS
{ orgStateLastChar :: Maybe Char
orgStateLastChar =
OrgParserState -> Maybe Char
orgStateLastChar OrgParserState
cOS
}
)
forall (f :: * -> *) a. Applicative f => a -> f a
pure b
result