module OpcXmlDaClient.Protocol.XmlParsing where

import qualified Attoparsec.Data as AttoparsecData
import qualified Data.Attoparsec.Text as Atto
import qualified Data.ByteString.Base64 as Base64
import qualified Data.Text as Text
import qualified Data.Text.Encoding as TextEncoding
import OpcXmlDaClient.Base.Prelude hiding (Read)
import qualified OpcXmlDaClient.Base.Vector as VectorUtil
import qualified OpcXmlDaClient.Protocol.Namespaces as Ns
import OpcXmlDaClient.Protocol.Types
import qualified OpcXmlDaClient.XmlSchemaValues.Attoparsec as XmlSchemaValuesAttoparsec
import OpcXmlDaClient.XmlSchemaValues.Types
import qualified Text.XML as Xml
import XmlParser

-- * Responses

opcResponse :: Text -> Element a -> Element (Either SoapFault a)
opcResponse :: Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
opcElementName Element a
opcElementParser = do
  [(Maybe Text, Text)] -> Element ()
elementNameIsOneOf [(Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.soapEnv2, Text
"Envelope"), (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.soapEnv, Text
"Envelope")]
  ByName Element (Either SoapFault a) -> Element (Either SoapFault a)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Either SoapFault a)
 -> Element (Either SoapFault a))
-> ByName Element (Either SoapFault a)
-> Element (Either SoapFault a)
forall a b. (a -> b) -> a -> b
$ Text
-> Element (Either SoapFault a)
-> ByName Element (Either SoapFault a)
forall (parser :: * -> *) a. Text -> parser a -> ByName parser a
bySoapEnvName Text
"Body" (Element (Either SoapFault a)
 -> ByName Element (Either SoapFault a))
-> Element (Either SoapFault a)
-> ByName Element (Either SoapFault a)
forall a b. (a -> b) -> a -> b
$ ByName Element (Either SoapFault a) -> Element (Either SoapFault a)
forall a. ByName Element a -> Element a
childrenByName ByName Element (Either SoapFault a)
body
  where
    body :: ByName Element (Either SoapFault a)
body =
      SoapFault -> Either SoapFault a
forall a b. a -> Either a b
Left (SoapFault -> Either SoapFault a)
-> ByName Element SoapFault -> ByName Element (Either SoapFault a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByName Element SoapFault
soapFault ByName Element (Either SoapFault a)
-> ByName Element (Either SoapFault a)
-> ByName Element (Either SoapFault a)
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> Either SoapFault a
forall a b. b -> Either a b
Right (a -> Either SoapFault a)
-> ByName Element a -> ByName Element (Either SoapFault a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ByName Element a
opcContent
      where
        soapFault :: ByName Element SoapFault
soapFault = Text -> Element SoapFault -> ByName Element SoapFault
forall (parser :: * -> *) a. Text -> parser a -> ByName parser a
bySoapEnvName Text
"Fault" (Element SoapFault -> ByName Element SoapFault)
-> Element SoapFault -> ByName Element SoapFault
forall a b. (a -> b) -> a -> b
$ ByName Element SoapFault -> Element SoapFault
forall a. ByName Element a -> Element a
childrenByName (ByName Element SoapFault -> Element SoapFault)
-> ByName Element SoapFault -> Element SoapFault
forall a b. (a -> b) -> a -> b
$ ByName Element SoapFault
soapV1P2 ByName Element SoapFault
-> ByName Element SoapFault -> ByName Element SoapFault
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> ByName Element SoapFault
soapV1P1
          where
            soapV1P2 :: ByName Element SoapFault
soapV1P2 = do
              SoapFaultCode
_code <- Text -> Element SoapFaultCode -> ByName Element SoapFaultCode
forall (parser :: * -> *) a. Text -> parser a -> ByName parser a
bySoapEnvName Text
"Code" (Element SoapFaultCode -> ByName Element SoapFaultCode)
-> Element SoapFaultCode -> ByName Element SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                ByName Element SoapFaultCode -> Element SoapFaultCode
forall a. ByName Element a -> Element a
childrenByName (ByName Element SoapFaultCode -> Element SoapFaultCode)
-> ByName Element SoapFaultCode -> Element SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                  Text -> Element SoapFaultCode -> ByName Element SoapFaultCode
forall (parser :: * -> *) a. Text -> parser a -> ByName parser a
bySoapEnvName Text
"Value" (Element SoapFaultCode -> ByName Element SoapFaultCode)
-> Element SoapFaultCode -> ByName Element SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                    Nodes SoapFaultCode -> Element SoapFaultCode
forall a. Nodes a -> Element a
children (Nodes SoapFaultCode -> Element SoapFaultCode)
-> Nodes SoapFaultCode -> Element SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                      Content SoapFaultCode -> Nodes SoapFaultCode
forall content. Content content -> Nodes content
contentNode (Content SoapFaultCode -> Nodes SoapFaultCode)
-> Content SoapFaultCode -> Nodes SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                        do
                          QName
qName <- Content QName
adaptedQNameContent
                          case QName
qName of
                            NamespacedQName Text
ns Text
name ->
                              if Text
ns Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
Ns.soapEnv
                                then (StdSoapFaultCode -> SoapFaultCode)
-> Content StdSoapFaultCode -> Content SoapFaultCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StdSoapFaultCode -> SoapFaultCode
StdSoapFaultCode (Content StdSoapFaultCode -> Content SoapFaultCode)
-> Content StdSoapFaultCode -> Content SoapFaultCode
forall a b. (a -> b) -> a -> b
$ case Text
name of
                                  Text
"VersionMismatch" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "versionMismatch" StdSoapFaultCode
StdSoapFaultCode
#versionMismatch
                                  Text
"MustUnderstand" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "mustUnderstand" StdSoapFaultCode
StdSoapFaultCode
#mustUnderstand
                                  Text
"DataEncodingUnknown" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "dataEncodingUnknown" StdSoapFaultCode
StdSoapFaultCode
#dataEncodingUnknown
                                  Text
"Sender" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "sender" StdSoapFaultCode
StdSoapFaultCode
#sender
                                  Text
"Receiver" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "receiver" StdSoapFaultCode
StdSoapFaultCode
#receiver
                                  Text
_ -> String -> Content StdSoapFaultCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected code: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name)
                                else SoapFaultCode -> Content SoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (SoapFaultCode -> Content SoapFaultCode)
-> SoapFaultCode -> Content SoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "custom" (QName -> SoapFaultCode)
QName -> SoapFaultCode
#custom (QName -> SoapFaultCode) -> QName -> SoapFaultCode
forall a b. (a -> b) -> a -> b
$ Text -> Text -> QName
NamespacedQName Text
ns Text
name
                            QName
_ -> SoapFaultCode -> Content SoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (SoapFaultCode -> Content SoapFaultCode)
-> SoapFaultCode -> Content SoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "custom" (QName -> SoapFaultCode)
QName -> SoapFaultCode
#custom (QName -> SoapFaultCode) -> QName -> SoapFaultCode
forall a b. (a -> b) -> a -> b
$ QName
qName
              -- FIXME: We take the first reason here,
              -- but the result really can be a map indexed by language
              Text
_reason <- ByName Element Text -> ByName Element Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
orEmpty (ByName Element Text -> ByName Element Text)
-> ByName Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a. Text -> parser a -> ByName parser a
bySoapEnvName Text
"Reason" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ ByName Element Text -> Element Text
forall a. ByName Element a -> Element a
childrenByName (ByName Element Text -> Element Text)
-> ByName Element Text -> Element Text
forall a b. (a -> b) -> a -> b
$ ByName Element Text -> ByName Element Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
orEmpty (ByName Element Text -> ByName Element Text)
-> ByName Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a. Text -> parser a -> ByName parser a
bySoapEnvName Text
"Text" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
              return $ SoapFaultCode -> Text -> SoapFault
SoapFault SoapFaultCode
_code Text
_reason
            soapV1P1 :: ByName Element SoapFault
soapV1P1 = do
              SoapFaultCode
_code <- Maybe Text
-> Text -> Element SoapFaultCode -> ByName Element SoapFaultCode
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"faultcode" (Element SoapFaultCode -> ByName Element SoapFaultCode)
-> Element SoapFaultCode -> ByName Element SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                Nodes SoapFaultCode -> Element SoapFaultCode
forall a. Nodes a -> Element a
children (Nodes SoapFaultCode -> Element SoapFaultCode)
-> Nodes SoapFaultCode -> Element SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                  Content SoapFaultCode -> Nodes SoapFaultCode
forall content. Content content -> Nodes content
contentNode (Content SoapFaultCode -> Nodes SoapFaultCode)
-> Content SoapFaultCode -> Nodes SoapFaultCode
forall a b. (a -> b) -> a -> b
$
                    do
                      QName
qName <- Content QName
adaptedQNameContent
                      case QName
qName of
                        NamespacedQName Text
ns Text
name ->
                          if Text
ns Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
Ns.soapEnv2
                            then (StdSoapFaultCode -> SoapFaultCode)
-> Content StdSoapFaultCode -> Content SoapFaultCode
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap StdSoapFaultCode -> SoapFaultCode
StdSoapFaultCode (Content StdSoapFaultCode -> Content SoapFaultCode)
-> Content StdSoapFaultCode -> Content SoapFaultCode
forall a b. (a -> b) -> a -> b
$ case Text
name of
                              Text
"VersionMismatch" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "versionMismatch" StdSoapFaultCode
StdSoapFaultCode
#versionMismatch
                              Text
"MustUnderstand" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "mustUnderstand" StdSoapFaultCode
StdSoapFaultCode
#mustUnderstand
                              Text
"Client" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "sender" StdSoapFaultCode
StdSoapFaultCode
#sender
                              Text
"Server" -> StdSoapFaultCode -> Content StdSoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (StdSoapFaultCode -> Content StdSoapFaultCode)
-> StdSoapFaultCode -> Content StdSoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "receiver" StdSoapFaultCode
StdSoapFaultCode
#receiver
                              Text
_ -> String -> Content StdSoapFaultCode
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String
"Unexpected code: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
name)
                            else SoapFaultCode -> Content SoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (SoapFaultCode -> Content SoapFaultCode)
-> SoapFaultCode -> Content SoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "custom" (QName -> SoapFaultCode)
QName -> SoapFaultCode
#custom (QName -> SoapFaultCode) -> QName -> SoapFaultCode
forall a b. (a -> b) -> a -> b
$ Text -> Text -> QName
NamespacedQName Text
ns Text
name
                        QName
_ -> SoapFaultCode -> Content SoapFaultCode
forall (m :: * -> *) a. Monad m => a -> m a
return (SoapFaultCode -> Content SoapFaultCode)
-> SoapFaultCode -> Content SoapFaultCode
forall a b. (a -> b) -> a -> b
$ IsLabel "custom" (QName -> SoapFaultCode)
QName -> SoapFaultCode
#custom (QName -> SoapFaultCode) -> QName -> SoapFaultCode
forall a b. (a -> b) -> a -> b
$ QName
qName
              -- FIXME: We take the first reason here,
              -- but the result really can be a map indexed by language
              Text
_reason <- ByName Element Text -> ByName Element Text
forall (f :: * -> *) a. (Alternative f, Monoid a) => f a -> f a
orEmpty (ByName Element Text -> ByName Element Text)
-> ByName Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"faultstring" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ (Text -> Text) -> Content Text -> Content Text
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Text -> Text
Text.strip (Content Text -> Content Text) -> Content Text -> Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
              return $ SoapFaultCode -> Text -> SoapFault
