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

    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 "\\\"" ParsecT Text () Identity String
    -> Text -> ParsecT Text () Identity Text
    forall (f :: * -> *) a b. Functor f => f a -> b -> f b
    $> "\\\""

    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 '"'
      [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 '"'))

    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 "\\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 "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
                  ("\\l", s :: Text
    s) : _ -> Text
    farg Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> "#" Text -> Text -> Text
    forall a. Semigroup a => a -> a -> a
    <> Text
    s
                  _              -> Text
    farg
      Text -> ParsecT Text () Identity Text
    forall (m :: * -> *) a. Monad m => a -> m a
    return Text
    url