XML: add ncName

diff --git a/Language/Symantic/XML/Document.hs b/Language/Symantic/XML/Document.hs
index 1cb9797177a9c73bc4a996aea60a5dc831c165fc..62087b28e52b02aca344c3e704b582ae3b32c84d 100644 (file)
--- a/Language/Symantic/XML/Document.hs
+++ b/Language/Symantic/XML/Document.hs
@@ -25,7 +25,7 @@ import Data.Functor (Functor(..), (<$>))
 import Data.Hashable (Hashable(..))
 import Data.Int (Int)
 import Data.List.NonEmpty (NonEmpty(..))
-import Data.Maybe (Maybe(..))
+import Data.Maybe (Maybe(..), fromMaybe)
 import Data.Monoid (Monoid(..))
 import Data.Ord (Ord(..))
 import Data.Semigroup (Semigroup(..))
@@ -196,12 +196,18 @@ newtype NCName = NCName { unNCName :: TL.Text }
 instance Show NCName where
        showsPrec _p = showString . TL.unpack . unNCName
 instance IsString NCName where
-       fromString s
-        | c:cs <- s
-        , XC.isXmlNCNameStartChar c
-        && all XC.isXmlNCNameChar cs
-        = NCName (TL.pack s)
-        | otherwise = error "Invalid XML NCName"
+       fromString s =
+               fromMaybe (error "Invalid XML NCName") $
+               ncName (TL.pack s)
+
+ncName :: TL.Text -> Maybe NCName
+ncName t =
+       case TL.uncons t of
+        Just (c, cs)
+         | XC.isXmlNCNameStartChar c
+         , TL.all XC.isXmlNCNameChar cs
+         -> Just (NCName t)
+        _ -> Nothing
 
 poolNCNames :: [NCName]
 poolNCNames =