{-# LANGUAGE TypeSynonymInstances #-}
{- |
Module      :  ./Common/XmlParser.hs
Description :  Interface to the Xml Parsing Facility
Copyright   :  (c) Ewaryst Schulz, DFKI 2009
License     :  GPLv2 or higher, see LICENSE.txt

Maintainer  :  ewaryst.schulz@dfki.de
Stability   :  provisional
Portability :  portable

Provides an xml parse function which depends on external libraries.
-}


module Common.XmlParser (XmlParseable (parseXml), readXmlFile) where

import Text.XML.Light
import qualified Xeno.DOM as Xeno
import Data.ByteString.UTF8 (toString)
import qualified Control.Monad.Fail as Fail

import qualified Data.ByteString as BS

readXmlFile :: FilePath -> IO BS.ByteString
readXmlFile :: FilePath -> IO ByteString
readXmlFile fp :: FilePath
fp = do
  ByteString
bs <- FilePath -> IO ByteString
BS.readFile FilePath
fp
  if ByteString -> Int
BS.length ByteString
bs Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> 0 then ByteString -> IO ByteString
forall (m :: * -> *) a. Monad m => a -> m a
return ByteString
bs else
      FilePath -> IO ByteString
forall (m :: * -> *) a. MonadFail m => FilePath -> m a
Fail.fail "Common.XmlParser.readXmlFile: empty file"

parseXmlXeno :: BS.ByteString -> Either String Element
parseXmlXeno :: ByteString -> Either FilePath Element
parseXmlXeno s :: ByteString
s = case ByteString -> Either XenoException Node
Xeno.parse ByteString
s of
  Left err :: XenoException
err -> FilePath -> Either FilePath Element
forall a b. a -> Either a b
Left (FilePath -> Either FilePath Element)
-> FilePath -> Either FilePath Element
forall a b. (a -> b) -> a -> b
$ XenoException -> FilePath
forall a. Show a => a -> FilePath
show XenoException
err
  Right nd :: Node
nd -> let Elem e :: Element
e = Node -> Content
xenoNodeToContent Node
nd
    in Element -> Either FilePath Element
forall a b. b -> Either a b
Right Element
e

xenoNodeToContent :: Xeno.Node -> Content
xenoNodeToContent :: Node -> Content
xenoNodeToContent nd :: Node
nd =
  Element -> Content
Elem (Element -> Content) -> Element -> Content
forall a b. (a -> b) -> a -> b
$
    Element
blank_element
      { elName :: QName
elName = ByteString -> QName
strToQName (Node -> ByteString
Xeno.name Node
nd),
        elAttribs :: [Attr]
elAttribs = ((ByteString, ByteString) -> Attr)
-> [(ByteString, ByteString)] -> [Attr]
forall a b. (a -> b) -> [a] -> [b]
map (ByteString, ByteString) -> Attr
attrToAttr (Node -> [(ByteString, ByteString)]
Xeno.attributes Node
nd),
        elContent :: [Content]
elContent = [Content] -> [Content]
xenoContentToContent (Node -> [Content]
Xeno.contents Node
nd)
      }

xenoContentToContent :: [Xeno.Content] -> [Content]
xenoContentToContent :: [Content] -> [Content]
xenoContentToContent (Xeno.Text t :: ByteString
t : xs :: [Content]
xs) = FilePath -> Content
strToCData (ByteString -> FilePath
toString ByteString
t) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
xenoContentToContent [Content]
xs
xenoContentToContent (Xeno.CData t :: ByteString
t : xs :: [Content]
xs) = FilePath -> Content
strToCData (ByteString -> FilePath
toString ByteString
t) Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
xenoContentToContent [Content]
xs
xenoContentToContent (Xeno.Element nd :: Node
nd : xs :: [Content]
xs) = Node -> Content
xenoNodeToContent Node
nd Content -> [Content] -> [Content]
forall a. a -> [a] -> [a]
: [Content] -> [Content]
xenoContentToContent [Content]
xs
xenoContentToContent _ = []

strToCData :: String -> Content
strToCData :: FilePath -> Content
strToCData s :: FilePath
s = CData -> Content
Text (CData -> Content) -> CData -> Content
forall a b. (a -> b) -> a -> b
$ CData
blank_cdata { cdData :: FilePath
cdData = FilePath
s }


attrToAttr :: (BS.ByteString, BS.ByteString) -> Attr
attrToAttr :: (ByteString, ByteString) -> Attr
attrToAttr (n :: ByteString
n, v :: ByteString
v) = Attr :: QName -> FilePath -> Attr
Attr { attrKey :: QName
attrKey = ByteString -> QName
strToQName ByteString
n
                         , attrVal :: FilePath
attrVal = ByteString -> FilePath
toString ByteString
v }

strToQName :: BS.ByteString -> QName
strToQName :: ByteString -> QName
strToQName s :: ByteString
s = case (Char -> Bool) -> FilePath -> (FilePath, FilePath)
forall a. (a -> Bool) -> [a] -> ([a], [a])
break (':' Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
==) (FilePath -> (FilePath, FilePath))
-> FilePath -> (FilePath, FilePath)
forall a b. (a -> b) -> a -> b
$ ByteString -> FilePath
toString ByteString
s of
                 (n :: FilePath
n, []) -> FilePath -> QName
unqual FilePath
n
                 (pr :: FilePath
pr, _ : n :: FilePath
n) -> QName
blank_name { qName :: FilePath
qName = FilePath
n, qPrefix :: Maybe FilePath
qPrefix = FilePath -> Maybe FilePath
forall a. a -> Maybe a
Just FilePath
pr }

class XmlParseable a where
  parseXml :: a -> IO (Either String Element)

instance XmlParseable BS.ByteString where
  parseXml :: ByteString -> IO (Either FilePath Element)
parseXml = Either FilePath Element -> IO (Either FilePath Element)
forall (m :: * -> *) a. Monad m => a -> m a
return (Either FilePath Element -> IO (Either FilePath Element))
-> (ByteString -> Either FilePath Element)
-> ByteString
-> IO (Either FilePath Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Either FilePath Element
parseXmlXeno