SoapFault SoapFaultCode
_code Text
_reason
            orEmpty :: f a -> f a
orEmpty f a
_p = f a
_p f a -> f a -> f a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> a -> f a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
forall a. Monoid a => a
mempty
        opcContent :: ByName Element a
opcContent =
          Maybe Text -> Text -> Element a -> ByName Element a
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
opcElementName Element a
opcElementParser

getStatusResponse :: Element (Either SoapFault GetStatusResponse)
getStatusResponse :: Element (Either SoapFault GetStatusResponse)
getStatusResponse =
  Text
-> Element GetStatusResponse
-> Element (Either SoapFault GetStatusResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"GetStatusResponse" (Element GetStatusResponse
 -> Element (Either SoapFault GetStatusResponse))
-> Element GetStatusResponse
-> Element (Either SoapFault GetStatusResponse)
forall a b. (a -> b) -> a -> b
$
    ByName Element GetStatusResponse -> Element GetStatusResponse
forall a. ByName Element a -> Element a
childrenByName (ByName Element GetStatusResponse -> Element GetStatusResponse)
-> ByName Element GetStatusResponse -> Element GetStatusResponse
forall a b. (a -> b) -> a -> b
$ do
      Maybe ReplyBase
_getStatusResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"GetStatusResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
      Maybe ServerStatus
_status <- ByName Element ServerStatus -> ByName Element (Maybe ServerStatus)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ServerStatus
 -> ByName Element (Maybe ServerStatus))
-> ByName Element ServerStatus
-> ByName Element (Maybe ServerStatus)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element ServerStatus -> ByName Element ServerStatus
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Status" (Element ServerStatus -> ByName Element ServerStatus)
-> Element ServerStatus -> ByName Element ServerStatus
forall a b. (a -> b) -> a -> b
$ Element ServerStatus
serverStatus
      return $ Maybe ReplyBase -> Maybe ServerStatus -> GetStatusResponse
GetStatusResponse Maybe ReplyBase
_getStatusResult Maybe ServerStatus
_status

readResponse :: Element (Either SoapFault ReadResponse)
readResponse :: Element (Either SoapFault ReadResponse)
readResponse =
  Text
-> Element ReadResponse -> Element (Either SoapFault ReadResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"ReadResponse" (Element ReadResponse -> Element (Either SoapFault ReadResponse))
-> Element ReadResponse -> Element (Either SoapFault ReadResponse)
forall a b. (a -> b) -> a -> b
$
    ByName Element ReadResponse -> Element ReadResponse
forall a. ByName Element a -> Element a
childrenByName (ByName Element ReadResponse -> Element ReadResponse)
-> ByName Element ReadResponse -> Element ReadResponse
forall a b. (a -> b) -> a -> b
$ do
      Maybe ReplyBase
_readResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"ReadResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
      Maybe ReplyItemList
_rItemList <- ByName Element ReplyItemList
-> ByName Element (Maybe ReplyItemList)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyItemList
 -> ByName Element (Maybe ReplyItemList))
-> ByName Element ReplyItemList
-> ByName Element (Maybe ReplyItemList)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element ReplyItemList -> ByName Element ReplyItemList
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"RItemList" (Element ReplyItemList -> ByName Element ReplyItemList)
-> Element ReplyItemList -> ByName Element ReplyItemList
forall a b. (a -> b) -> a -> b
$ Element ReplyItemList
replyItemList
      Vector OpcError
_errors <- ByName Element OpcError -> ByName Element (Vector OpcError)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element OpcError -> ByName Element (Vector OpcError))
-> ByName Element OpcError -> ByName Element (Vector OpcError)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element OpcError -> ByName Element OpcError
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Errors" (Element OpcError -> ByName Element OpcError)
-> Element OpcError -> ByName Element OpcError
forall a b. (a -> b) -> a -> b
$ Element OpcError
opcError
      return $ Maybe ReplyBase
-> Maybe ReplyItemList -> Vector OpcError -> ReadResponse
ReadResponse Maybe ReplyBase
_readResult Maybe ReplyItemList
_rItemList Vector OpcError
_errors

writeResponse :: Element (Either SoapFault WriteResponse)
writeResponse :: Element (Either SoapFault WriteResponse)
writeResponse =
  Text
-> Element WriteResponse
-> Element (Either SoapFault WriteResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"WriteResponse" (Element WriteResponse -> Element (Either SoapFault WriteResponse))
-> Element WriteResponse
-> Element (Either SoapFault WriteResponse)
forall a b. (a -> b) -> a -> b
$
    ByName Element WriteResponse -> Element WriteResponse
forall a. ByName Element a -> Element a
childrenByName (ByName Element WriteResponse -> Element WriteResponse)
-> ByName Element WriteResponse -> Element WriteResponse
forall a b. (a -> b) -> a -> b
$ do
      Maybe ReplyBase
_writeResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"WriteResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
      Maybe ReplyItemList
_rItemList <- ByName Element ReplyItemList
-> ByName Element (Maybe ReplyItemList)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyItemList
 -> ByName Element (Maybe ReplyItemList))
-> ByName Element ReplyItemList
-> ByName Element (Maybe ReplyItemList)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element ReplyItemList -> ByName Element ReplyItemList
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"RItemList" (Element ReplyItemList -> ByName Element ReplyItemList)
-> Element ReplyItemList -> ByName Element ReplyItemList
forall a b. (a -> b) -> a -> b
$ Element ReplyItemList
replyItemList
      Vector OpcError
_errors <- ByName Element OpcError -> ByName Element (Vector OpcError)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element OpcError -> ByName Element (Vector OpcError))
-> ByName Element OpcError -> ByName Element (Vector OpcError)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element OpcError -> ByName Element OpcError
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Errors" (Element OpcError -> ByName Element OpcError)
-> Element OpcError -> ByName Element OpcError
forall a b. (a -> b) -> a -> b
$ Element OpcError
opcError
      return $ Maybe ReplyBase
-> Maybe ReplyItemList -> Vector OpcError -> WriteResponse
WriteResponse Maybe ReplyBase
_writeResult Maybe ReplyItemList
_rItemList Vector OpcError
_errors

subscribeResponse :: Element (Either SoapFault SubscribeResponse)
subscribeResponse :: Element (Either SoapFault SubscribeResponse)
subscribeResponse =
  Text
-> Element SubscribeResponse
-> Element (Either SoapFault SubscribeResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"SubscribeResponse" (Element SubscribeResponse
 -> Element (Either SoapFault SubscribeResponse))
-> Element SubscribeResponse
-> Element (Either SoapFault SubscribeResponse)
forall a b. (a -> b) -> a -> b
$
    Element (Element SubscribeResponse) -> Element SubscribeResponse
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element SubscribeResponse) -> Element SubscribeResponse)
-> Element (Element SubscribeResponse) -> Element SubscribeResponse
forall a b. (a -> b) -> a -> b
$
      ByName Content (Element SubscribeResponse)
-> Element (Element SubscribeResponse)
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element SubscribeResponse)
 -> Element (Element SubscribeResponse))
-> ByName Content (Element SubscribeResponse)
-> Element (Element SubscribeResponse)
forall a b. (a -> b) -> a -> b
$ do
        Maybe Text
_subHandle <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ServerSubHandle" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
        return $
          ByName Element SubscribeResponse -> Element SubscribeResponse
forall a. ByName Element a -> Element a
childrenByName (ByName Element SubscribeResponse -> Element SubscribeResponse)
-> ByName Element SubscribeResponse -> Element SubscribeResponse
forall a b. (a -> b) -> a -> b
$ do
            Maybe ReplyBase
_subscribeResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"SubscribeResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
            Maybe SubscribeReplyItemList
_rItemList <- ByName Element SubscribeReplyItemList
-> ByName Element (Maybe SubscribeReplyItemList)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element SubscribeReplyItemList
 -> ByName Element (Maybe SubscribeReplyItemList))
-> ByName Element SubscribeReplyItemList
-> ByName Element (Maybe SubscribeReplyItemList)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text
-> Element SubscribeReplyItemList
-> ByName Element SubscribeReplyItemList
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"RItemList" (Element SubscribeReplyItemList
 -> ByName Element SubscribeReplyItemList)
-> Element SubscribeReplyItemList
-> ByName Element SubscribeReplyItemList
forall a b. (a -> b) -> a -> b
$ Element SubscribeReplyItemList
subscribeReplyItemList
            Vector OpcError
_errors <- ByName Element OpcError -> ByName Element (Vector OpcError)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element OpcError -> ByName Element (Vector OpcError))
-> ByName Element OpcError -> ByName Element (Vector OpcError)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element OpcError -> ByName Element OpcError
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"OPCError" (Element OpcError -> ByName Element OpcError)
-> Element OpcError -> ByName Element OpcError
forall a b. (a -> b) -> a -> b
$ Element OpcError
opcError
            return $ Maybe ReplyBase
-> Maybe SubscribeReplyItemList
-> Vector OpcError
-> Maybe Text
-> SubscribeResponse
SubscribeResponse Maybe ReplyBase
_subscribeResult Maybe SubscribeReplyItemList
_rItemList Vector OpcError
_errors Maybe Text
_subHandle

subscriptionPolledRefreshResponse :: Element (Either SoapFault SubscriptionPolledRefreshResponse)
subscriptionPolledRefreshResponse :: Element (Either SoapFault SubscriptionPolledRefreshResponse)
subscriptionPolledRefreshResponse =
  Text
-> Element SubscriptionPolledRefreshResponse
-> Element (Either SoapFault SubscriptionPolledRefreshResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"SubscriptionPolledRefreshResponse" (Element SubscriptionPolledRefreshResponse
 -> Element (Either SoapFault SubscriptionPolledRefreshResponse))
-> Element SubscriptionPolledRefreshResponse
-> Element (Either SoapFault SubscriptionPolledRefreshResponse)
forall a b. (a -> b) -> a -> b
$
    Element (Element SubscriptionPolledRefreshResponse)
-> Element SubscriptionPolledRefreshResponse
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element SubscriptionPolledRefreshResponse)
 -> Element SubscriptionPolledRefreshResponse)
-> Element (Element SubscriptionPolledRefreshResponse)
-> Element SubscriptionPolledRefreshResponse
forall a b. (a -> b) -> a -> b
$
      ByName Element (Element SubscriptionPolledRefreshResponse)
-> Element (Element SubscriptionPolledRefreshResponse)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element SubscriptionPolledRefreshResponse)
 -> Element (Element SubscriptionPolledRefreshResponse))
-> ByName Element (Element SubscriptionPolledRefreshResponse)
-> Element (Element SubscriptionPolledRefreshResponse)
forall a b. (a -> b) -> a -> b
$ do
        Maybe ReplyBase
_subscriptionPolledRefreshResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"SubscriptionPolledRefreshResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
        Vector Text
