{-# LANGUAGE OverloadedStrings #-}
{- |
   Module      : Text.Pandoc.Readers.Docx.Fields
   Copyright   : Copyright (C) 2014-2020 Jesse Rosenthal
   License     : GNU GPL, version 2 or above

   Maintainer  : Jesse Rosenthal <jrosenthal@jhu.edu>
   Stability   : alpha
   Portability : portable

For parsing Field definitions in instText tags, as described in
ECMA-376-1:2016, §17.16.5 -}

module Text.Pandoc.Readers.Docx.Fields ( FieldInfo(..)
                                       , parseFieldInfo
                                       ) where

import Data.Functor (($>), void)
import qualified Data.Text as T
import Text.Pandoc.Parsing

type URL = T.Text
type Anchor = T.Text

data FieldInfo = HyperlinkField URL
                -- The boolean indicates whether the field is a hyperlink.
               | PagerefField Anchor Bool
               | CslCitation T.Text
               | CslBibliography
               | EndNoteCite T.Text
               | EndNoteRefList
               | 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
$cshowsPrec :: Int -> FieldInfo -> ShowS
showsPrec :: Int -> FieldInfo -> ShowS
$cshow :: FieldInfo -> String
show :: FieldInfo -> String
$cshowList :: [FieldInfo] -> ShowS
showList :: [FieldInfo] -> ShowS
Show)

type Parser = Parsec T.Text ()

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
<|>
  Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () FieldInfo
addIn
  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 a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FieldInfo
UnknownField

addIn :: Parser FieldInfo
addIn :: Parsec Text () FieldInfo
addIn = do
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"ADDIN"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parsec Text () FieldInfo
cslCitation 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
cslBibliography 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
endnoteCite 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
endnoteRefList

cslCitation :: Parser FieldInfo
cslCitation :: Parsec Text () FieldInfo
cslCitation = do
  ParsecT Text () Identity String -> ParsecT Text () Identity ()
forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"ZOTERO_ITEM")
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"CSL_CITATION"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text -> FieldInfo
CslCitation (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
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput

cslBibliography :: Parser FieldInfo
cslBibliography :: Parsec Text () FieldInfo
cslBibliography = do
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"ZOTERO_BIBL" ParsecT Text () Identity String
-> ParsecT Text () Identity String
-> ParsecT Text () Identity String
forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"Mendeley Bibliography CSL_BIBLIOGRAPHY"
  FieldInfo -> Parsec Text () FieldInfo
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FieldInfo
CslBibliography

endnoteCite :: Parser FieldInfo
endnoteCite :: Parsec Text () FieldInfo
endnoteCite = Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () FieldInfo -> Parsec Text () FieldInfo)
-> Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"EN.CITE"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text -> FieldInfo
EndNoteCite (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
forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput

endnoteRefList :: Parser FieldInfo
endnoteRefList :: Parsec Text () FieldInfo
endnoteRefList = Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Parsec Text () FieldInfo -> Parsec Text () FieldInfo)
-> Parsec Text () FieldInfo -> Parsec Text () FieldInfo
forall a b. (a -> b) -> a -> b
$ do
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"EN.REFLIST"
  FieldInfo -> Parsec Text () FieldInfo
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return FieldInfo
EndNoteRefList


escapedQuote :: Parser T.Text
escapedQuote :: ParsecT Text () Identity Text
escapedQuote = String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar)

quotedString :: Parser T.Text
quotedString :: ParsecT Text () Identity Text
quotedString = do
  Char -> ParsecT Text () Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s 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

-- there are other switches, but this is the only one I've seen in the wild so far, so it's the first one I'll implement. See §17.16.5.25
hyperlinkSwitch :: Parser (T.Text, T.Text)
hyperlinkSwitch :: Parser (Text, Text)
hyperlinkSwitch = do
  String
sw <- String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\l"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- ParsecT Text () Identity Text
fieldArgument
  (Text, Text) -> Parser (Text, Text)
forall a. a -> ParsecT Text () Identity a
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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"HYPERLINK"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- Text
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall s (m :: * -> *) t a u.
Stream s m t =>
a -> ParsecT s u m a -> ParsecT s u m a
option Text
"" (ParsecT Text () Identity Text -> ParsecT Text () Identity Text)
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall a b. (a -> b) -> a -> b
$ ParsecT Text () Identity Char -> ParsecT Text () Identity ()
forall s (m :: * -> *) t a u.
(Stream s m t, Show a) =>
ParsecT s u m a -> ParsecT s u m ()
notFollowedBy (Char -> ParsecT Text () Identity Char
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
Char -> ParsecT s u m Char
char Char
'\\') ParsecT Text () Identity ()
-> ParsecT Text () Identity Text -> ParsecT Text () Identity Text
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> ParsecT Text () Identity Text
fieldArgument
  [(Text, Text)]
switches <- ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity [(Text, Text)]
-> ParsecT Text () Identity [(Text, Text)]
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
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 a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return Text
url

-- See §17.16.5.45
pagerefSwitch :: Parser (T.Text, T.Text)
pagerefSwitch :: Parser (Text, Text)
pagerefSwitch = do
  String
sw <- String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\h"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- ParsecT Text () Identity Text
fieldArgument
  (Text, Text) -> Parser (Text, Text)
forall a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
sw, Text
farg)

pageref :: Parser (Anchor, Bool)
pageref :: ParsecT Text () Identity (Text, Bool)
pageref = 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 (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space
  String -> ParsecT Text () Identity String
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"PAGEREF"
  ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- ParsecT Text () Identity Text
fieldArgument
  [(Text, Text)]
switches <- ParsecT Text () Identity ()
forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces ParsecT Text () Identity ()
-> ParsecT Text () Identity [(Text, Text)]
-> ParsecT Text () Identity [(Text, Text)]
forall a b.
ParsecT Text () Identity a
-> ParsecT Text () Identity b -> ParsecT Text () Identity b
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 a. a -> ParsecT Text () Identity a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text
farg, Bool
isLink)