{-# 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
    }
  | XmlComment
    { Value -> Text
_comment :: 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)

makeClassy ''Value
makePrisms ''Value

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 []                                = []