_invalidServerSubHandles <- ByName Element Text -> ByName Element (Vector Text)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element Text -> ByName Element (Vector Text))
-> ByName Element Text -> ByName Element (Vector Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"InvalidServerSubHandles" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
        Vector SubscribePolledRefreshReplyItemList
_rItemList <- ByName Element SubscribePolledRefreshReplyItemList
-> ByName Element (Vector SubscribePolledRefreshReplyItemList)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element SubscribePolledRefreshReplyItemList
 -> ByName Element (Vector SubscribePolledRefreshReplyItemList))
-> ByName Element SubscribePolledRefreshReplyItemList
-> ByName Element (Vector SubscribePolledRefreshReplyItemList)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text
-> Element SubscribePolledRefreshReplyItemList
-> ByName Element SubscribePolledRefreshReplyItemList
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"RItemList" (Element SubscribePolledRefreshReplyItemList
 -> ByName Element SubscribePolledRefreshReplyItemList)
-> Element SubscribePolledRefreshReplyItemList
-> ByName Element SubscribePolledRefreshReplyItemList
forall a b. (a -> b) -> a -> b
$ Element SubscribePolledRefreshReplyItemList
subscribePolledRefreshReplyItemList
        Vector OpcError
_errors <- ByName Element OpcError -> ByName Element (Vector OpcError)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element OpcError -> ByName Element (Vector OpcError))
-> ByName Element OpcError -> ByName Element (Vector OpcError)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element OpcError -> ByName Element OpcError
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"OPCError" (Element OpcError -> ByName Element OpcError)
-> Element OpcError -> ByName Element OpcError
forall a b. (a -> b) -> a -> b
$ Element OpcError
opcError
        return $
          ByName Content SubscriptionPolledRefreshResponse
-> Element SubscriptionPolledRefreshResponse
forall a. ByName Content a -> Element a
attributesByName (ByName Content SubscriptionPolledRefreshResponse
 -> Element SubscriptionPolledRefreshResponse)
-> ByName Content SubscriptionPolledRefreshResponse
-> Element SubscriptionPolledRefreshResponse
forall a b. (a -> b) -> a -> b
$ do
            Bool
_dataBufferOverflow <- Maybe Text -> Text -> Content Bool -> ByName Content Bool
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"DataBufferOverflow" Content Bool
booleanContent ByName Content Bool -> ByName Content Bool -> ByName Content Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ByName Content Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            return $ Maybe ReplyBase
-> Vector Text
-> Vector SubscribePolledRefreshReplyItemList
-> Vector OpcError
-> Bool
-> SubscriptionPolledRefreshResponse
SubscriptionPolledRefreshResponse Maybe ReplyBase
_subscriptionPolledRefreshResult Vector Text
_invalidServerSubHandles Vector SubscribePolledRefreshReplyItemList
_rItemList Vector OpcError
_errors Bool
_dataBufferOverflow

subscriptionCancelResponse :: Element (Either SoapFault SubscriptionCancelResponse)
subscriptionCancelResponse :: Element (Either SoapFault SubscriptionCancelResponse)
subscriptionCancelResponse =
  Text
-> Element SubscriptionCancelResponse
-> Element (Either SoapFault SubscriptionCancelResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"SubscriptionCancelResponse" (Element SubscriptionCancelResponse
 -> Element (Either SoapFault SubscriptionCancelResponse))
-> Element SubscriptionCancelResponse
-> Element (Either SoapFault SubscriptionCancelResponse)
forall a b. (a -> b) -> a -> b
$
    ByName Element SubscriptionCancelResponse
-> Element SubscriptionCancelResponse
forall a. ByName Element a -> Element a
childrenByName (ByName Element SubscriptionCancelResponse
 -> Element SubscriptionCancelResponse)
-> ByName Element SubscriptionCancelResponse
-> Element SubscriptionCancelResponse
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text
_clientRequestHandle <- ByName Element Text -> ByName Element (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Text -> ByName Element (Maybe Text))
-> ByName Element Text -> ByName Element (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"ClientRequestHandle" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      return $ Maybe Text -> SubscriptionCancelResponse
SubscriptionCancelResponse Maybe Text
_clientRequestHandle

browseResponse :: Element (Either SoapFault BrowseResponse)
browseResponse :: Element (Either SoapFault BrowseResponse)
browseResponse =
  Text
-> Element BrowseResponse
-> Element (Either SoapFault BrowseResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"BrowseResponse" (Element BrowseResponse
 -> Element (Either SoapFault BrowseResponse))
-> Element BrowseResponse
-> Element (Either SoapFault BrowseResponse)
forall a b. (a -> b) -> a -> b
$
    Element (Element BrowseResponse) -> Element BrowseResponse
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element BrowseResponse) -> Element BrowseResponse)
-> Element (Element BrowseResponse) -> Element BrowseResponse
forall a b. (a -> b) -> a -> b
$
      ByName Element (Element BrowseResponse)
-> Element (Element BrowseResponse)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element BrowseResponse)
 -> Element (Element BrowseResponse))
-> ByName Element (Element BrowseResponse)
-> Element (Element BrowseResponse)
forall a b. (a -> b) -> a -> b
$ do
        Maybe ReplyBase
_browseResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"BrowseResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
        Vector BrowseElement
_elements <- ByName Element BrowseElement
-> ByName Element (Vector BrowseElement)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element BrowseElement
 -> ByName Element (Vector BrowseElement))
-> ByName Element BrowseElement
-> ByName Element (Vector BrowseElement)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element BrowseElement -> ByName Element BrowseElement
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Elements" (Element BrowseElement -> ByName Element BrowseElement)
-> Element BrowseElement -> ByName Element BrowseElement
forall a b. (a -> b) -> a -> b
$ Element BrowseElement
browseElement
        Vector OpcError
_errors <- ByName Element OpcError -> ByName Element (Vector OpcError)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element OpcError -> ByName Element (Vector OpcError))
-> ByName Element OpcError -> ByName Element (Vector OpcError)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element OpcError -> ByName Element OpcError
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Errors" (Element OpcError -> ByName Element OpcError)
-> Element OpcError -> ByName Element OpcError
forall a b. (a -> b) -> a -> b
$ Element OpcError
opcError
        return $
          ByName Content BrowseResponse -> Element BrowseResponse
forall a. ByName Content a -> Element a
attributesByName (ByName Content BrowseResponse -> Element BrowseResponse)
-> ByName Content BrowseResponse -> Element BrowseResponse
forall a b. (a -> b) -> a -> b
$ do
            Maybe Text
_continuationPoint <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ContinuationPoint" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
            Bool
_moreElements <- Maybe Text -> Text -> Content Bool -> ByName Content Bool
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"MoreElements" Content Bool
booleanContent ByName Content Bool -> ByName Content Bool -> ByName Content Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ByName Content Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            return $ Maybe ReplyBase
-> Vector BrowseElement
-> Vector OpcError
-> Maybe Text
-> Bool
-> BrowseResponse
BrowseResponse Maybe ReplyBase
_browseResult Vector BrowseElement
_elements Vector OpcError
_errors Maybe Text
_continuationPoint Bool
_moreElements

getPropertiesResponse :: Element (Either SoapFault GetPropertiesResponse)
getPropertiesResponse :: Element (Either SoapFault GetPropertiesResponse)
getPropertiesResponse =
  Text
-> Element GetPropertiesResponse
-> Element (Either SoapFault GetPropertiesResponse)
forall a. Text -> Element a -> Element (Either SoapFault a)
opcResponse Text
"GetPropertiesResponse" (Element GetPropertiesResponse
 -> Element (Either SoapFault GetPropertiesResponse))
-> Element GetPropertiesResponse
-> Element (Either SoapFault GetPropertiesResponse)
forall a b. (a -> b) -> a -> b
$
    ByName Element GetPropertiesResponse
-> Element GetPropertiesResponse
forall a. ByName Element a -> Element a
childrenByName (ByName Element GetPropertiesResponse
 -> Element GetPropertiesResponse)
-> ByName Element GetPropertiesResponse
-> Element GetPropertiesResponse
forall a b. (a -> b) -> a -> b
$ do
      Maybe ReplyBase
_getPropertiesResult <- ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element ReplyBase -> ByName Element (Maybe ReplyBase))
-> ByName Element ReplyBase -> ByName Element (Maybe ReplyBase)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ReplyBase -> ByName Element ReplyBase
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"GetPropertiesResult" (Element ReplyBase -> ByName Element ReplyBase)
-> Element ReplyBase -> ByName Element ReplyBase
forall a b. (a -> b) -> a -> b
$ Element ReplyBase
replyBase
      Vector PropertyReplyList
_propertiesList <- ByName Element PropertyReplyList
-> ByName Element (Vector PropertyReplyList)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element PropertyReplyList
 -> ByName Element (Vector PropertyReplyList))
-> ByName Element PropertyReplyList
-> ByName Element (Vector PropertyReplyList)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text
-> Element PropertyReplyList
-> ByName Element PropertyReplyList
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"PropertyLists" (Element PropertyReplyList -> ByName Element PropertyReplyList)
-> Element PropertyReplyList -> ByName Element PropertyReplyList
forall a b. (a -> b) -> a -> b
$ Element PropertyReplyList
propertyReplyList
      Vector OpcError
_errors <- ByName Element OpcError -> ByName Element (Vector OpcError)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element OpcError -> ByName Element (Vector OpcError))
-> ByName Element OpcError -> ByName Element (Vector OpcError)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element OpcError -> ByName Element OpcError
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Errors" (Element OpcError -> ByName Element OpcError)
-> Element OpcError -> ByName Element OpcError
forall a b. (a -> b) -> a -> b
$ Element OpcError
opcError
      return $ Maybe ReplyBase
-> Vector PropertyReplyList
-> Vector OpcError
-> GetPropertiesResponse
GetPropertiesResponse Maybe ReplyBase
_getPropertiesResult Vector PropertyReplyList
_propertiesList Vector OpcError
_errors

-- * Details

replyBase :: Element ReplyBase
replyBase :: Element ReplyBase
replyBase =
  ByName Content ReplyBase -> Element ReplyBase
forall a. ByName Content a -> Element a
attributesByName (ByName Content ReplyBase -> Element ReplyBase)
-> ByName Content ReplyBase -> Element ReplyBase
forall a b. (a -> b) -> a -> b
$ do
    UTCTime
_rcvTime <- Maybe Text -> Text -> Content UTCTime -> ByName Content UTCTime
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"RcvTime" Content UTCTime
dateTimeContent
    UTCTime
_replyTime <- Maybe Text -> Text -> Content UTCTime -> ByName Content UTCTime
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ReplyTime" Content UTCTime
dateTimeContent
    Maybe Text
_clientRequestHandle <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ClientRequestHandle" Content Text
textContent
    Maybe Text
_revisedLocaleID <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"RevisedLocaleID" Content Text
textContent
    ServerState
_serverState <- Maybe Text
-> Text -> Content ServerState -> ByName Content ServerState
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ServerState" Content ServerState
serverStateContent
    return $ UTCTime
-> UTCTime -> Maybe Text -> Maybe Text -> ServerState -> ReplyBase
ReplyBase UTCTime
_rcvTime UTCTime
_replyTime Maybe Text
_clientRequestHandle Maybe Text
_revisedLocaleID ServerState
_serverState

subscribeReplyItemList :: Element SubscribeReplyItemList
subscribeReplyItemList :: Element SubscribeReplyItemList
subscribeReplyItemList =
  Element (Element SubscribeReplyItemList)
