@@ -0,0 +1,31 @@
1+{-# LANGUAGE OverloadedStrings #-}
2+{-# LANGUAGE MonoLocalBinds #-}
3+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4+
5+module Text.XML.Nillable
6+where
7+
8+import Control.DeepSeq
9+import Text.XML.DOM.Parser
10+import Text.XML.Writer
11+import Text.XML.ParentAttributes
12+
13+-- | Type that can have explicit null value
14+--
15+-- Null value is indicated by "nil"="true" attribute.
16+newtype Nillable a = Nillable (Maybe a)
17+ deriving (Eq, Show, Ord, Read, NFData, ToXML)
18+
19+instance ToXmlParentAttributes a => ToXmlParentAttributes (Nillable a) where
20+ toXmlParentAttributes (Nillable Nothing) =
21+ [("{http://www.w3.org/2001/XMLSchema-instance}nil", "true")]
22+ toXmlParentAttributes (Nillable (Just a)) = toXmlParentAttributes a
23+
24+instance FromDom a => FromDom (Nillable a) where
25+ fromDom = do
26+ nil <- parseAttributeMaybe
27+ (matchName "{http://www.w3.org/2001/XMLSchema-instance}nil")
28+ Right
29+ case nil of
30+ Just "true" -> return (Nillable Nothing)
31+ _ -> Nillable . Just <$> fromDom