{-# 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.Parsec
import Text.Parsec.Text (Parser)

type URL = T.Text

data FieldInfo = HyperlinkField URL
               | 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
<|>
  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

-- 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 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