{-# LANGUAGE QuasiQuotes #-}
module SAML2.XML.Types where
import Data.List.NonEmpty (NonEmpty(..))
import Network.URI (URI(..), URIAuth(..), uriToString)
import qualified Text.XML.HXT.DOM.TypeDefs as HXT
import qualified Text.XML.HXT.Arrow.Pickle.Xml.Invertible as XP
type Node = HXT.XmlTree
type Nodes = HXT.XmlTrees
type List1 a = NonEmpty a
xpList1 :: XP.PU a -> XP.PU (List1 a)
xpList1 :: PU a -> PU (List1 a)
xpList1 PU a
f = [XP.biCase|a:l <-> a:|l|] Bijection (->) [a] (List1 a) -> PU [a] -> PU (List1 a)
forall (f :: * -> *) a b. Functor f => (a <-> b) -> f a -> f b
XP.>$< PU a -> PU [a]
forall a. PU a -> PU [a]
XP.xpList1 PU a
f
type QName = HXT.QName
data Namespace = Namespace
{ Namespace -> String
namespacePrefix :: !String
, Namespace -> URI
namespaceURI :: !URI
, Namespace -> String
namespaceURIString :: !String
}
mkNamespace :: String -> URI -> Namespace
mkNamespace :: String -> URI -> Namespace
mkNamespace String
p URI
u = String -> URI -> String -> Namespace
Namespace String
p URI
u (String -> Namespace) -> String -> Namespace
forall a b. (a -> b) -> a -> b
$ (String -> String) -> URI -> String -> String
uriToString String -> String
forall a. a -> a
id URI
u String
""
mkNName :: Namespace -> String -> QName
mkNName :: Namespace -> String -> QName
mkNName Namespace
ns String
n = String -> String -> String -> QName
HXT.mkQName (Namespace -> String
namespacePrefix Namespace
ns) String
n (Namespace -> String
namespaceURIString Namespace
ns)
httpURI :: String -> String -> String -> String -> URI
httpURI :: String -> String -> String -> String -> URI
httpURI String
host = String -> Maybe URIAuth -> String -> String -> String -> URI
URI String
"http:" (Maybe URIAuth -> String -> String -> String -> URI)
-> Maybe URIAuth -> String -> String -> String -> URI
forall a b. (a -> b) -> a -> b
$ URIAuth -> Maybe URIAuth
forall a. a -> Maybe a
Just (URIAuth -> Maybe URIAuth) -> URIAuth -> Maybe URIAuth
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> URIAuth
URIAuth String
"" String
host String
""
xmlNS, xmlnsNS :: Namespace
xmlNS :: Namespace
xmlNS = String -> URI -> Namespace
mkNamespace String
"xml" (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/XML/1998/namespace" String
"" String
""
xmlnsNS :: Namespace
xmlnsNS = String -> URI -> Namespace
mkNamespace String
"xmlns" (URI -> Namespace) -> URI -> Namespace
forall a b. (a -> b) -> a -> b
$ String -> String -> String -> String -> URI
httpURI String
"www.w3.org" String
"/2000/xmlns/" String
"" String
""