-- | Mid-level parsers for XML instructions.
--
-- All documentation examples assume the following setup:
--
-- > :set -XOverloadedStrings
-- > import Data.Attoparsec.ByteString
module Data.XML.Parser.Mid.Instruction where

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

-- | Processing instruction.
--
-- <https://www.w3.org/TR/REC-xml/#dt-pi>
data Instruction = Instruction Text Text
  deriving (Instruction -> Instruction -> Bool
(Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool) -> Eq Instruction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instruction -> Instruction -> Bool
$c/= :: Instruction -> Instruction -> Bool
== :: Instruction -> Instruction -> Bool
$c== :: Instruction -> Instruction -> Bool
Eq, Eq Instruction
Eq Instruction
-> (Instruction -> Instruction -> Ordering)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Bool)
-> (Instruction -> Instruction -> Instruction)
-> (Instruction -> Instruction -> Instruction)
-> Ord Instruction
Instruction -> Instruction -> Bool
Instruction -> Instruction -> Ordering
Instruction -> Instruction -> Instruction
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 :: Instruction -> Instruction -> Instruction
$cmin :: Instruction -> Instruction -> Instruction
max :: Instruction -> Instruction -> Instruction
$cmax :: Instruction -> Instruction -> Instruction
>= :: Instruction -> Instruction -> Bool
$c>= :: Instruction -> Instruction -> Bool
> :: Instruction -> Instruction -> Bool
$c> :: Instruction -> Instruction -> Bool
<= :: Instruction -> Instruction -> Bool
$c<= :: Instruction -> Instruction -> Bool
< :: Instruction -> Instruction -> Bool
$c< :: Instruction -> Instruction -> Bool
compare :: Instruction -> Instruction -> Ordering
$ccompare :: Instruction -> Instruction -> Ordering
$cp1Ord :: Eq Instruction
Ord, ReadPrec [Instruction]
ReadPrec Instruction
Int -> ReadS Instruction
ReadS [Instruction]
(Int -> ReadS Instruction)
-> ReadS [Instruction]
-> ReadPrec Instruction
-> ReadPrec [Instruction]
-> Read Instruction
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Instruction]
$creadListPrec :: ReadPrec [Instruction]
readPrec :: ReadPrec Instruction
$creadPrec :: ReadPrec Instruction
readList :: ReadS [Instruction]
$creadList :: ReadS [Instruction]
readsPrec :: Int -> ReadS Instruction
$creadsPrec :: Int -> ReadS Instruction
Read, Int -> Instruction -> ShowS
[Instruction] -> ShowS
Instruction -> String
(Int -> Instruction -> ShowS)
-> (Instruction -> String)
-> ([Instruction] -> ShowS)
-> Show Instruction
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instruction] -> ShowS
$cshowList :: [Instruction] -> ShowS
show :: Instruction -> String
$cshow :: Instruction -> String
showsPrec :: Int -> Instruction -> ShowS
$cshowsPrec :: Int -> Instruction -> ShowS
Show)


-- | <https://www.w3.org/TR/REC-xml/#dt-pi>
--
-- >>> parseOnly instruction "<?xml-stylesheet type='text/xsl' href='style.xsl'?>"
-- Right (Instruction "xml-stylesheet" "type='text/xsl' href='style.xsl'")
instruction :: CharParsing m => Monad m => m Instruction
instruction :: m Instruction
instruction = do
  Text
name <- m Text
forall (m :: * -> *). (CharParsing m, Monad m) => m Text
tokenInstructionOpen
  m String
forall (m :: * -> *). CharParsing m => m String
tokenWhitespace
  String
content <- m Char -> m () -> m String
forall (m :: * -> *) a end. Alternative m => m a -> m end -> m [a]
manyTill m Char
forall (m :: * -> *). CharParsing m => m Char
anyChar (m () -> m String) -> m () -> m String
forall a b. (a -> b) -> a -> b
$ m () -> m ()
forall (m :: * -> *) a. Parsing m => m a -> m a
try m ()
forall (m :: * -> *). CharParsing m => m ()
tokenInstructionClose
  Instruction -> m Instruction
forall (m :: * -> *) a. Monad m => a -> m a
return (Instruction -> m Instruction) -> Instruction -> m Instruction
forall a b. (a -> b) -> a -> b
$ Text -> Text -> Instruction
Instruction Text
name (Text -> Instruction) -> Text -> Instruction
forall a b. (a -> b) -> a -> b
$ String -> Text
Text.pack String
content