-> Element SubscribeReplyItemList
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element SubscribeReplyItemList)
 -> Element SubscribeReplyItemList)
-> Element (Element SubscribeReplyItemList)
-> Element SubscribeReplyItemList
forall a b. (a -> b) -> a -> b
$
    ByName Content (Element SubscribeReplyItemList)
-> Element (Element SubscribeReplyItemList)
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element SubscribeReplyItemList)
 -> Element (Element SubscribeReplyItemList))
-> ByName Content (Element SubscribeReplyItemList)
-> Element (Element SubscribeReplyItemList)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Int32
_revisedSamplingRate <- ByName Content Int32 -> ByName Content (Maybe Int32)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Int32 -> ByName Content (Maybe Int32))
-> ByName Content Int32 -> ByName Content (Maybe Int32)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Int32 -> ByName Content Int32
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"RevisedSamplingRate" (Content Int32 -> ByName Content Int32)
-> Content Int32 -> ByName Content Int32
forall a b. (a -> b) -> a -> b
$ Parser Int32 -> Content Int32
forall a. Parser a -> Content a
attoparsedContent Parser Int32
forall a. Integral a => Parser a
Atto.decimal
      return $ do
        Vector SubscribeItemValue
_items <- ByName Element (Vector SubscribeItemValue)
-> Element (Vector SubscribeItemValue)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Vector SubscribeItemValue)
 -> Element (Vector SubscribeItemValue))
-> ByName Element (Vector SubscribeItemValue)
-> Element (Vector SubscribeItemValue)
forall a b. (a -> b) -> a -> b
$ ByName Element SubscribeItemValue
-> ByName Element (Vector SubscribeItemValue)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element SubscribeItemValue
 -> ByName Element (Vector SubscribeItemValue))
-> ByName Element SubscribeItemValue
-> ByName Element (Vector SubscribeItemValue)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text
-> Element SubscribeItemValue
-> ByName Element SubscribeItemValue
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Items" (Element SubscribeItemValue -> ByName Element SubscribeItemValue)
-> Element SubscribeItemValue -> ByName Element SubscribeItemValue
forall a b. (a -> b) -> a -> b
$ Element SubscribeItemValue
subscribeItemValue
        return (Vector SubscribeItemValue -> Maybe Int32 -> SubscribeReplyItemList
SubscribeReplyItemList Vector SubscribeItemValue
_items Maybe Int32
_revisedSamplingRate)

subscribeItemValue :: Element SubscribeItemValue
subscribeItemValue :: Element SubscribeItemValue
subscribeItemValue =
  Element (Element SubscribeItemValue) -> Element SubscribeItemValue
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element SubscribeItemValue)
 -> Element SubscribeItemValue)
-> Element (Element SubscribeItemValue)
-> Element SubscribeItemValue
forall a b. (a -> b) -> a -> b
$
    ByName Content (Element SubscribeItemValue)
-> Element (Element SubscribeItemValue)
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element SubscribeItemValue)
 -> Element (Element SubscribeItemValue))
-> ByName Content (Element SubscribeItemValue)
-> Element (Element SubscribeItemValue)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Int
_revisedSamplingRate <- ByName Content Int -> ByName Content (Maybe Int)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Int -> ByName Content (Maybe Int))
-> ByName Content Int -> ByName Content (Maybe Int)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Int -> ByName Content Int
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"RevisedSamplingRate" (Content Int -> ByName Content Int)
-> Content Int -> ByName Content Int
forall a b. (a -> b) -> a -> b
$ Parser Int -> Content Int
forall a. Parser a -> Content a
attoparsedContent Parser Int
forall a. Integral a => Parser a
Atto.decimal
      return $ do
        ItemValue
_itemValue <- ByName Element ItemValue -> Element ItemValue
forall a. ByName Element a -> Element a
childrenByName (ByName Element ItemValue -> Element ItemValue)
-> ByName Element ItemValue -> Element ItemValue
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ItemValue -> ByName Element ItemValue
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"ItemValue" (Element ItemValue -> ByName Element ItemValue)
-> Element ItemValue -> ByName Element ItemValue
forall a b. (a -> b) -> a -> b
$ Element ItemValue
itemValue
        return (ItemValue -> Maybe Int -> SubscribeItemValue
SubscribeItemValue ItemValue
_itemValue Maybe Int
_revisedSamplingRate)

opcError :: Element OpcError
opcError :: Element OpcError
opcError =
  Element (Element OpcError) -> Element OpcError
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element OpcError) -> Element OpcError)
-> Element (Element OpcError) -> Element OpcError
forall a b. (a -> b) -> a -> b
$
    ByName Content (Element OpcError) -> Element (Element OpcError)
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element OpcError) -> Element (Element OpcError))
-> ByName Content (Element OpcError) -> Element (Element OpcError)
forall a b. (a -> b) -> a -> b
$ do
      QName
_id <- Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ID" (Content QName -> ByName Content QName)
-> Content QName -> ByName Content QName
forall a b. (a -> b) -> a -> b
$ Content QName
adaptedQNameContent
      return $
        ByName Element OpcError -> Element OpcError
forall a. ByName Element a -> Element a
childrenByName (ByName Element OpcError -> Element OpcError)
-> ByName Element OpcError -> Element OpcError
forall a b. (a -> b) -> a -> b
$ do
          Maybe Text
_text <- ByName Element Text -> ByName Element (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Text -> ByName Element (Maybe Text))
-> ByName Element Text -> ByName Element (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Text" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          return $ Maybe Text -> QName -> OpcError
OpcError Maybe Text
_text QName
_id

itemValue :: Element ItemValue
itemValue :: Element ItemValue
itemValue =
  Element (Element ItemValue) -> Element ItemValue
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element ItemValue) -> Element ItemValue)
-> Element (Element ItemValue) -> Element ItemValue
forall a b. (a -> b) -> a -> b
$
    ByName Content (Element ItemValue) -> Element (Element ItemValue)
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element ItemValue) -> Element (Element ItemValue))
-> ByName Content (Element ItemValue)
-> Element (Element ItemValue)
forall a b. (a -> b) -> a -> b
$ do
      Maybe QName
_valueTypeQualifier <- ByName Content QName -> ByName Content (Maybe QName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content QName -> ByName Content (Maybe QName))
-> ByName Content QName -> ByName Content (Maybe QName)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ValueTypeQualifier" (Content QName -> ByName Content QName)
-> Content QName -> ByName Content QName
forall a b. (a -> b) -> a -> b
$ Content QName
adaptedQNameContent
      Maybe Text
_itemPath <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemPath" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      Maybe Text
_itemName <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemName" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      Maybe Text
_clientItemHandle <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ClientItemHandle" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      Maybe UTCTime
_timestamp <- ByName Content UTCTime -> ByName Content (Maybe UTCTime)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content UTCTime -> ByName Content (Maybe UTCTime))
-> ByName Content UTCTime -> ByName Content (Maybe UTCTime)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content UTCTime -> ByName Content UTCTime
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"Timestamp" (Content UTCTime -> ByName Content UTCTime)
-> Content UTCTime -> ByName Content UTCTime
forall a b. (a -> b) -> a -> b
$ Content UTCTime
dateTimeContent
      Maybe QName
_resultId <- ByName Content QName -> ByName Content (Maybe QName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content QName -> ByName Content (Maybe QName))
-> ByName Content QName -> ByName Content (Maybe QName)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ResultID" (Content QName -> ByName Content QName)
-> Content QName -> ByName Content QName
forall a b. (a -> b) -> a -> b
$ Content QName
adaptedQNameContent
      return $ do
        ByName Element ItemValue -> Element ItemValue
forall a. ByName Element a -> Element a
childrenByName (ByName Element ItemValue -> Element ItemValue)
-> ByName Element ItemValue -> Element ItemValue
forall a b. (a -> b) -> a -> b
$ do
          Maybe Text
_diagnosticInfo <- ByName Element Text -> ByName Element (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Text -> ByName Element (Maybe Text))
-> ByName Element Text -> ByName Element (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"DiagnosticInfo" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          Maybe Value
_value <- ByName Element Value -> ByName Element (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Value -> ByName Element (Maybe Value))
-> ByName Element Value -> ByName Element (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Value -> ByName Element Value
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Value" (Element Value -> ByName Element Value)
-> Element Value -> ByName Element Value
forall a b. (a -> b) -> a -> b
$ Element Value
value
          Maybe OpcQuality
_opcQuality <- ByName Element OpcQuality -> ByName Element (Maybe OpcQuality)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element OpcQuality -> ByName Element (Maybe OpcQuality))
-> ByName Element OpcQuality -> ByName Element (Maybe OpcQuality)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element OpcQuality -> ByName Element OpcQuality
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Quality" (Element OpcQuality -> ByName Element OpcQuality)
-> Element OpcQuality -> ByName Element OpcQuality
forall a b. (a -> b) -> a -> b
$ Element OpcQuality
opcQuality
          return (Maybe Text
-> Maybe Value
-> Maybe OpcQuality
-> Maybe QName
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe UTCTime
-> Maybe QName
-> ItemValue
ItemValue Maybe Text
_diagnosticInfo Maybe Value
_value Maybe OpcQuality
_opcQuality Maybe QName
_valueTypeQualifier Maybe Text
_itemPath Maybe Text
_itemName Maybe Text
_clientItemHandle Maybe UTCTime
_timestamp Maybe QName
_resultId)

value :: Element Value
value :: Element Value
value = do
  Element (Element Value) -> Element Value
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element Value) -> Element Value)
-> Element (Element Value) -> Element Value
forall a b. (a -> b) -> a -> b
$
    ByName Content (Element Value) -> Element (Element Value)
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element Value) -> Element (Element Value))
-> ByName Content (Element Value) -> Element (Element Value)
forall a b. (a -> b) -> a -> b
$
      Maybe Text
-> Text
-> Content (Element Value)
-> ByName Content (Element Value)
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.xsi) Text
"type" (Content (Element Value) -> ByName Content (Element Value))
-> Content (Element Value) -> ByName Content (Element Value)
forall a b. (a -> b) -> a -> b
$ do
        (Maybe Text
_typeNs, Text
_typeName) <- Content (Maybe Text, Text)
qNameContent
        case Maybe Text
_typeNs of
          Just Text
_typeNs ->
            if Text
_typeNs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
Ns.xsd
              then case Text
_typeName of
                Text
"string" -> (Text -> Value) -> Content Text -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "string" (Text -> Value)
Text -> Value
#string Content Text
stringContent
                Text
"boolean" -> (Bool -> Value) -> Content Bool -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "boolean" (Bool -> Value)
Bool -> Value
#boolean Content Bool
booleanContent
                Text
"float" -> (Float -> Value) -> Content Float -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "float" (Float -> Value)
Float -> Value
#float Content Float
floatContent
                Text
"double" -> (Double -> Value) -> Content Double -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "double" (Double -> Value)
Double -> Value
#double Content Double
doubleContent
                Text
"decimal" -> (Scientific -> Value)
-> Content Scientific -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "decimal" (Scientific -> Value)
Scientific -> Value
#decimal Content Scientific
decimalContent
                Text
"long" -> (Int64 -> Value) -> Content Int64 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "long" (Int64 -> Value)
Int64 -> Value
#long Content Int64
longContent
                Text
"int" -> (Int32 -> Value) -> Content Int32 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "int" (Int32 -> Value)
Int32 -> Value
#int Content Int32
intContent
                Text
