{-# LANGUAGE OverloadedStrings #-}
module Text.Pandoc.Readers.Docx.Fields ( FieldInfo(..)
, parseFieldInfo
) where
import Data.Functor (($>), void)
import qualified Data.Text as T
import Text.Parsec
import Text.Parsec.Text (Parser)
type URL = T.Text
type Anchor = T.Text
data FieldInfo = HyperlinkField URL
| Anchor Bool
| UnknownField
deriving (Int -> FieldInfo -> ShowS
[FieldInfo] -> ShowS
FieldInfo -> String
(Int -> FieldInfo -> ShowS)
-> (FieldInfo -> String)
-> ([FieldInfo] -> ShowS)
-> Show FieldInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FieldInfo] -> ShowS
$cshowList :: [FieldInfo] -> ShowS
show :: FieldInfo -> String
$cshow :: FieldInfo -> String
showsPrec :: Int -> FieldInfo -> ShowS
$cshowsPrec :: Int -> FieldInfo -> ShowS
Show)
parseFieldInfo :: T.Text -> Either ParseError FieldInfo
parseFieldInfo :: Text -> Either ParseError FieldInfo
parseFieldInfo = Parsec Text () FieldInfo
-> String -> Text -> Either ParseError FieldInfo
forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parsec Text () FieldInfo
fieldInfo String
""
fieldInfo :: Parser FieldInfo
fieldInfo :: Parsec Text () FieldInfo
fieldInfo =
Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> FieldInfo
HyperlinkField (Text -> FieldInfo)
-> ParsecT Text () Identity Text -> Parsec Text () FieldInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Text
hyperlink)
Parsec Text () FieldInfo
-> Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (((Text -> Bool -> FieldInfo) -> (Text, Bool) -> FieldInfo
forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Bool -> FieldInfo
PagerefField) ((Text, Bool) -> FieldInfo)
-> ParsecT Text () Identity (Text, Bool)
-> Parsec Text () FieldInfo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity (Text, Bool)
pageref)
Parsec Text () FieldInfo
-> Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
FieldInfo -> Parsec Text () FieldInfo
forall (m :: * -> *) a. Monad m => a -> m a
return FieldInfo
UnknownField
escapedQuote :: Parser T.Text
escapedQuote :: ParsecT Text () Identity Text
escapedQuote = String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\\"" ParsecT Text () Identity String
-> Text -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\\\""
inQuotes :: Parser T.Text
inQuotes :: ParsecT Text () Identity Text
inQuotes =
ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ParsecT Text () Identity Text
escapedQuote ParsecT Text () Identity Text
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Text
T.singleton (Char -> Text)
-> ParsecT Text () Identity Char -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar)
quotedString :: Parser T.Text
quotedString :: ParsecT Text () Identity Text
quotedString = do
Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'
[Text] -> Text
T.concat ([Text] -> Text)
-> ParsecT Text () Identity [Text] -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Text
-> ParsecT Text () Identity Char -> ParsecT Text () Identity [Text]
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Text
inQuotes (ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) u.
Stream s m Char =>
Char -> ParsecT s u m Char
char Char
'"'))
unquotedString :: Parser T.Text
unquotedString :: ParsecT Text () Identity Text
unquotedString = String -> Text
T.pack (String -> Text)
-> ParsecT Text () Identity String -> ParsecT Text () Identity Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ParsecT Text () Identity Char
-> ParsecT Text () Identity () -> ParsecT Text () Identity String
forall s (m :: * -> *) t u a end.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m end -> ParsecT s u m [a]
manyTill ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
anyChar (ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (ParsecT Text () Identity () -> ParsecT Text () Identity ())
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ParsecT Text () Identity Char -> ParsecT Text () Identity Char
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space) ParsecT Text () Identity ()
-> ParsecT Text () Identity () -> ParsecT Text () Identity ()
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity ()
forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)
fieldArgument :: Parser T.Text
fieldArgument :: ParsecT Text () Identity Text
fieldArgument = ParsecT Text () Identity Text
quotedString ParsecT Text () Identity Text
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> ParsecT Text () Identity Text
unquotedString
hyperlinkSwitch :: Parser (T.Text, T.Text)
hyperlinkSwitch :: Parser (Text, Text)
hyperlinkSwitch = do
String
sw <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\l"
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
Text
farg <- ParsecT Text () Identity Text
fieldArgument
(Text, Text) -> Parser (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
sw, Text
farg)
hyperlink :: Parser URL
hyperlink :: ParsecT Text () Identity Text
hyperlink = do
ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"HYPERLINK"
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
Text
farg <- ParsecT Text () Identity Text
fieldArgument
[(Text, Text)]
switches <- ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity [(Text, Text)]
-> ParsecT Text () Identity [(Text, Text)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Text) -> ParsecT Text () Identity [(Text, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (Text, Text)
hyperlinkSwitch
let url :: Text
url = case [(Text, Text)]
switches of
(Text
"\\l", Text
s) : [(Text, Text)]
_ -> Text
farg Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
s
[(Text, Text)]
_ -> Text
farg
Text -> ParsecT Text () Identity Text
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url
pagerefSwitch :: Parser (T.Text, T.Text)
= do
String
sw <- String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"\\h"
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
Text
farg <- ParsecT Text () Identity Text
fieldArgument
(Text, Text) -> Parser (Text, Text)
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
sw, Text
farg)
pageref :: Parser (Anchor, Bool)
= do
ParsecT Text () Identity Char -> ParsecT Text () Identity String
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many ParsecT Text () Identity Char
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m Char
space
String -> ParsecT Text () Identity String
forall s (m :: * -> *) u.
Stream s m Char =>
String -> ParsecT s u m String
string String
"PAGEREF"
ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces
Text
farg <- ParsecT Text () Identity Text
fieldArgument
[(Text, Text)]
switches <- ParsecT Text () Identity ()
forall s (m :: * -> *) u. Stream s m Char => ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity [(Text, Text)]
-> ParsecT Text () Identity [(Text, Text)]
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> Parser (Text, Text) -> ParsecT Text () Identity [(Text, Text)]
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many Parser (Text, Text)
pagerefSwitch
let isLink :: Bool
isLink = case [(Text, Text)]
switches of
(Text
"\\h", Text
_) : [(Text, Text)]
_ -> Bool
True
[(Text, Text)]
_ -> Bool
False
(Text, Bool) -> ParsecT Text () Identity (Text, Bool)
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
farg, Bool
isLink)