{-# LANGUAGE OverloadedStrings #-}
module HaskellWorks.Data.Xml.Decode where
import Control.Applicative
import Control.Lens
import Control.Monad
import Data.Foldable
import Data.Text (Text)
import HaskellWorks.Data.Xml.DecodeError
import HaskellWorks.Data.Xml.DecodeResult
import HaskellWorks.Data.Xml.Internal.Show
import HaskellWorks.Data.Xml.Value
class Decode a where
decode :: Value -> DecodeResult a
instance Decode Value where
decode :: Value -> DecodeResult Value
decode = Value -> DecodeResult Value
forall a. a -> DecodeResult a
DecodeOk
{-# INLINE decode #-}
failDecode :: Text -> DecodeResult a
failDecode :: Text -> DecodeResult a
failDecode = DecodeError -> DecodeResult a
forall a. DecodeError -> DecodeResult a
DecodeFailed (DecodeError -> DecodeResult a)
-> (Text -> DecodeError) -> Text -> DecodeResult a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> DecodeError
DecodeError
(@>) :: Value -> Text -> DecodeResult Text
@> :: Value -> Text -> DecodeResult Text
(@>) (XmlElement Text
_ [(Text, Text)]
as [Value]
_) Text
n = case ((Text, Text) -> Bool) -> [(Text, Text)] -> Maybe (Text, Text)
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
find (\(Text, Text)
v -> (Text, Text) -> Text
forall a b. (a, b) -> a
fst (Text, Text)
v Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n) [(Text, Text)]
as of
Just (Text
_, Text
text) -> Text -> DecodeResult Text
forall a. a -> DecodeResult a
DecodeOk Text
text
Maybe (Text, Text)
Nothing -> Text -> DecodeResult Text
forall a. Text -> DecodeResult a
failDecode (Text -> DecodeResult Text) -> Text -> DecodeResult Text
forall a b. (a -> b) -> a -> b
$ Text
"No such attribute " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
n
(@>) Value
_ Text
n = Text -> DecodeResult Text
forall a. Text -> DecodeResult a
failDecode (Text -> DecodeResult Text) -> Text -> DecodeResult Text
forall a b. (a -> b) -> a -> b
$ Text
"Not an element whilst looking up attribute " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
n
(/>) :: Value -> Text -> DecodeResult Value
/> :: Value -> Text -> DecodeResult Value
(/>) (XmlElement Text
_ [(Text, Text)]
_ [Value]
cs) Text
n = [Value] -> DecodeResult Value
go [Value]
cs
where go :: [Value] -> DecodeResult Value
go [] = Text -> DecodeResult Value
forall a. Text -> DecodeResult a
failDecode (Text -> DecodeResult Value) -> Text -> DecodeResult Value
forall a b. (a -> b) -> a -> b
$ Text
"Unable to find element " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
n
go (Value
r:[Value]
rs) = case Value
r of
e :: Value
e@(XmlElement Text
n' [(Text, Text)]
_ [Value]
_) | Text
n' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n -> Value -> DecodeResult Value
forall a. a -> DecodeResult a
DecodeOk Value
e
Value
_ -> [Value] -> DecodeResult Value
go [Value]
rs
(/>) Value
_ Text
n = Text -> DecodeResult Value
forall a. Text -> DecodeResult a
failDecode (Text -> DecodeResult Value) -> Text -> DecodeResult Value
forall a b. (a -> b) -> a -> b
$ Text
"Expecting parent of element " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
n
(?>) :: Value -> (Value -> DecodeResult Value) -> DecodeResult Value
?> :: Value -> (Value -> DecodeResult Value) -> DecodeResult Value
(?>) Value
v Value -> DecodeResult Value
f = Value -> DecodeResult Value
f Value
v DecodeResult Value -> DecodeResult Value -> DecodeResult Value
forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Value -> DecodeResult Value
forall (f :: * -> *) a. Applicative f => a -> f a
pure Value
v
(~>) :: Value -> Text -> DecodeResult Value
~> :: Value -> Text -> DecodeResult Value
(~>) e :: Value
e@(XmlElement Text
n' [(Text, Text)]
_ [Value]
_) Text
n | Text
n' Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n = Value -> DecodeResult Value
forall a. a -> DecodeResult a
DecodeOk Value
e
(~>) Value
_ Text
n = Text -> DecodeResult Value
forall a. Text -> DecodeResult a
failDecode (Text -> DecodeResult Value) -> Text -> DecodeResult Value
forall a b. (a -> b) -> a -> b
$ Text
"Expecting parent of element " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text -> Text
forall a. Show a => a -> Text
tshow Text
n
(/>>) :: Value -> Text -> DecodeResult [Value]
/>> :: Value -> Text -> DecodeResult [Value]
(/>>) Value
v Text
n = Value
v Value -> Getting [Value] Value [Value] -> [Value]
forall s a. s -> Getting a s a -> a
^. Getting [Value] Value [Value]
forall c. HasValue c => Traversal' c [Value]
childNodes [Value] -> (Value -> DecodeResult Value) -> [DecodeResult Value]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> (Value -> Text -> DecodeResult Value
~> Text
n) [DecodeResult Value]
-> (DecodeResult Value -> [Value]) -> [[Value]]
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> DecodeResult Value -> [Value]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList [[Value]] -> ([[Value]] -> [Value]) -> [Value]
forall a b. a -> (a -> b) -> b
& [[Value]] -> [Value]
forall (m :: * -> *) a. Monad m => m (m a) -> m a
join [Value]
-> ([Value] -> DecodeResult [Value]) -> DecodeResult [Value]
forall a b. a -> (a -> b) -> b
& [Value] -> DecodeResult [Value]
forall (f :: * -> *) a. Applicative f => a -> f a
pure
(</>) :: DecodeResult Value -> Text -> DecodeResult Value
</> :: DecodeResult Value -> Text -> DecodeResult Value
(</>) DecodeResult Value
ma Text
n = DecodeResult Value
ma DecodeResult Value
-> (Value -> DecodeResult Value) -> DecodeResult Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Text -> DecodeResult Value
/> Text
n)
(<@>) :: DecodeResult Value -> Text -> DecodeResult Text
<@> :: DecodeResult Value -> Text -> DecodeResult Text
(<@>) DecodeResult Value
ma Text
n = DecodeResult Value
ma DecodeResult Value
-> (Value -> DecodeResult Text) -> DecodeResult Text
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> Text -> DecodeResult Text
@> Text
n)
(<?>) :: DecodeResult Value -> (Value -> DecodeResult Value) -> DecodeResult Value
<?> :: DecodeResult Value
-> (Value -> DecodeResult Value) -> DecodeResult Value
(<?>) DecodeResult Value
ma Value -> DecodeResult Value
f = DecodeResult Value
ma DecodeResult Value
-> (Value -> DecodeResult Value) -> DecodeResult Value
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= (Value -> (Value -> DecodeResult Value) -> DecodeResult Value
?> Value -> DecodeResult Value
f)