"short" -> (Int16 -> Value) -> Content Int16 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "short" (Int16 -> Value)
Int16 -> Value
#short Content Int16
shortContent
                Text
"byte" -> (Int8 -> Value) -> Content Int8 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "byte" (Int8 -> Value)
Int8 -> Value
#byte Content Int8
byteContent
                Text
"unsignedLong" -> (Word64 -> Value) -> Content Word64 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "unsignedLong" (Word64 -> Value)
Word64 -> Value
#unsignedLong Content Word64
unsignedLongContent
                Text
"unsignedInt" -> (Word32 -> Value) -> Content Word32 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "unsignedInt" (Word32 -> Value)
Word32 -> Value
#unsignedInt Content Word32
unsignedIntContent
                Text
"unsignedShort" -> (Word16 -> Value) -> Content Word16 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "unsignedShort" (Word16 -> Value)
Word16 -> Value
#unsignedShort Content Word16
unsignedShortContent
                Text
"unsignedByte" -> (Word8 -> Value) -> Content Word8 -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "unsignedByte" (Word8 -> Value)
Word8 -> Value
#unsignedByte Content Word8
unsignedByteContent
                Text
"base64Binary" -> (ByteString -> Value)
-> Content ByteString -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "base64Binary" (ByteString -> Value)
ByteString -> Value
#base64Binary Content ByteString
base64BinaryContent
                Text
"dateTime" -> (UTCTime -> Value) -> Content UTCTime -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "dateTime" (UTCTime -> Value)
UTCTime -> Value
#dateTime Content UTCTime
dateTimeContent
                Text
"time" -> (Time -> Value) -> Content Time -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "time" (Time -> Value)
Time -> Value
#time Content Time
timeContent
                Text
"date" -> (Date -> Value) -> Content Date -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "date" (Date -> Value)
Date -> Value
#date Content Date
dateContent
                Text
"duration" -> (Duration -> Value) -> Content Duration -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "duration" (Duration -> Value)
Duration -> Value
#duration Content Duration
durationContent
                Text
"QName" -> (QName -> Value) -> Content QName -> Content (Element Value)
forall (m :: * -> *) a b.
Monad m =>
(a -> b) -> Content a -> m (Element b)
primitive IsLabel "qName" (QName -> Value)
QName -> Value
#qName Content QName
adaptedQNameContent
                Text
_ -> String -> Content (Element Value)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Content (Element Value))
-> String -> Content (Element Value)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected XSD type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
_typeName
              else
                if Text
_typeNs Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
Ns.opc
                  then case Text
_typeName of
                    Text
"ArrayOfByte" -> Text
-> (Vector Int8 -> Value)
-> Content Int8
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"byte" IsLabel "arrayOfByte" (Vector Int8 -> Value)
Vector Int8 -> Value
#arrayOfByte Content Int8
byteContent
                    Text
"ArrayOfShort" -> Text
-> (Vector Int16 -> Value)
-> Content Int16
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"short" IsLabel "arrayOfShort" (Vector Int16 -> Value)
Vector Int16 -> Value
#arrayOfShort Content Int16
shortContent
                    Text
"ArrayOfUnsignedShort" -> Text
-> (Vector Word16 -> Value)
-> Content Word16
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"unsignedShort" IsLabel "arrayOfUnsignedShort" (Vector Word16 -> Value)
Vector Word16 -> Value
#arrayOfUnsignedShort Content Word16
unsignedShortContent
                    Text
"ArrayOfInt" -> Text
-> (Vector Int32 -> Value)
-> Content Int32
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"int" IsLabel "arrayOfInt" (Vector Int32 -> Value)
Vector Int32 -> Value
#arrayOfInt Content Int32
intContent
                    Text
"ArrayOfUnsignedInt" -> Text
-> (Vector Word32 -> Value)
-> Content Word32
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"unsignedInt" IsLabel "arrayOfUnsignedInt" (Vector Word32 -> Value)
Vector Word32 -> Value
#arrayOfUnsignedInt Content Word32
unsignedIntContent
                    Text
"ArrayOfLong" -> Text
-> (Vector Int64 -> Value)
-> Content Int64
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"long" IsLabel "arrayOfLong" (Vector Int64 -> Value)
Vector Int64 -> Value
#arrayOfLong Content Int64
longContent
                    Text
"ArrayOfUnsignedLong" -> Text
-> (Vector Word64 -> Value)
-> Content Word64
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"unsignedLong" IsLabel "arrayOfUnsignedLong" (Vector Word64 -> Value)
Vector Word64 -> Value
#arrayOfUnsignedLong Content Word64
unsignedLongContent
                    Text
"ArrayOfFloat" -> Text
-> (Vector Float -> Value)
-> Content Float
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"float" IsLabel "arrayOfFloat" (Vector Float -> Value)
Vector Float -> Value
#arrayOfFloat Content Float
floatContent
                    Text
"ArrayOfDecimal" -> Text
-> (Vector Scientific -> Value)
-> Content Scientific
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"decimal" IsLabel "arrayOfDecimal" (Vector Scientific -> Value)
Vector Scientific -> Value
#arrayOfDecimal Content Scientific
decimalContent
                    Text
"ArrayOfDouble" -> Text
-> (Vector Double -> Value)
-> Content Double
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"double" IsLabel "arrayOfDouble" (Vector Double -> Value)
Vector Double -> Value
#arrayOfDouble Content Double
doubleContent
                    Text
"ArrayOfBoolean" -> Text
-> (Vector Bool -> Value)
-> Content Bool
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"boolean" IsLabel "arrayOfBoolean" (Vector Bool -> Value)
Vector Bool -> Value
#arrayOfBoolean Content Bool
booleanContent
                    Text
"ArrayOfString" -> Text
-> (Vector Text -> Value)
-> Content Text
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"string" IsLabel "arrayOfString" (Vector Text -> Value)
Vector Text -> Value
#arrayOfString Content Text
stringContent
                    Text
"ArrayOfDateTime" -> Text
-> (Vector UTCTime -> Value)
-> Content UTCTime
-> Content (Element Value)
forall (m :: * -> *) (v :: * -> *) a b.
(Monad m, Vector v a) =>
Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
"dateTime" IsLabel "arrayOfDateTime" (Vector UTCTime -> Value)
Vector UTCTime -> Value
#arrayOfDateTime Content UTCTime
dateTimeContent
                    Text
"ArrayOfAnyType" ->
                      Element Value -> Content (Element Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Value -> Content (Element Value))
-> Element Value -> Content (Element Value)
forall a b. (a -> b) -> a -> b
$
                        (Vector (Maybe Value) -> Value)
-> Element (Vector (Maybe Value)) -> Element Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IsLabel "arrayOfAnyType" (Vector (Maybe Value) -> Value)
Vector (Maybe Value) -> Value
#arrayOfAnyType (Element (Vector (Maybe Value)) -> Element Value)
-> Element (Vector (Maybe Value)) -> Element Value
forall a b. (a -> b) -> a -> b
$
                          ByName Element (Vector (Maybe Value))
-> Element (Vector (Maybe Value))
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Vector (Maybe Value))
 -> Element (Vector (Maybe Value)))
-> ByName Element (Vector (Maybe Value))
-> Element (Vector (Maybe Value))
forall a b. (a -> b) -> a -> b
$
                            ByName Element (Maybe Value)
-> ByName Element (Vector (Maybe Value))
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element (Maybe Value)
 -> ByName Element (Vector (Maybe Value)))
-> ByName Element (Maybe Value)
-> ByName Element (Vector (Maybe Value))
forall a b. (a -> b) -> a -> b
$
                              Maybe Text
-> Text -> Element (Maybe Value) -> ByName Element (Maybe Value)
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"anyType" (Element (Maybe Value) -> ByName Element (Maybe Value))
-> Element (Maybe Value) -> ByName Element (Maybe Value)
forall a b. (a -> b) -> a -> b
$ do
                                Bool
_isNil <- ByName Content Bool -> Element Bool
forall a. ByName Content a -> Element a
attributesByName ByName Content Bool
isNil
                                if Bool
_isNil
                                  then Maybe Value -> Element (Maybe Value)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Value
forall a. Maybe a
Nothing
                                  else (Value -> Maybe Value) -> Element Value -> Element (Maybe Value)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Value -> Maybe Value
forall a. a -> Maybe a
Just (Element Value -> Element (Maybe Value))
-> Element Value -> Element (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Element Value
value
                    Text
"OPCQuality" -> Element Value -> Content (Element Value)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element Value -> Content (Element Value))
-> Element Value -> Content (Element Value)
forall a b. (a -> b) -> a -> b
$ (OpcQuality -> Value) -> Element OpcQuality -> Element Value
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap IsLabel "opcQuality" (OpcQuality -> Value)
OpcQuality -> Value
#opcQuality (Element OpcQuality -> Element Value)
-> Element OpcQuality -> Element Value
forall a b. (a -> b) -> a -> b
$ Element OpcQuality
opcQuality
                    Text
_ -> String -> Content (Element Value)
forall (m :: * -> *) a. MonadFail m => String -> m a
fail (String -> Content (Element Value))
-> String -> Content (Element Value)
forall a b. (a -> b) -> a -> b
$ String
"Unexpected OPC type: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Text -> String
forall a. Show a => a -> String
show Text
_typeName
                  else QName -> Content (Element Value)
forall (m :: * -> *) b.
(Monad m, IsLabel "nonStandard" (ValueNonStandard -> b)) =>
QName -> m (Element b)
nonStandard (Text -> Text -> QName
NamespacedQName Text
_typeNs Text
_typeName)
          Maybe Text
Nothing -> QName -> Content (Element Value)
forall (m :: * -> *) b.
(Monad m, IsLabel "nonStandard" (ValueNonStandard -> b)) =>
QName -> m (Element b)
nonStandard (Text -> QName
UnnamespacedQName Text
_typeName)
  where
    primitive :: (a -> b) -> Content a -> m (Element b)
primitive a -> b
constructor Content a
contentParser =
      Element b -> m (Element b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element b -> m (Element b)) -> Element b -> m (Element b)
forall a b. (a -> b) -> a -> b
$ (a -> b) -> Element a -> Element b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap a -> b
constructor (Element a -> Element b) -> Element a -> Element b
forall a b. (a -> b) -> a -> b
$ Nodes a -> Element a
forall a. Nodes a -> Element a
children (Nodes a -> Element a) -> Nodes a -> Element a
forall a b. (a -> b) -> a -> b
$ Content a -> Nodes a
forall content. Content content -> Nodes content
contentNode Content a
contentParser
    arrayOfPrimitive :: Text -> (v a -> b) -> Content a -> m (Element b)
arrayOfPrimitive Text
elementName v a -> b
constructor Content a
contentParser =
      Element b -> m (Element b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element b -> m (Element b)) -> Element b -> m (Element b)
