{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE InstanceSigs #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE TupleSections #-}
module HaskellWorks.Data.Xml.Value
( Value(..)
, HasValue(..)
, _XmlDocument
, _XmlText
, _XmlElement
, _XmlCData
, _XmlComment
, _XmlMeta
, _XmlError
) where
import Control.Lens
import Data.Text (Text)
import HaskellWorks.Data.Xml.Internal.Show
import HaskellWorks.Data.Xml.RawDecode
import HaskellWorks.Data.Xml.RawValue
data Value
= XmlDocument
{ Value -> [Value]
_childNodes :: [Value]
}
| XmlText
{ Value -> Text
_textValue :: Text
}
| XmlElement
{ Value -> Text
_name :: Text
, Value -> [(Text, Text)]
_attributes :: [(Text, Text)]
, _childNodes :: [Value]
}
| XmlCData
{ Value -> Text
_cdata :: Text
}
|
{ :: Text
}
| XmlMeta
{ _name :: Text
, _childNodes :: [Value]
}
| XmlError
{ Value -> Text
_errorMessage :: Text
}
deriving (Value -> Value -> Bool
(Value -> Value -> Bool) -> (Value -> Value -> Bool) -> Eq Value
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Value -> Value -> Bool
== :: Value -> Value -> Bool
$c/= :: Value -> Value -> Bool
/= :: Value -> Value -> Bool
Eq, Int -> Value -> ShowS
[Value] -> ShowS
Value -> String
(Int -> Value -> ShowS)
-> (Value -> String) -> ([Value] -> ShowS) -> Show Value
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Value -> ShowS
showsPrec :: Int -> Value -> ShowS
$cshow :: Value -> String
show :: Value -> String
$cshowList :: [Value] -> ShowS
showList :: [Value] -> ShowS
Show)
instance RawDecode Value where
rawDecode :: RawValue -> Value
rawDecode (RawDocument [RawValue]
rvs ) = [Value] -> Value
XmlDocument (RawValue -> Value
forall a. RawDecode a => RawValue -> a
rawDecode (RawValue -> Value) -> [RawValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawValue]
rvs)
rawDecode (RawText Text
text ) = Text -> Value
XmlText Text
text
rawDecode (RawElement Text
n [RawValue]
cs ) = Text -> [RawValue] -> Value
mkXmlElement Text
n [RawValue]
cs
rawDecode (RawCData Text
text ) = Text -> Value
XmlCData Text
text
rawDecode (RawComment Text
text ) = Text -> Value
XmlComment Text
text
rawDecode (RawMeta Text
n [RawValue]
cs ) = Text -> [Value] -> Value
XmlMeta Text
n (RawValue -> Value
forall a. RawDecode a => RawValue -> a
rawDecode (RawValue -> Value) -> [RawValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawValue]
cs)
rawDecode (RawAttrName Text
nameValue ) = Text -> Value
XmlError (Text
"Can't decode attribute name: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
nameValue)
rawDecode (RawAttrValue Text
attrValue ) = Text -> Value
XmlError (Text
"Can't decode attribute value: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
attrValue)
rawDecode (RawAttrList [RawValue]
as ) = Text -> Value
XmlError (Text
"Can't decode attribute list: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [RawValue] -> Text
forall a. Show a => a -> Text
tshow [RawValue]
as)
rawDecode (RawError Text
msg ) = Text -> Value
XmlError Text
msg
mkXmlElement :: Text -> [RawValue] -> Value
mkXmlElement :: Text -> [RawValue] -> Value
mkXmlElement Text
n (RawAttrList [RawValue]
as:[RawValue]
cs) = Text -> [(Text, Text)] -> [Value] -> Value
XmlElement Text
n ([RawValue] -> [(Text, Text)]
mkAttrs [RawValue]
as) (RawValue -> Value
forall a. RawDecode a => RawValue -> a
rawDecode (RawValue -> Value) -> [RawValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawValue]
cs)
mkXmlElement Text
n [RawValue]
cs = Text -> [(Text, Text)] -> [Value] -> Value
XmlElement Text
n [] (RawValue -> Value
forall a. RawDecode a => RawValue -> a
rawDecode (RawValue -> Value) -> [RawValue] -> [Value]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [RawValue]
cs)
mkAttrs :: [RawValue] -> [(Text, Text)]
mkAttrs :: [RawValue] -> [(Text, Text)]
mkAttrs (RawAttrName Text
n:RawAttrValue Text
v:[RawValue]
cs) = (Text
n, Text
v)(Text, Text) -> [(Text, Text)] -> [(Text, Text)]
forall a. a -> [a] -> [a]
:[RawValue] -> [(Text, Text)]
mkAttrs [RawValue]
cs
mkAttrs (RawValue
_:[RawValue]
cs) = [RawValue] -> [(Text, Text)]
mkAttrs [RawValue]
cs
mkAttrs [] = []