-- | Mid-level parsers for XML external entities.
--
-- <https://www.w3.org/TR/REC-xml/#dt-extent>
--
-- All documentation examples assume the following setup:
--
-- > :set -XOverloadedStrings
-- > import Data.Attoparsec.ByteString
module Data.XML.Parser.Mid.ExternalID
  ( ExternalID(..)
  , externalID
  ) where

import           Control.Applicative
import           Data.Text               (Text)
import qualified Data.Text               as Text
import           Data.XML.Parser.Low
import           Text.Parser.Char
import           Text.Parser.Combinators

-- $setup
-- >>> :set -XOverloadedStrings
-- >>> import Data.Attoparsec.ByteString


-- | External entity identifier
--
-- <https://www.w3.org/TR/REC-xml/#dt-extent>
data ExternalID = PublicID Text Text | SystemID Text
  deriving (ExternalID -> ExternalID -> Bool
(ExternalID -> ExternalID -> Bool)
-> (ExternalID -> ExternalID -> Bool) -> Eq ExternalID
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ExternalID -> ExternalID -> Bool
$c/= :: ExternalID -> ExternalID -> Bool
== :: ExternalID -> ExternalID -> Bool
$c== :: ExternalID -> ExternalID -> Bool
Eq, Eq ExternalID
Eq ExternalID
-> (ExternalID -> ExternalID -> Ordering)
-> (ExternalID -> ExternalID -> Bool)
-> (ExternalID -> ExternalID -> Bool)
-> (ExternalID -> ExternalID -> Bool)
-> (ExternalID -> ExternalID -> Bool)
-> (ExternalID -> ExternalID -> ExternalID)
-> (ExternalID -> ExternalID -> ExternalID)
-> Ord ExternalID
ExternalID -> ExternalID -> Bool
ExternalID -> ExternalID -> Ordering
ExternalID -> ExternalID -> ExternalID
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ExternalID -> ExternalID -> ExternalID
$cmin :: ExternalID -> ExternalID -> ExternalID
max :: ExternalID -> ExternalID -> ExternalID
$cmax :: ExternalID -> ExternalID -> ExternalID
>= :: ExternalID -> ExternalID -> Bool
$c>= :: ExternalID -> ExternalID -> Bool
> :: ExternalID -> ExternalID -> Bool
$c> :: ExternalID -> ExternalID -> Bool
<= :: ExternalID -> ExternalID -> Bool
$c<= :: ExternalID -> ExternalID -> Bool
< :: ExternalID -> ExternalID -> Bool
$c< :: ExternalID -> ExternalID -> Bool
compare :: ExternalID -> ExternalID -> Ordering
$ccompare :: ExternalID -> ExternalID -> Ordering
$cp1Ord :: Eq ExternalID
Ord, ReadPrec [ExternalID]
ReadPrec ExternalID
Int -> ReadS ExternalID
ReadS [ExternalID]
(Int -> ReadS ExternalID)
-> ReadS [ExternalID]
-> ReadPrec ExternalID
-> ReadPrec [ExternalID]
-> Read ExternalID
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ExternalID]
$creadListPrec :: ReadPrec [ExternalID]
readPrec :: ReadPrec ExternalID
$creadPrec :: ReadPrec ExternalID
readList :: ReadS [ExternalID]
$creadList :: ReadS [ExternalID]
readsPrec :: Int -> ReadS ExternalID
$creadsPrec :: Int -> ReadS ExternalID
Read, Int -> ExternalID -> ShowS
[ExternalID] -> ShowS
ExternalID -> String
(Int -> ExternalID -> ShowS)
-> (ExternalID -> String)
-> ([ExternalID] -> ShowS)
-> Show ExternalID
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ExternalID] -> ShowS
$cshowList :: [ExternalID] -> ShowS
show :: ExternalID -> String
$cshow :: ExternalID -> String
showsPrec :: Int -> ExternalID -> ShowS
$cshowsPrec :: Int -> ExternalID -> ShowS
Show)


-- | <https://www.w3.org/TR/REC-xml/#NT-ExternalID>
--
-- >>> parseOnly externalID "PUBLIC '-//Textuality//TEXT Standard open-hatch boilerplate//EN' 'http://www.textuality.com/boilerplate/OpenHatch.xml'"
-- Right (PublicID "-//Textuality//TEXT Standard open-hatch boilerplate//EN" "http://www.textuality.com/boilerplate/OpenHatch.xml")
-- >>> parseOnly externalID "SYSTEM '../grafix/OpenHatch.gif'"
-- Right (SystemID "../grafix/OpenHatch.gif")
externalID :: CharParsing m => Monad m => m ExternalID
externalID :: m ExternalID
externalID = m ExternalID
publicID m ExternalID -> m ExternalID -> m ExternalID
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m ExternalID
systemID where
  publicID :: m ExternalID
publicID = do
    String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"PUBLIC"
    m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
    Text
a <- m Text
systemLiteral
    m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
    Text
b <- m Text
systemLiteral
    ExternalID -> m ExternalID
forall (m :: * -> *) a. Monad m => a -> m a
return (ExternalID -> m ExternalID) -> ExternalID -> m ExternalID
forall a b. (a -> b) -> a -> b
$ Text -> Text -> ExternalID
PublicID Text
a Text
b
  systemID :: m ExternalID
systemID = String -> m String
forall (m :: * -> *). CharParsing m => String -> m String
string String
"SYSTEM" m String -> m String -> m String
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace m String -> m ExternalID -> m ExternalID
forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
*> (Text -> ExternalID
SystemID (Text -> ExternalID) -> m Text -> m ExternalID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Text
systemLiteral)
  systemLiteral :: m Text
systemLiteral = String -> Text
Text.pack (String -> Text) -> m String -> m Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> m Char -> m String
forall (m :: * -> *) a. (CharParsing m, Monad m) => m a -> m [a]
manyQuoted m Char
forall (m :: * -> *). CharParsing m => m Char
anyChar

quoted :: CharParsing m => Monad m => m a -> m a
quoted :: m a -> m a
quoted m a
x = m a
x m a -> m Char -> m a
forall (m :: * -> *) a sur. Applicative m => m a -> m sur -> m a
`surroundedBy` m Char
forall (m :: * -> *). CharParsing m => m Char
tokenSingleQuote m a -> m a -> m a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m a
x m a -> m Char -> m a
forall (m :: * -> *) a sur. Applicative m => m a -> m sur -> m a
`surroundedBy` m Char
forall (m :: * -> *). CharParsing m => m Char
tokenDoubleQuote

manyQuoted :: CharParsing m => Monad m => m a -> m [a]
manyQuoted :: m a -> m [a]
manyQuoted m a
x = m Char -> m a -> m [a]
forall (m :: * -> *) end a.
(Monad m, Parsing m) =>
m end -> m a -> m [a]
manyQuotedBy m Char
forall (m :: * -> *). CharParsing m => m Char
tokenSingleQuote m a
x m [a] -> m [a] -> m [a]
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> m Char -> m a -> m [a]
forall (m :: * -> *) end a.
(Monad m, Parsing m) =>
m end -> m a -> m [a]
manyQuotedBy m Char
forall (m :: * -> *). CharParsing m => m Char
tokenDoubleQuote m a
x where
  manyQuotedBy :: m end -> m a -> m [a]
manyQuotedBy m end
quote m a
x = do
    m end
quote
    m a -> m end -> m [a]
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill m a
x (m end -> m end
forall (m :: * -> *) a. Parsing m => m a -> m a
try m end
quote)