forall a b. (a -> b) -> a -> b
$ (v a -> b) -> Element (v a) -> Element b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap v a -> b
constructor (Element (v a) -> Element b) -> Element (v a) -> Element b
forall a b. (a -> b) -> a -> b
$ ByName Element (v a) -> Element (v a)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (v a) -> Element (v a))
-> ByName Element (v a) -> Element (v a)
forall a b. (a -> b) -> a -> b
$ ByName Element a -> ByName Element (v a)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element a -> ByName Element (v a))
-> ByName Element a -> ByName Element (v a)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element a -> ByName Element a
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
elementName (Element a -> ByName Element a) -> Element a -> ByName Element a
forall a b. (a -> b) -> a -> b
$ Nodes a -> Element a
forall a. Nodes a -> Element a
children (Nodes a -> Element a) -> Nodes a -> Element a
forall a b. (a -> b) -> a -> b
$ Content a -> Nodes a
forall content. Content content -> Nodes content
contentNode Content a
contentParser
    nonStandard :: QName -> m (Element b)
nonStandard QName
_type =
      Element b -> m (Element b)
forall (m :: * -> *) a. Monad m => a -> m a
return (Element b -> m (Element b)) -> Element b -> m (Element b)
forall a b. (a -> b) -> a -> b
$
        ([Node] -> b) -> Element [Node] -> Element b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (IsLabel "nonStandard" (ValueNonStandard -> b)
ValueNonStandard -> b
#nonStandard (ValueNonStandard -> b)
-> ([Node] -> ValueNonStandard) -> [Node] -> b
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. QName -> [Node] -> ValueNonStandard
ValueNonStandard QName
_type) (Element [Node] -> Element b) -> Element [Node] -> Element b
forall a b. (a -> b) -> a -> b
$ do
          Xml.Element Name
_ Map Name Text
_ [Node]
_children <- Element Element
astElement
          [Node] -> Element [Node]
forall (m :: * -> *) a. Monad m => a -> m a
return [Node]
_children

opcQuality :: Element OpcQuality
opcQuality :: Element OpcQuality
opcQuality =
  ByName Content OpcQuality -> Element OpcQuality
forall a. ByName Content a -> Element a
attributesByName (ByName Content OpcQuality -> Element OpcQuality)
-> ByName Content OpcQuality -> Element OpcQuality
forall a b. (a -> b) -> a -> b
$ do
    QualityBits
_qualityField <- Maybe Text
-> Text -> Content QualityBits -> ByName Content QualityBits
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"QualityField" Content QualityBits
qualityBitsContent ByName Content QualityBits
-> ByName Content QualityBits -> ByName Content QualityBits
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> QualityBits -> ByName Content QualityBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsLabel "good" QualityBits
QualityBits
#good
    LimitBits
_limitField <- Maybe Text -> Text -> Content LimitBits -> ByName Content LimitBits
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"LimitField" Content LimitBits
limitBitsContent ByName Content LimitBits
-> ByName Content LimitBits -> ByName Content LimitBits
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> LimitBits -> ByName Content LimitBits
forall (f :: * -> *) a. Applicative f => a -> f a
pure IsLabel "none" LimitBits
LimitBits
#none
    Word8
_vendorField <- Maybe Text -> Text -> Content Word8 -> ByName Content Word8
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"VendorField" Content Word8
unsignedByteContent ByName Content Word8
-> ByName Content Word8 -> ByName Content Word8
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Word8 -> ByName Content Word8
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word8
0
    return (QualityBits -> LimitBits -> Word8 -> OpcQuality
OpcQuality QualityBits
_qualityField LimitBits
_limitField Word8
_vendorField)

serverStatus :: Element ServerStatus
serverStatus :: Element ServerStatus
serverStatus =
  Element (Element ServerStatus) -> Element ServerStatus
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element ServerStatus) -> Element ServerStatus)
-> Element (Element ServerStatus) -> Element ServerStatus
forall a b. (a -> b) -> a -> b
$
    ByName Element (Element ServerStatus)
-> Element (Element ServerStatus)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element ServerStatus)
 -> Element (Element ServerStatus))
-> ByName Element (Element ServerStatus)
-> Element (Element ServerStatus)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Text
_statusInfo <- ByName Element Text -> ByName Element (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Text -> ByName Element (Maybe Text))
-> ByName Element Text -> ByName Element (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"StatusInfo" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      Maybe Text
_vendorInfo <- ByName Element Text -> ByName Element (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Text -> ByName Element (Maybe Text))
-> ByName Element Text -> ByName Element (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"VendorInfo" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      Vector Text
_supportedLocaleIds <- ByName Element Text -> ByName Element (Vector Text)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element Text -> ByName Element (Vector Text))
-> ByName Element Text -> ByName Element (Vector Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"SupportedLocaleIDs" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      Vector Text
_supportedInterfaceVersions <- ByName Element Text -> ByName Element (Vector Text)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element Text -> ByName Element (Vector Text))
-> ByName Element Text -> ByName Element (Vector Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Text -> ByName Element Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"SupportedInterfaceVersions" (Element Text -> ByName Element Text)
-> Element Text -> ByName Element Text
forall a b. (a -> b) -> a -> b
$ Nodes Text -> Element Text
forall a. Nodes a -> Element a
children (Nodes Text -> Element Text) -> Nodes Text -> Element Text
forall a b. (a -> b) -> a -> b
$ Content Text -> Nodes Text
forall content. Content content -> Nodes content
contentNode (Content Text -> Nodes Text) -> Content Text -> Nodes Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
      return $
        ByName Content ServerStatus -> Element ServerStatus
forall a. ByName Content a -> Element a
attributesByName (ByName Content ServerStatus -> Element ServerStatus)
-> ByName Content ServerStatus -> Element ServerStatus
forall a b. (a -> b) -> a -> b
$ do
          UTCTime
_startTime <- Maybe Text -> Text -> Content UTCTime -> ByName Content UTCTime
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"StartTime" (Content UTCTime -> ByName Content UTCTime)
-> Content UTCTime -> ByName Content UTCTime
forall a b. (a -> b) -> a -> b
$ Content UTCTime
dateTimeContent
          Maybe Text
_productVersion <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ProductVersion" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          return $ Maybe Text
-> Maybe Text
-> Vector Text
-> Vector Text
-> UTCTime
-> Maybe Text
-> ServerStatus
ServerStatus Maybe Text
_statusInfo Maybe Text
_vendorInfo Vector Text
_supportedLocaleIds Vector Text
_supportedInterfaceVersions UTCTime
_startTime Maybe Text
_productVersion

replyItemList :: Element ReplyItemList
replyItemList :: Element ReplyItemList
replyItemList =
  Element (Element ReplyItemList) -> Element ReplyItemList
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element ReplyItemList) -> Element ReplyItemList)
-> Element (Element ReplyItemList) -> Element ReplyItemList
forall a b. (a -> b) -> a -> b
$
    ByName Element (Element ReplyItemList)
-> Element (Element ReplyItemList)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element ReplyItemList)
 -> Element (Element ReplyItemList))
-> ByName Element (Element ReplyItemList)
-> Element (Element ReplyItemList)
forall a b. (a -> b) -> a -> b
$ do
      Vector ItemValue
_items <- ByName Element ItemValue -> ByName Element (Vector ItemValue)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element ItemValue -> ByName Element (Vector ItemValue))
-> ByName Element ItemValue -> ByName Element (Vector ItemValue)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ItemValue -> ByName Element ItemValue
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Items" (Element ItemValue -> ByName Element ItemValue)
-> Element ItemValue -> ByName Element ItemValue
forall a b. (a -> b) -> a -> b
$ Element ItemValue
itemValue
      return $
        ByName Content ReplyItemList -> Element ReplyItemList
forall a. ByName Content a -> Element a
attributesByName (ByName Content ReplyItemList -> Element ReplyItemList)
-> ByName Content ReplyItemList -> Element ReplyItemList
forall a b. (a -> b) -> a -> b
$ do
          Maybe Text
_reserved <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"Reserved" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          return $ Vector ItemValue -> Maybe Text -> ReplyItemList
ReplyItemList Vector ItemValue
_items Maybe Text
_reserved

subscribePolledRefreshReplyItemList :: Element SubscribePolledRefreshReplyItemList
subscribePolledRefreshReplyItemList :: Element SubscribePolledRefreshReplyItemList
subscribePolledRefreshReplyItemList =
  Element (Element SubscribePolledRefreshReplyItemList)
-> Element SubscribePolledRefreshReplyItemList
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element SubscribePolledRefreshReplyItemList)
 -> Element SubscribePolledRefreshReplyItemList)
-> Element (Element SubscribePolledRefreshReplyItemList)
-> Element SubscribePolledRefreshReplyItemList
forall a b. (a -> b) -> a -> b
$
    ByName Element (Element SubscribePolledRefreshReplyItemList)
-> Element (Element SubscribePolledRefreshReplyItemList)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element SubscribePolledRefreshReplyItemList)
 -> Element (Element SubscribePolledRefreshReplyItemList))
-> ByName Element (Element SubscribePolledRefreshReplyItemList)
-> Element (Element SubscribePolledRefreshReplyItemList)
forall a b. (a -> b) -> a -> b
$ do
      Vector ItemValue
_items <- ByName Element ItemValue -> ByName Element (Vector ItemValue)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element ItemValue -> ByName Element (Vector ItemValue))
-> ByName Element ItemValue -> ByName Element (Vector ItemValue)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element ItemValue -> ByName Element ItemValue
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Items" (Element ItemValue -> ByName Element ItemValue)
-> Element ItemValue -> ByName Element ItemValue
forall a b. (a -> b) -> a -> b
$ Element ItemValue
itemValue
      return $
        ByName Content SubscribePolledRefreshReplyItemList
-> Element SubscribePolledRefreshReplyItemList
forall a. ByName Content a -> Element a
attributesByName (ByName Content SubscribePolledRefreshReplyItemList
 -> Element SubscribePolledRefreshReplyItemList)
-> ByName Content SubscribePolledRefreshReplyItemList
-> Element SubscribePolledRefreshReplyItemList
forall a b. (a -> b) -> a -> b
$ do
          Maybe Text
_subscriptionHandle <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"SubscriptionHandle" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          return $ Vector ItemValue
-> Maybe Text -> SubscribePolledRefreshReplyItemList
SubscribePolledRefreshReplyItemList Vector ItemValue
_items Maybe Text
_subscriptionHandle

browseElement :: Element BrowseElement
browseElement :: Element BrowseElement
browseElement =
  Element (Element BrowseElement) -> Element BrowseElement
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element BrowseElement) -> Element BrowseElement)
-> Element (Element BrowseElement) -> Element BrowseElement
forall a b. (a -> b) -> a -> b
$
    ByName Element (Element BrowseElement)
-> Element (Element BrowseElement)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element BrowseElement)
 -> Element (Element BrowseElement))
-> ByName Element (Element BrowseElement)
-> Element (Element BrowseElement)
forall a b. (a -> b) -> a -> b
$ do
      Vector ItemProperty
_properties <- ByName Element ItemProperty -> ByName Element (Vector ItemProperty)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element ItemProperty
 -> ByName Element (Vector ItemProperty))
-> ByName Element ItemProperty
-> ByName Element (Vector ItemProperty)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element ItemProperty -> ByName Element ItemProperty
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Properties" (Element ItemProperty -> ByName Element ItemProperty)
-> Element ItemProperty -> ByName Element ItemProperty
forall a b. (a -> b) -> a -> b
$ Element ItemProperty
itemProperty
      return $
        ByName Content BrowseElement -> Element BrowseElement
forall a. ByName Content a -> Element a
attributesByName (ByName Content BrowseElement -> Element BrowseElement)
-> ByName Content BrowseElement -> Element BrowseElement
forall a b. (a -> b) -> a -> b
$ do
          Maybe Text
