generic-xml-0.1: Xml/Instances.hs

{-# LANGUAGE TemplateHaskell, FlexibleInstances,
             OverlappingInstances, UndecidableInstances #-}

module Xml.Instances where

import Data.Char
import Data.List
import Xml.Base
import Data.Generics.SYB.WithClass.Basics
import Data.Generics.SYB.WithClass.Derive
import Data.Generics.SYB.WithClass.Instances ()
import Data.Maybe
import           Data.ByteString.Char8 (ByteString)
import qualified Data.ByteString.Char8 as BS

-- The Xml [a] context is a bit scary, but if we don't have it then
-- GHC complains about overlapping instances
instance (Xml a, Xml [a]) => Xml [a] where
    toXml = concatMap toXml
    readXml = f [] []
        where f acc_xs acc_vs [] = Just (reverse acc_xs, reverse acc_vs)
              f acc_xs acc_vs (x:xs) = case readXml [x] of
                                           Just ([], v) ->
                                               f acc_xs (v:acc_vs) xs
                                           _ ->
                                               f (x:acc_xs) acc_vs xs

instance Xml String where
    toXml x = [CData x]
    readXml = fromXmlWith f
        where f (CData x) = Just x
              f _ = Nothing

-- XXX This instance should be somewhere else as otherwise we get
-- problems when two different traversals define it
$( deriveData [''ByteString] )

instance Xml ByteString where
    toXml x = [CData $ BS.unpack x]
    readXml = fromXmlWith f
        where f (CData x) = Just $ BS.pack x
              f _ = Nothing

$( xmlShowCDatas [''Int, ''Integer, ''Float, ''Double] )

instance Xml a => Xml (Maybe a) where
    toXml = transparentToXml
    -- We can't use transparentReadXml or Nothing would always win, as
    -- it is first in the list of constructors
    readXml = aConstrFromElements $ map (toConstr xmlProxy) [Just (), Nothing]

$( transparentXml ''Either )
$( transparentXml ''(,) )
$( transparentXml ''(,,) )
$( transparentXml ''(,,,) )