{-# 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
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)

type Parser = Parsec T.Text ()

parseFieldInfo :: T.Text -> Either ParseError FieldInfo
parseFieldInfo :: Text -> Either ParseError FieldInfo
parseFieldInfo = forall s t a.
Stream s Identity t =>
Parsec s () a -> String -> s -> Either ParseError a
parse Parser FieldInfo
fieldInfo String
""

fieldInfo :: Parser FieldInfo
fieldInfo :: Parser FieldInfo
fieldInfo =
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (Text -> FieldInfo
HyperlinkField forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser Text
hyperlink)
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try ((forall a b c. (a -> b -> c) -> (a, b) -> c
uncurry Text -> Bool -> FieldInfo
PagerefField) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Parser (Text, Bool)
pageref)
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser FieldInfo
addIn
  forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|>
  forall (m :: * -> *) a. Monad m => a -> m a
return FieldInfo
UnknownField

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

cslCitation :: Parser FieldInfo
cslCitation :: Parser FieldInfo
cslCitation = do
  forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m ()
optional (forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"ZOTERO_ITEM")
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"CSL_CITATION"
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text -> FieldInfo
CslCitation forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u. Monad m => ParsecT s u m s
getInput

cslBibliography :: Parser FieldInfo
cslBibliography :: Parser FieldInfo
cslBibliography = do
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"ZOTERO_BIBL" forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> 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"
  forall (m :: * -> *) a. Monad m => a -> m a
return FieldInfo
CslBibliography

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

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


escapedQuote :: Parser T.Text
escapedQuote :: Parser Text
escapedQuote = forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\\"" forall (f :: * -> *) a b. Functor f => f a -> b -> f b
$> Text
"\\\""

inQuotes :: Parser T.Text
inQuotes :: Parser Text
inQuotes =
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try Parser Text
escapedQuote forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> (Char -> Text
T.singleton forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar)

quotedString :: Parser T.Text
quotedString :: Parser Text
quotedString = do
  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 forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 Parser Text
inQuotes (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try (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 :: Parser Text
unquotedString = String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> 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 forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
anyChar (forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m a
try forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a. Functor f => f a -> f ()
void (forall s (m :: * -> *) t u a.
Stream s m t =>
ParsecT s u m a -> ParsecT s u m a
lookAhead forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space) forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> forall s (m :: * -> *) t u.
(Stream s m t, Show t) =>
ParsecT s u m ()
eof)

fieldArgument :: Parser T.Text
fieldArgument :: Parser Text
fieldArgument = Parser Text
quotedString forall s u (m :: * -> *) a.
ParsecT s u m a -> ParsecT s u m a -> ParsecT s u m a
<|> Parser 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 <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\l"
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- Parser Text
fieldArgument
  forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
sw, Text
farg)

hyperlink :: Parser URL
hyperlink :: Parser Text
hyperlink = do
  forall s u (m :: * -> *) a. ParsecT s u m a -> ParsecT s u m [a]
many forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m Char
space
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"HYPERLINK"
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- Parser Text
fieldArgument
  [(Text, Text)]
switches <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> 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 forall a. Semigroup a => a -> a -> a
<> Text
"#" forall a. Semigroup a => a -> a -> a
<> Text
s
              [(Text, Text)]
_              -> Text
farg
  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 <- forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
String -> ParsecT s u m String
string String
"\\h"
  forall (m :: * -> *) s u.
(Monad m, Stream s m Char, UpdateSourcePos s Char) =>
ParsecT s u m ()
spaces
  Text
farg <- Parser Text
fieldArgument
  forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Text
T.pack String
sw, Text
farg)

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