_name <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"Name" Content Text
textContent
          Maybe Text
_itemPath <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemPath" Content Text
textContent
          Maybe Text
_itemName <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemName" Content Text
textContent
          Bool
_isItem <- Maybe Text -> Text -> Content Bool -> ByName Content Bool
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"IsItem" Content Bool
booleanContent
          Bool
_hasChildren <- Maybe Text -> Text -> Content Bool -> ByName Content Bool
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"HasChildren" Content Bool
booleanContent
          return $ Vector ItemProperty
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Bool
-> Bool
-> BrowseElement
BrowseElement Vector ItemProperty
_properties Maybe Text
_name Maybe Text
_itemPath Maybe Text
_itemName Bool
_isItem Bool
_hasChildren

itemProperty :: Element ItemProperty
itemProperty :: Element ItemProperty
itemProperty =
  Element (Element ItemProperty) -> Element ItemProperty
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element ItemProperty) -> Element ItemProperty)
-> Element (Element ItemProperty) -> Element ItemProperty
forall a b. (a -> b) -> a -> b
$
    ByName Element (Element ItemProperty)
-> Element (Element ItemProperty)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element ItemProperty)
 -> Element (Element ItemProperty))
-> ByName Element (Element ItemProperty)
-> Element (Element ItemProperty)
forall a b. (a -> b) -> a -> b
$ do
      Maybe Value
_value <- ByName Element Value -> ByName Element (Maybe Value)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Element Value -> ByName Element (Maybe Value))
-> ByName Element Value -> ByName Element (Maybe Value)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Element Value -> ByName Element Value
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Value" (Element Value -> ByName Element Value)
-> Element Value -> ByName Element Value
forall a b. (a -> b) -> a -> b
$ Element Value
value
      return $
        ByName Content ItemProperty -> Element ItemProperty
forall a. ByName Content a -> Element a
attributesByName (ByName Content ItemProperty -> Element ItemProperty)
-> ByName Content ItemProperty -> Element ItemProperty
forall a b. (a -> b) -> a -> b
$ do
          QName
_name <- Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"Name" Content QName
adaptedQNameContent
          Maybe Text
_description <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"Description" Content Text
textContent
          Maybe Text
_itemPath <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemPath" Content Text
textContent
          Maybe Text
_itemName <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemName" Content Text
textContent
          Maybe QName
_resultId <- ByName Content QName -> ByName Content (Maybe QName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content QName -> ByName Content (Maybe QName))
-> ByName Content QName -> ByName Content (Maybe QName)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ResultID" Content QName
adaptedQNameContent
          return $ Maybe Value
-> QName
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe QName
-> ItemProperty
ItemProperty Maybe Value
_value QName
_name Maybe Text
_description Maybe Text
_itemPath Maybe Text
_itemName Maybe QName
_resultId

propertyReplyList :: Element PropertyReplyList
propertyReplyList :: Element PropertyReplyList
propertyReplyList = do
  Element (Element PropertyReplyList) -> Element PropertyReplyList
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element PropertyReplyList) -> Element PropertyReplyList)
-> Element (Element PropertyReplyList) -> Element PropertyReplyList
forall a b. (a -> b) -> a -> b
$
    ByName Element (Element PropertyReplyList)
-> Element (Element PropertyReplyList)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Element PropertyReplyList)
 -> Element (Element PropertyReplyList))
-> ByName Element (Element PropertyReplyList)
-> Element (Element PropertyReplyList)
forall a b. (a -> b) -> a -> b
$ do
      Vector ItemProperty
_properties <- ByName Element ItemProperty -> ByName Element (Vector ItemProperty)
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element ItemProperty
 -> ByName Element (Vector ItemProperty))
-> ByName Element ItemProperty
-> ByName Element (Vector ItemProperty)
forall a b. (a -> b) -> a -> b
$ Maybe Text
-> Text -> Element ItemProperty -> ByName Element ItemProperty
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"Properties" (Element ItemProperty -> ByName Element ItemProperty)
-> Element ItemProperty -> ByName Element ItemProperty
forall a b. (a -> b) -> a -> b
$ Element ItemProperty
itemProperty
      return $
        ByName Content PropertyReplyList -> Element PropertyReplyList
forall a. ByName Content a -> Element a
attributesByName (ByName Content PropertyReplyList -> Element PropertyReplyList)
-> ByName Content PropertyReplyList -> Element PropertyReplyList
forall a b. (a -> b) -> a -> b
$ do
          Maybe Text
_itemPath <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemPath" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          Maybe Text
_itemName <- ByName Content Text -> ByName Content (Maybe Text)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content Text -> ByName Content (Maybe Text))
-> ByName Content Text -> ByName Content (Maybe Text)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content Text -> ByName Content Text
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ItemName" (Content Text -> ByName Content Text)
-> Content Text -> ByName Content Text
forall a b. (a -> b) -> a -> b
$ Content Text
textContent
          Maybe QName
_resultId <- ByName Content QName -> ByName Content (Maybe QName)
forall (f :: * -> *) a. Alternative f => f a -> f (Maybe a)
optional (ByName Content QName -> ByName Content (Maybe QName))
-> ByName Content QName -> ByName Content (Maybe QName)
forall a b. (a -> b) -> a -> b
$ Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName Maybe Text
forall a. Maybe a
Nothing Text
"ResultID" (Content QName -> ByName Content QName)
-> Content QName -> ByName Content QName
forall a b. (a -> b) -> a -> b
$ Content QName
adaptedQNameContent
          return $ Vector ItemProperty
-> Maybe Text -> Maybe Text -> Maybe QName -> PropertyReplyList
PropertyReplyList Vector ItemProperty
_properties Maybe Text
_itemPath Maybe Text
_itemName Maybe QName
_resultId

-- * Content

qualityBitsContent :: Content QualityBits
qualityBitsContent :: Content QualityBits
qualityBitsContent =
  [(Text, QualityBits)] -> Content QualityBits
