module Text.XML.HaXml.Validate
( validate
, partialValidate
) where
import Prelude hiding (elem,rem,mod,sequence)
import qualified Prelude (elem)
import Text.XML.HaXml.Types
import Text.XML.HaXml.Namespaces
import Text.XML.HaXml.Combinators (multi,tag,iffind,literal,none,o)
import Text.XML.HaXml.XmlContent (attr2str)
import Data.Maybe (fromMaybe,isNothing,fromJust)
import Data.List (intercalate,nub,(\\))
import Data.Char (isSpace)
#if __GLASGOW_HASKELL__ >= 604 || __NHC__ >= 118 || defined(__HUGS__)
import qualified Data.Map as Map
type FiniteMap a b = Map.Map a b
listToFM :: Ord a => [(a,b)] -> FiniteMap a b
listToFM :: forall a b. Ord a => [(a, b)] -> FiniteMap a b
listToFM = forall a b. Ord a => [(a, b)] -> FiniteMap a b
Map.fromList
lookupFM :: Ord a => FiniteMap a b -> a -> Maybe b
lookupFM :: forall a b. Ord a => FiniteMap a b -> a -> Maybe b
lookupFM = forall a b c. (a -> b -> c) -> b -> a -> c
flip forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup
#elif __GLASGOW_HASKELL__ >= 504 || __NHC__ > 114
import Data.FiniteMap
#else
type FiniteMap a b = [(a,b)]
listToFM :: Eq a => [(a,b)] -> FiniteMap a b
listToFM = id
lookupFM :: Eq a => FiniteMap a b -> a -> Maybe b
lookupFM fm k = lookup k fm
#endif
data SimpleDTD = SimpleDTD
{ SimpleDTD -> FiniteMap QName ContentSpec
elements :: FiniteMap QName ContentSpec
, SimpleDTD -> FiniteMap (QName, QName) AttType
attributes :: FiniteMap (QName,QName) AttType
, SimpleDTD -> FiniteMap QName [QName]
required :: FiniteMap QName [QName]
, SimpleDTD -> [(QName, QName)]
ids :: [(QName,QName)]
, SimpleDTD -> [(QName, QName)]
idrefs :: [(QName,QName)]
}
simplifyDTD :: DocTypeDecl -> SimpleDTD
simplifyDTD :: DocTypeDecl -> SimpleDTD
simplifyDTD (DTD QName
_ Maybe ExternalID
_ [MarkupDecl]
decls) =
SimpleDTD
{ elements :: FiniteMap QName ContentSpec
elements = forall a b. Ord a => [(a, b)] -> FiniteMap a b
listToFM [ (QName
name,ContentSpec
content)
| Element (ElementDecl QName
name ContentSpec
content) <- [MarkupDecl]
decls ]
, attributes :: FiniteMap (QName, QName) AttType
attributes = forall a b. Ord a => [(a, b)] -> FiniteMap a b
listToFM [ ((QName
elem,QName
attr),AttType
typ)
| AttList (AttListDecl QName
elem [AttDef]
attdefs) <- [MarkupDecl]
decls
, AttDef QName
attr AttType
typ DefaultDecl
_ <- [AttDef]
attdefs ]
, required :: FiniteMap QName [QName]
required = forall a b. Ord a => [(a, b)] -> FiniteMap a b
listToFM [ (QName
elem, forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [ [ QName
attr | AttDef QName
attr AttType
_ DefaultDecl
REQUIRED <- [AttDef]
attdefs ]
| AttList (AttListDecl QName
elem' [AttDef]
attdefs) <- [MarkupDecl]
decls
, QName
elem' forall a. Eq a => a -> a -> Bool
== QName
elem ]
)
| Element (ElementDecl QName
elem ContentSpec
_) <- [MarkupDecl]
decls ]
, ids :: [(QName, QName)]
ids = [ (QName
elem,QName
attr)
| Element (ElementDecl QName
elem ContentSpec
_) <- [MarkupDecl]
decls
, AttList (AttListDecl QName
name [AttDef]
attdefs) <- [MarkupDecl]
decls
, QName
elem forall a. Eq a => a -> a -> Bool
== QName
name
, AttDef QName
attr (TokenizedType TokenizedType
ID) DefaultDecl
_ <- [AttDef]
attdefs ]
, idrefs :: [(QName, QName)]
idrefs = []
}
gives :: Bool -> a -> [a]
Bool
True gives :: forall a. Bool -> a -> [a]
`gives` a
x = [a
x]
Bool
False `gives` a
_ = []
validate :: DocTypeDecl -> Element i -> [String]
validate :: forall i. DocTypeDecl -> Element i -> [String]
validate DocTypeDecl
dtd' Element i
elem = forall i. DocTypeDecl -> Element i -> [String]
root DocTypeDecl
dtd' Element i
elem forall a. [a] -> [a] -> [a]
++ forall i. DocTypeDecl -> Element i -> [String]
partialValidate DocTypeDecl
dtd' Element i
elem
where
root :: DocTypeDecl -> Element i -> [String]
root (DTD QName
name Maybe ExternalID
_ [MarkupDecl]
_) (Elem QName
name' [Attribute]
_ [Content i]
_) =
(QName
nameforall a. Eq a => a -> a -> Bool
/=QName
name') forall a. Bool -> a -> [a]
`gives` (String
"Document type should be <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
name
forall a. [a] -> [a] -> [a]
++String
"> but appears to be <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
name'forall a. [a] -> [a] -> [a]
++String
">.")
partialValidate :: DocTypeDecl -> Element i -> [String]
partialValidate :: forall i. DocTypeDecl -> Element i -> [String]
partialValidate DocTypeDecl
dtd' Element i
elem = forall {i}. Element i -> [String]
valid Element i
elem forall a. [a] -> [a] -> [a]
++ forall {i}. Element i -> [String]
checkIDs Element i
elem
where
dtd :: SimpleDTD
dtd = DocTypeDecl -> SimpleDTD
simplifyDTD DocTypeDecl
dtd'
valid :: Element i -> [String]
valid (Elem QName
name [Attribute]
attrs [Content i]
contents) =
let spec :: Maybe ContentSpec
spec = forall a b. Ord a => FiniteMap a b -> a -> Maybe b
lookupFM (SimpleDTD -> FiniteMap QName ContentSpec
elements SimpleDTD
dtd) QName
name in
forall a. Maybe a -> Bool
isNothing Maybe ContentSpec
spec forall a. Bool -> a -> [a]
`gives` (String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
nameforall a. [a] -> [a] -> [a]
++String
"> not known.")
forall a. [a] -> [a] -> [a]
++ (let dups :: [String]
dups = forall a. Eq a => [a] -> [a]
duplicates (forall a b. (a -> b) -> [a] -> [b]
map (QName -> String
qname forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a, b) -> a
fst) [Attribute]
attrs) in
Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
dups) forall a. Bool -> a -> [a]
`gives`
(String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
nameforall a. [a] -> [a] -> [a]
++String
"> has duplicate attributes: "
forall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
dupsforall a. [a] -> [a] -> [a]
++String
"."))
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (QName -> Attribute -> [String]
checkAttr QName
name) [Attribute]
attrs
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {b}. QName -> [(QName, b)] -> QName -> [String]
checkRequired QName
name [Attribute]
attrs)
(forall a. a -> Maybe a -> a
fromMaybe [] (forall a b. Ord a => FiniteMap a b -> a -> Maybe b
lookupFM (SimpleDTD -> FiniteMap QName [QName]
required SimpleDTD
dtd) QName
name))
forall a. [a] -> [a] -> [a]
++ forall {i}. QName -> ContentSpec -> [Content i] -> [String]
checkContentSpec QName
name (forall a. a -> Maybe a -> a
fromMaybe ContentSpec
ANY Maybe ContentSpec
spec) [Content i]
contents
forall a. [a] -> [a] -> [a]
++ forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap Element i -> [String]
valid [ Element i
elm | CElem Element i
elm i
_ <- [Content i]
contents ]
checkAttr :: QName -> Attribute -> [String]
checkAttr QName
elm (QName
attr, AttValue
val) =
let typ :: Maybe AttType
typ = forall a b. Ord a => FiniteMap a b -> a -> Maybe b
lookupFM (SimpleDTD -> FiniteMap (QName, QName) AttType
attributes SimpleDTD
dtd) (QName
elm,QName
attr)
attval :: String
attval = AttValue -> String
attr2str AttValue
val in
if forall a. Maybe a -> Bool
isNothing Maybe AttType
typ then [String
"Attribute \""forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
attr
forall a. [a] -> [a] -> [a]
++String
"\" not known for element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
">."]
else
case forall a. HasCallStack => Maybe a -> a
fromJust Maybe AttType
typ of
EnumeratedType EnumeratedType
e ->
case EnumeratedType
e of
Enumeration [String]
es ->
(String
attval forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [String]
es) forall a. Bool -> a -> [a]
`gives`
(String
"Value \""forall a. [a] -> [a] -> [a]
++String
attvalforall a. [a] -> [a] -> [a]
++String
"\" of attribute \""
forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
attrforall a. [a] -> [a] -> [a]
++String
"\" in element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elm
forall a. [a] -> [a] -> [a]
++String
"> is not in the required enumeration range: "
forall a. [a] -> [a] -> [a]
++[String] -> String
unwords [String]
es)
EnumeratedType
_ -> []
AttType
_ -> []
checkRequired :: QName -> [(QName, b)] -> QName -> [String]
checkRequired QName
elm [(QName, b)]
attrs QName
req =
(QName
req forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` forall a b. (a -> b) -> [a] -> [b]
map forall a b. (a, b) -> a
fst [(QName, b)]
attrs) forall a. Bool -> a -> [a]
`gives`
(String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
"> requires the attribute \""forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
req
forall a. [a] -> [a] -> [a]
++String
"\" but it is missing.")
checkContentSpec :: QName -> ContentSpec -> [Content i] -> [String]
checkContentSpec QName
_elm ContentSpec
ANY [Content i]
_ = []
checkContentSpec QName
_elm ContentSpec
EMPTY [] = []
checkContentSpec QName
elm ContentSpec
EMPTY (Content i
_:[Content i]
_) =
[String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
"> is not empty but should be."]
checkContentSpec QName
elm (Mixed Mixed
PCDATA) [Content i]
cs = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {t :: * -> *} {i}.
Foldable t =>
QName -> t QName -> Content i -> [String]
checkMixed QName
elm []) [Content i]
cs
checkContentSpec QName
elm (Mixed (PCDATAplus [QName]
names)) [Content i]
cs =
forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (forall {t :: * -> *} {i}.
Foldable t =>
QName -> t QName -> Content i -> [String]
checkMixed QName
elm [QName]
names) [Content i]
cs
checkContentSpec QName
elm (ContentSpec CP
cp) [Content i]
cs = forall {i}. QName -> [Content i] -> [String]
excludeText QName
elm [Content i]
cs forall a. [a] -> [a] -> [a]
++
(let ([String]
errs,[QName]
rest) = QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm CP
cp (forall {i}. [Content i] -> [QName]
flatten [Content i]
cs) in
case [QName]
rest of [] -> [String]
errs
[QName]
_ -> [String]
errsforall a. [a] -> [a] -> [a]
++[String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
"> contains extra "
forall a. [a] -> [a] -> [a]
++String
"elements beyond its content spec."])
checkMixed :: QName -> t QName -> Content i -> [String]
checkMixed QName
elm t QName
permitted (CElem (Elem QName
name [Attribute]
_ [Content i]
_) i
_)
| QName
name forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` t QName
permitted =
[String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
"> contains an element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
name
forall a. [a] -> [a] -> [a]
++String
"> but should not."]
checkMixed QName
_elm t QName
_permitted Content i
_ = []
flatten :: [Content i] -> [QName]
flatten (CElem (Elem QName
name [Attribute]
_ [Content i]
_) i
_: [Content i]
cs) = QName
nameforall a. a -> [a] -> [a]
: [Content i] -> [QName]
flatten [Content i]
cs
flatten (Content i
_: [Content i]
cs) = [Content i] -> [QName]
flatten [Content i]
cs
flatten [] = []
excludeText :: QName -> [Content i] -> [String]
excludeText QName
elm (CElem Element i
_ i
_: [Content i]
cs) = QName -> [Content i] -> [String]
excludeText QName
elm [Content i]
cs
excludeText QName
elm (CMisc Misc
_ i
_: [Content i]
cs) = QName -> [Content i] -> [String]
excludeText QName
elm [Content i]
cs
excludeText QName
elm (CString Bool
_ String
s i
_: [Content i]
cs) | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all Char -> Bool
isSpace String
s = QName -> [Content i] -> [String]
excludeText QName
elm [Content i]
cs
excludeText QName
elm (Content i
_:[Content i]
_) =
[String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
"> contains text/references but should not."]
excludeText QName
_elm [] = []
checkCP :: QName -> CP -> [QName] -> ([String],[QName])
checkCP :: QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm cp :: CP
cp@(TagName QName
_ Modifier
None) [] = (QName -> CP -> [String]
cpError QName
elm CP
cp, [])
checkCP QName
elm cp :: CP
cp@(TagName QName
n Modifier
None) (QName
n':[QName]
ns)
| QName
nforall a. Eq a => a -> a -> Bool
==QName
n' = ([], [QName]
ns)
| Bool
otherwise = (QName -> CP -> [String]
cpError QName
elm CP
cp, QName
n'forall a. a -> [a] -> [a]
:[QName]
ns)
checkCP QName
_ (TagName QName
_ Modifier
Query) [] = ([],[])
checkCP QName
_ (TagName QName
n Modifier
Query) (QName
n':[QName]
ns)
| QName
nforall a. Eq a => a -> a -> Bool
==QName
n' = ([], [QName]
ns)
| Bool
otherwise = ([], QName
n'forall a. a -> [a] -> [a]
:[QName]
ns)
checkCP QName
_ (TagName QName
_ Modifier
Star) [] = ([],[])
checkCP QName
elm (TagName QName
n Modifier
Star) (QName
n':[QName]
ns)
| QName
nforall a. Eq a => a -> a -> Bool
==QName
n' = QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm (QName -> Modifier -> CP
TagName QName
n Modifier
Star) [QName]
ns
| Bool
otherwise = ([], QName
n'forall a. a -> [a] -> [a]
:[QName]
ns)
checkCP QName
elm cp :: CP
cp@(TagName QName
_ Modifier
Plus) [] = (QName -> CP -> [String]
cpError QName
elm CP
cp, [])
checkCP QName
elm cp :: CP
cp@(TagName QName
n Modifier
Plus) (QName
n':[QName]
ns)
| QName
nforall a. Eq a => a -> a -> Bool
==QName
n' = QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm (QName -> Modifier -> CP
TagName QName
n Modifier
Star) [QName]
ns
| Bool
otherwise = (QName -> CP -> [String]
cpError QName
elm CP
cp, QName
n'forall a. a -> [a] -> [a]
:[QName]
ns)
checkCP QName
elm cp :: CP
cp@(Choice [CP]
cps Modifier
None) [QName]
ns =
let next :: [[QName]]
next = QName -> [QName] -> [CP] -> [[QName]]
choice QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[QName]]
next then (QName -> CP -> [String]
cpError QName
elm CP
cp, [QName]
ns)
else ([], forall a. [a] -> a
head [[QName]]
next)
checkCP QName
_ (Choice [CP]
_ Modifier
Query) [] = ([],[])
checkCP QName
elm (Choice [CP]
cps Modifier
Query) [QName]
ns =
let next :: [[QName]]
next = QName -> [QName] -> [CP] -> [[QName]]
choice QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[QName]]
next then ([],[QName]
ns)
else ([], forall a. [a] -> a
head [[QName]]
next)
checkCP QName
_ (Choice [CP]
_ Modifier
Star) [] = ([],[])
checkCP QName
elm (Choice [CP]
cps Modifier
Star) [QName]
ns =
let next :: [[QName]]
next = QName -> [QName] -> [CP] -> [[QName]]
choice QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[QName]]
next then ([],[QName]
ns)
else QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm ([CP] -> Modifier -> CP
Choice [CP]
cps Modifier
Star) (forall a. [a] -> a
head [[QName]]
next)
checkCP QName
elm cp :: CP
cp@(Choice [CP]
_ Modifier
Plus) [] = (QName -> CP -> [String]
cpError QName
elm CP
cp, [])
checkCP QName
elm cp :: CP
cp@(Choice [CP]
cps Modifier
Plus) [QName]
ns =
let next :: [[QName]]
next = QName -> [QName] -> [CP] -> [[QName]]
choice QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [[QName]]
next then (QName -> CP -> [String]
cpError QName
elm CP
cp, [QName]
ns)
else QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm ([CP] -> Modifier -> CP
Choice [CP]
cps Modifier
Star) (forall a. [a] -> a
head [[QName]]
next)
checkCP QName
elm cp :: CP
cp@(Seq [CP]
cps Modifier
None) [QName]
ns =
let ([String]
errs,[QName]
next) = forall {t :: * -> *}.
Foldable t =>
QName -> [QName] -> t CP -> ([String], [QName])
sequence QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs then ([],[QName]
next)
else (QName -> CP -> [String]
cpError QName
elm CP
cpforall a. [a] -> [a] -> [a]
++[String]
errs, [QName]
ns)
checkCP QName
_ (Seq [CP]
_ Modifier
Query) [] = ([],[])
checkCP QName
elm (Seq [CP]
cps Modifier
Query) [QName]
ns =
let ([String]
errs,[QName]
next) = forall {t :: * -> *}.
Foldable t =>
QName -> [QName] -> t CP -> ([String], [QName])
sequence QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs then ([],[QName]
next)
else ([], [QName]
ns)
checkCP QName
_ (Seq [CP]
_ Modifier
Star) [] = ([],[])
checkCP QName
elm (Seq [CP]
cps Modifier
Star) [QName]
ns =
let ([String]
errs,[QName]
next) = forall {t :: * -> *}.
Foldable t =>
QName -> [QName] -> t CP -> ([String], [QName])
sequence QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs then QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm ([CP] -> Modifier -> CP
Seq [CP]
cps Modifier
Star) [QName]
next
else ([], [QName]
ns)
checkCP QName
elm cp :: CP
cp@(Seq [CP]
_ Modifier
Plus) [] = (QName -> CP -> [String]
cpError QName
elm CP
cp, [])
checkCP QName
elm cp :: CP
cp@(Seq [CP]
cps Modifier
Plus) [QName]
ns =
let ([String]
errs,[QName]
next) = forall {t :: * -> *}.
Foldable t =>
QName -> [QName] -> t CP -> ([String], [QName])
sequence QName
elm [QName]
ns [CP]
cps in
if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
errs then QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm ([CP] -> Modifier -> CP
Seq [CP]
cps Modifier
Star) [QName]
next
else (QName -> CP -> [String]
cpError QName
elm CP
cpforall a. [a] -> [a] -> [a]
++[String]
errs, [QName]
ns)
choice :: QName -> [QName] -> [CP] -> [[QName]]
choice QName
elm [QName]
ns [CP]
cps =
[ [QName]
rem | ([],[QName]
rem) <- forall a b. (a -> b) -> [a] -> [b]
map (\CP
cp-> QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm (CP -> CP
definite CP
cp) [QName]
ns) [CP]
cps ]
forall a. [a] -> [a] -> [a]
++ [ [QName]
ns | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CP -> Bool
possEmpty [CP]
cps ]
where definite :: CP -> CP
definite (TagName QName
n Modifier
Query) = QName -> Modifier -> CP
TagName QName
n Modifier
None
definite (Choice [CP]
cps Modifier
Query) = [CP] -> Modifier -> CP
Choice [CP]
cps Modifier
None
definite (Seq [CP]
cps Modifier
Query) = [CP] -> Modifier -> CP
Seq [CP]
cps Modifier
None
definite (TagName QName
n Modifier
Star) = QName -> Modifier -> CP
TagName QName
n Modifier
Plus
definite (Choice [CP]
cps Modifier
Star) = [CP] -> Modifier -> CP
Choice [CP]
cps Modifier
Plus
definite (Seq [CP]
cps Modifier
Star) = [CP] -> Modifier -> CP
Seq [CP]
cps Modifier
Plus
definite CP
x = CP
x
possEmpty :: CP -> Bool
possEmpty (TagName QName
_ Modifier
mod) = Modifier
mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Modifier
Query,Modifier
Star]
possEmpty (Choice [CP]
cps Modifier
None) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CP -> Bool
possEmpty [CP]
cps
possEmpty (Choice [CP]
_ Modifier
mod) = Modifier
mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Modifier
Query,Modifier
Star]
possEmpty (Seq [CP]
cps Modifier
None) = forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
all CP -> Bool
possEmpty [CP]
cps
possEmpty (Seq [CP]
_ Modifier
mod) = Modifier
mod forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`Prelude.elem` [Modifier
Query,Modifier
Star]
sequence :: QName -> [QName] -> t CP -> ([String], [QName])
sequence QName
elm [QName]
ns t CP
cps =
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl (\([String]
es,[QName]
ns) CP
cp-> let ([String]
es',[QName]
ns') = QName -> CP -> [QName] -> ([String], [QName])
checkCP QName
elm CP
cp [QName]
ns
in ([String]
esforall a. [a] -> [a] -> [a]
++[String]
es', [QName]
ns'))
([],[QName]
ns) t CP
cps
checkIDs :: Element i -> [String]
checkIDs Element i
elm =
let celem :: Content i
celem = forall i. Element i -> i -> Content i
CElem Element i
elm forall a. HasCallStack => a
undefined
showAttr :: QName -> CFilter i
showAttr QName
a = forall i. String -> (String -> CFilter i) -> CFilter i -> CFilter i
iffind (QName -> String
printableName QName
a) forall i. String -> CFilter i
literal forall a b. a -> [b]
none
idElems :: [Content i]
idElems = forall (t :: * -> *) a b. Foldable t => (a -> [b]) -> t a -> [b]
concatMap (\(QName
name, QName
at)->
forall i. CFilter i -> CFilter i
multi (forall {i}. QName -> CFilter i
showAttr QName
at forall i. CFilter i -> CFilter i -> CFilter i
`o`
forall i. String -> CFilter i
tag (QName -> String
printableName QName
name))
Content i
celem)
(SimpleDTD -> [(QName, QName)]
ids SimpleDTD
dtd)
badIds :: [String]
badIds = forall a. Eq a => [a] -> [a]
duplicates (forall a b. (a -> b) -> [a] -> [b]
map (\(CString Bool
_ String
s i
_)->String
s) [Content i]
idElems)
in Bool -> Bool
not (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [String]
badIds) forall a. Bool -> a -> [a]
`gives`
(String
"These attribute values of type ID are not unique: "
forall a. [a] -> [a] -> [a]
++forall a. [a] -> [[a]] -> [a]
intercalate String
"," [String]
badIdsforall a. [a] -> [a] -> [a]
++String
".")
cpError :: QName -> CP -> [String]
cpError :: QName -> CP -> [String]
cpError QName
elm CP
cp =
[String
"Element <"forall a. [a] -> [a] -> [a]
++QName -> String
qname QName
elmforall a. [a] -> [a] -> [a]
++String
"> should contain "forall a. [a] -> [a] -> [a]
++CP -> String
display CP
cpforall a. [a] -> [a] -> [a]
++String
" but does not."]
display :: CP -> String
display :: CP -> String
display (TagName QName
name Modifier
mod) = QName -> String
qname QName
name forall a. [a] -> [a] -> [a]
++ Modifier -> String
modifier Modifier
mod
display (Choice [CP]
cps Modifier
mod) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"|" (forall a b. (a -> b) -> [a] -> [b]
map CP -> String
display [CP]
cps)
forall a. [a] -> [a] -> [a]
++ String
")" forall a. [a] -> [a] -> [a]
++ Modifier -> String
modifier Modifier
mod
display (Seq [CP]
cps Modifier
mod) = String
"(" forall a. [a] -> [a] -> [a]
++ forall a. [a] -> [[a]] -> [a]
intercalate String
"," (forall a b. (a -> b) -> [a] -> [b]
map CP -> String
display [CP]
cps)
forall a. [a] -> [a] -> [a]
++ String
")" forall a. [a] -> [a] -> [a]
++ Modifier -> String
modifier Modifier
mod
modifier :: Modifier -> String
modifier :: Modifier -> String
modifier Modifier
None = String
""
modifier Modifier
Query = String
"?"
modifier Modifier
Star = String
"*"
modifier Modifier
Plus = String
"+"
duplicates :: Eq a => [a] -> [a]
duplicates :: forall a. Eq a => [a] -> [a]
duplicates [a]
xs = [a]
xs forall a. Eq a => [a] -> [a] -> [a]
\\ forall a. Eq a => [a] -> [a]
nub [a]
xs
qname :: QName -> String
qname :: QName -> String
qname QName
n = QName -> String
printableName QName
n