forall a. [(Text, a)] -> Content a
enumContent
    [ (Text
"bad", IsLabel "bad" QualityBits
QualityBits
#bad),
      (Text
"badConfigurationError", IsLabel "badConfigurationError" QualityBits
QualityBits
#badConfigurationError),
      (Text
"badNotConnected", IsLabel "badNotConnected" QualityBits
QualityBits
#badNotConnected),
      (Text
"badDeviceFailure", IsLabel "badDeviceFailure" QualityBits
QualityBits
#badDeviceFailure),
      (Text
"badSensorFailure", IsLabel "badSensorFailure" QualityBits
QualityBits
#badSensorFailure),
      (Text
"badLastKnownValue", IsLabel "badLastKnownValue" QualityBits
QualityBits
#badLastKnownValue),
      (Text
"badCommFailure", IsLabel "badCommFailure" QualityBits
QualityBits
#badCommFailure),
      (Text
"badOutOfService", IsLabel "badOutOfService" QualityBits
QualityBits
#badOutOfService),
      (Text
"badWaitingForInitialData", IsLabel "badWaitingForInitialData" QualityBits
QualityBits
#badWaitingForInitialData),
      (Text
"uncertain", IsLabel "uncertain" QualityBits
QualityBits
#uncertain),
      (Text
"uncertainLastUsableValue", IsLabel "uncertainLastUsableValue" QualityBits
QualityBits
#uncertainLastUsableValue),
      (Text
"uncertainSensorNotAccurate", IsLabel "uncertainSensorNotAccurate" QualityBits
QualityBits
#uncertainSensorNotAccurate),
      (Text
"uncertainEUExceeded", IsLabel "uncertainEUExceeded" QualityBits
QualityBits
#uncertainEUExceeded),
      (Text
"uncertainSubNormal", IsLabel "uncertainSubNormal" QualityBits
QualityBits
#uncertainSubNormal),
      (Text
"good", IsLabel "good" QualityBits
QualityBits
#good),
      (Text
"goodLocalOverride", IsLabel "goodLocalOverride" QualityBits
QualityBits
#goodLocalOverride)
    ]

limitBitsContent :: Content LimitBits
limitBitsContent :: Content LimitBits
limitBitsContent =
  [(Text, LimitBits)] -> Content LimitBits
forall a. [(Text, a)] -> Content a
enumContent
    [ (Text
"none", IsLabel "none" LimitBits
LimitBits
#none),
      (Text
"low", IsLabel "low" LimitBits
LimitBits
#low),
      (Text
"high", IsLabel "high" LimitBits
LimitBits
#high),
      (Text
"constant", IsLabel "constant" LimitBits
LimitBits
#constant)
    ]

serverStateContent :: Content ServerState
serverStateContent :: Content ServerState
serverStateContent =
  [(Text, ServerState)] -> Content ServerState
forall a. [(Text, a)] -> Content a
enumContent
    [ (Text
"running", IsLabel "running" ServerState
ServerState
#running),
      (Text
"failed", IsLabel "failed" ServerState
ServerState
#failed),
      (Text
"noConfig", IsLabel "noConfig" ServerState
ServerState
#noConfig),
      (Text
"suspended", IsLabel "suspended" ServerState
ServerState
#suspended),
      (Text
"test", IsLabel "test" ServerState
ServerState
#test),
      (Text
"commFault", IsLabel "commFault" ServerState
ServerState
#commFault)
    ]

-- |
-- A sequence of UNICODE characters.
stringContent :: Content Text
stringContent :: Content Text
stringContent = Content Text
textContent

-- |
-- A binary logic value (true or false).
booleanContent :: Content Bool
booleanContent :: Content Bool
booleanContent = Parser Bool -> Content Bool
forall a. Parser a -> Content a
attoparsedContent (Parser Bool -> Content Bool) -> Parser Bool -> Content Bool
forall a b. (a -> b) -> a -> b
$ Parser Bool
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- An IEEE single-precision 32-bit floating point value.
floatContent :: Content Float
floatContent :: Content Float
floatContent = Parser Float -> Content Float
forall a. Parser a -> Content a
attoparsedContent (Parser Float -> Content Float) -> Parser Float -> Content Float
forall a b. (a -> b) -> a -> b
$ (Double -> Float) -> Parser Text Double -> Parser Float
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Double -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (Parser Text Double -> Parser Float)
-> Parser Text Double -> Parser Float
forall a b. (a -> b) -> a -> b
$ LenientParser Double => Parser Text Double
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser @Double

-- |
-- An IEEE double-precision 64-bit floating point value.
doubleContent :: Content Double
doubleContent :: Content Double
doubleContent = Parser Text Double -> Content Double
forall a. Parser a -> Content a
attoparsedContent (Parser Text Double -> Content Double)
-> Parser Text Double -> Content Double
forall a b. (a -> b) -> a -> b
$ Parser Text Double
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A fixed-point decimal value with arbitrary precision.
-- Application development environments impose practical limitations on the precision supported by this type. XML-DA compliant applications must support at least the range supported by the VT_CY type.
decimalContent :: Content Scientific
decimalContent :: Content Scientific
decimalContent = Parser Scientific -> Content Scientific
forall a. Parser a -> Content a
attoparsedContent (Parser Scientific -> Content Scientific)
-> Parser Scientific -> Content Scientific
forall a b. (a -> b) -> a -> b
$ Parser Scientific
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A 64-bit signed integer value.
longContent :: Content Int64
longContent :: Content Int64
longContent = Parser Int64 -> Content Int64
forall a. Parser a -> Content a
attoparsedContent (Parser Int64 -> Content Int64) -> Parser Int64 -> Content Int64
forall a b. (a -> b) -> a -> b
$ Parser Int64
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A 32-bit signed integer value.
intContent :: Content Int32
intContent :: Content Int32
intContent = Parser Int32 -> Content Int32
forall a. Parser a -> Content a
attoparsedContent (Parser Int32 -> Content Int32) -> Parser Int32 -> Content Int32
forall a b. (a -> b) -> a -> b
$ Parser Int32
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A 16-bit signed integer value.
shortContent :: Content Int16
shortContent :: Content Int16
shortContent = Parser Int16 -> Content Int16
forall a. Parser a -> Content a
attoparsedContent (Parser Int16 -> Content Int16) -> Parser Int16 -> Content Int16
forall a b. (a -> b) -> a -> b
$ Parser Int16
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- An 8-bit signed integer value.
-- Note this differs from the definition of ‘byte’ used in most programming laguages.
byteContent :: Content Int8
byteContent :: Content Int8
byteContent = Parser Int8 -> Content Int8
forall a. Parser a -> Content a
attoparsedContent (Parser Int8 -> Content Int8) -> Parser Int8 -> Content Int8
forall a b. (a -> b) -> a -> b
$ Parser Int8
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A 64-bit unsigned integer value.
unsignedLongContent :: Content Word64
unsignedLongContent :: Content Word64
unsignedLongContent = Parser Word64 -> Content Word64
forall a. Parser a -> Content a
attoparsedContent (Parser Word64 -> Content Word64)
-> Parser Word64 -> Content Word64
forall a b. (a -> b) -> a -> b
$ Parser Word64
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A 32-bit unsigned integer value.
unsignedIntContent :: Content Word32
unsignedIntContent :: Content Word32
unsignedIntContent = Parser Word32 -> Content Word32
forall a. Parser a -> Content a
attoparsedContent (Parser Word32 -> Content Word32)
-> Parser Word32 -> Content Word32
forall a b. (a -> b) -> a -> b
$ Parser Word32
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A 16-bit unsigned integer value.
unsignedShortContent :: Content Word16
unsignedShortContent :: Content Word16
unsignedShortContent = Parser Word16 -> Content Word16
forall a. Parser a -> Content a
attoparsedContent (Parser Word16 -> Content Word16)
-> Parser Word16 -> Content Word16
forall a b. (a -> b) -> a -> b
$ Parser Word16
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- An 8-bit unsigned integer value.
unsignedByteContent :: Content Word8
unsignedByteContent :: Content Word8
unsignedByteContent = Parser Word8 -> Content Word8
forall a. Parser a -> Content a
attoparsedContent (Parser Word8 -> Content Word8) -> Parser Word8 -> Content Word8
forall a b. (a -> b) -> a -> b
$ Parser Word8
forall a. LenientParser a => Parser a
AttoparsecData.lenientParser

-- |
-- A sequence of 8-bit values represented in XML with Base-64 Encoding.
base64BinaryContent :: Content ByteString
base64BinaryContent :: Content ByteString
base64BinaryContent = (Text -> Either Text ByteString) -> Content ByteString
forall a. (Text -> Either Text a) -> Content a
refinedContent ((Text -> Either Text ByteString) -> Content ByteString)
-> (Text -> Either Text ByteString) -> Content ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Either Text ByteString
Base64.decodeBase64 (ByteString -> Either Text ByteString)
-> (Text -> ByteString) -> Text -> Either Text ByteString
forall k (cat :: k -> k -> *) (b :: k) (c :: k) (a :: k).
Category cat =>
cat b c -> cat a b -> cat a c
. Text -> ByteString
TextEncoding.encodeUtf8

-- |
-- A specific instance in time.
dateTimeContent :: Content UTCTime
dateTimeContent :: Content UTCTime
dateTimeContent = Parser UTCTime -> Content UTCTime
forall a. Parser a -> Content a
attoparsedContent Parser UTCTime
XmlSchemaValuesAttoparsec.dateTime

-- |
-- An instant of time that recurs every day.
timeContent :: Content Time
timeContent :: Content Time
timeContent = Parser Time -> Content Time
forall a. Parser a -> Content a
attoparsedContent Parser Time
XmlSchemaValuesAttoparsec.time

-- |
-- A Gregorian calendar date.
dateContent :: Content Date
dateContent :: Content Date
dateContent = Parser Date -> Content Date
forall a. Parser a -> Content a
attoparsedContent Parser Date
XmlSchemaValuesAttoparsec.date

-- |
-- A duration of time as specified by Gregorian year, month, day, hour, minute, and second components.
durationContent :: Content Duration
durationContent :: Content Duration
durationContent = Parser Duration -> Content Duration
forall a. Parser a -> Content a
attoparsedContent Parser Duration
XmlSchemaValuesAttoparsec.duration

-- |
-- An XML qualified name comprising of a name and a namespace.
-- The name must be a valid XML element name and the namespace must be a valid URI.
-- QNames are equal only if the name and the namespace are equal.
adaptedQNameContent :: Content QName
adaptedQNameContent :: Content QName
adaptedQNameContent =
  Content (Maybe Text, Text)
qNameContent Content (Maybe Text, Text)
-> ((Maybe Text, Text) -> QName) -> Content QName
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \(Maybe Text
ns, Text
name) -> case Maybe Text
ns of
    Just Text
ns -> Text -> Text -> QName
NamespacedQName Text
ns Text
name
    Maybe Text
Nothing -> Text -> QName
UnnamespacedQName Text
name

-- * Attributes

isNil :: ByName Content Bool
isNil :: ByName Content Bool
isNil =
  Maybe Text -> Text -> Content Bool -> ByName Content Bool
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.xsi) Text
"nil" Content Bool
booleanContent ByName Content Bool -> ByName Content Bool -> ByName Content Bool
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Bool -> ByName Content Bool
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False

xsiType :: ByName Content QName
xsiType :: ByName Content QName
xsiType =
  Maybe Text -> Text -> Content QName -> ByName Content QName
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.xsi) Text
"type" Content QName
adaptedQNameContent

-- * Value parsers

-- |
-- Parse array of any type by passing in a parser for elements
-- in the context of a QName of the element type.
arrayOfAnyType :: (QName -> ByName Element element) -> ByName Element (Vector (Maybe element))
arrayOfAnyType :: (QName -> ByName Element element)
-> ByName Element (Vector (Maybe element))
arrayOfAnyType QName -> ByName Element element
elementParser =
  ByName Element (Maybe element)
-> ByName Element (Vector (Maybe element))
forall (m :: * -> *) (v :: * -> *) a.
(MonadPlus m, Vector v a) =>
m a -> m (v a)
VectorUtil.many (ByName Element (Maybe element)
 -> ByName Element (Vector (Maybe element)))
-> ByName Element (Maybe element)
-> ByName Element (Vector (Maybe element))
forall a b. (a -> b) -> a -> b
$
    Maybe Text
-> Text
-> Element (Maybe element)
-> ByName Element (Maybe element)
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.opc) Text
"anyType" (Element (Maybe element) -> ByName Element (Maybe element))
-> Element (Maybe element) -> ByName Element (Maybe element)
forall a b. (a -> b) -> a -> b
$
      Element (Element (Maybe element)) -> Element (Maybe element)
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join (Element (Element (Maybe element)) -> Element (Maybe element))
-> Element (Element (Maybe element)) -> Element (Maybe element)
forall a b. (a -> b) -> a -> b
$
        ByName Content (Element (Maybe element))
-> Element (Element (Maybe element))
forall a. ByName Content a -> Element a
attributesByName (ByName Content (Element (Maybe element))
 -> Element (Element (Maybe element)))
-> ByName Content (Element (Maybe element))
-> Element (Element (Maybe element))
forall a b. (a -> b) -> a -> b
$ do
          Bool
_isNil <- ByName Content Bool
isNil
          if Bool
_isNil
            then Element (Maybe element) -> ByName Content (Element (Maybe element))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe element -> Element (Maybe element)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe element
forall a. Maybe a
Nothing)
            else do
              QName
_type <- ByName Content QName
xsiType
              return $ ByName Element (Maybe element) -> Element (Maybe element)
forall a. ByName Element a -> Element a
childrenByName (ByName Element (Maybe element) -> Element (Maybe element))
-> ByName Element (Maybe element) -> Element (Maybe element)
forall a b. (a -> b) -> a -> b
$ (element -> Maybe element)
-> ByName Element element -> ByName Element (Maybe element)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap element -> Maybe element
forall a. a -> Maybe a
Just (ByName Element element -> ByName Element (Maybe element))
-> ByName Element element -> ByName Element (Maybe element)
forall a b. (a -> b) -> a -> b
$ QName -> ByName Element element
elementParser QName
_type

-- * Helpers

-- |
-- A workaround for the fact that OPC uses a non-standard URI for the SOAP ENV
-- namespace.
bySoapEnvName :: Text -> parser a -> ByName parser a
bySoapEnvName :: Text -> parser a -> ByName parser a
bySoapEnvName Text
_name parser a
_parser =
  Maybe Text -> Text -> parser a -> ByName parser a
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.soapEnv2) Text
_name parser a
_parser
    ByName parser a -> ByName parser a -> ByName parser a
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Maybe Text -> Text -> parser a -> ByName parser a
forall (parser :: * -> *) a.
Maybe Text -> Text -> parser a -> ByName parser a
byName (Text -> Maybe Text
forall a. a -> Maybe a
Just Text
Ns.soapEnv) Text
_name parser a
_parser

elementNameIsOneOf :: [(Maybe Text, Text)] -> Element ()
elementNameIsOneOf :: [(Maybe Text, Text)] -> Element ()
elementNameIsOneOf [(Maybe Text, Text)]
_names =
  (Maybe Text -> Text -> Either Text ()) -> Element ()
forall a. (Maybe Text -> Text -> Either Text a) -> Element a
elementName ((Maybe Text -> Text -> Either Text ()) -> Element ())
-> (Maybe Text -> Text -> Either Text ()) -> Element ()
forall a b. (a -> b) -> a -> b
$ \Maybe Text
_actualNs Text
_actualName ->
    if (Maybe Text, Text) -> [(Maybe Text, Text)] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
elem (Maybe Text
_actualNs, Text
_actualName) [(Maybe Text, Text)]
_names
      then () -> Either Text ()
forall a b. b -> Either a b
Right ()
      else
        Text -> Either Text ()
forall a b. a -> Either a b
Left (Text -> Either Text ()) -> Text -> Either Text ()
forall a b. (a -> b) -> a -> b
$
          String -> Text
forall a. IsString a => String -> a
fromString (String -> Text) -> String -> Text
forall a b. (a -> b) -> a -> b
$
            String
"Unexpected element name: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> (Maybe Text, Text) -> String
forall a. Show a => a -> String
show (Maybe Text
_actualNs, Text
_actualName) String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
". "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"Expecting one of the following: "
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> [(Maybe Text, Text)] -> String
forall a. Show a => a -> String
show [(Maybe Text, Text)]
_names
              String -> String -> String
forall a. Semigroup a => a -> a -> a
<> String
"."