module Text.XML.DOM.Parser.Attributes
  ( parseAttribute
  , parseAttributeMaybe
  , getCurrentAttributes
  , getCurrentAttribute
  ) where

import Control.Lens
import Data.Map.Strict as M
import Data.Text as T
import Text.XML.DOM.Parser.Types
import Text.XML.Lens

-- | Parses attribute with given name, throws error if attribute is not found.
--
-- @since 1.0.0
parseAttribute
  :: (Monad m)
  => NameMatcher
     -- ^ Attribute name
  -> (Text -> Either Text a)
     -- ^ Attribute content parser
  -> DomParserT Identity m a
parseAttribute :: forall (m :: * -> *) a.
Monad m =>
NameMatcher -> (Text -> Either Text a) -> DomParserT Identity m a
parseAttribute NameMatcher
attrName Text -> Either Text a
parser =
  NameMatcher
-> (Text -> Either Text a) -> DomParserT Identity m (Maybe a)
forall (m :: * -> *) a.
Monad m =>
NameMatcher
-> (Text -> Either Text a) -> DomParserT Identity m (Maybe a)
parseAttributeMaybe NameMatcher
attrName Text -> Either Text a
parser DomParserT Identity m (Maybe a)
-> (Maybe a
    -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall a b.
ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
-> (a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) b)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe a
Nothing -> (DomPath -> ParserError)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall (m :: * -> *) (f :: * -> *) a.
(MonadError ParserErrors m, MonadReader (ParserData f) m) =>
(DomPath -> ParserError) -> m a
throwParserError ((DomPath -> ParserError)
 -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a)
-> (DomPath -> ParserError)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall a b. (a -> b) -> a -> b
$ NameMatcher -> DomPath -> ParserError
PEAttributeNotFound NameMatcher
attrName
    Just a
a  -> a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall a.
a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall (m :: * -> *) a. Monad m => a -> m a
return a
a

-- | Parses attribute with given name. Returns Nothing if attribute is
-- not found.
--
-- @since 1.0.0
parseAttributeMaybe
  :: (Monad m)
  => NameMatcher
     -- ^ Attribute name
  -> (Text -> Either Text a)
     -- ^ Attribute content parser
  -> DomParserT Identity m (Maybe a)
parseAttributeMaybe :: forall (m :: * -> *) a.
Monad m =>
NameMatcher
-> (Text -> Either Text a) -> DomParserT Identity m (Maybe a)
parseAttributeMaybe NameMatcher
attrName Text -> Either Text a
parser =
  NameMatcher -> DomParserT Identity m (Maybe Text)
forall (m :: * -> *).
Monad m =>
NameMatcher -> DomParserT Identity m (Maybe Text)
getCurrentAttribute NameMatcher
attrName DomParserT Identity m (Maybe Text)
-> (Maybe Text
    -> ReaderT
         (ParserData Identity) (ExceptT ParserErrors m) (Maybe a))
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe a)
forall a b.
ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
-> (a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) b)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Maybe Text
Nothing   -> Maybe a
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe a)
forall a.
a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe a
forall a. Maybe a
Nothing
    Just Text
aval -> case Text -> Either Text a
parser Text
aval of
      Left Text
err -> (DomPath -> ParserError)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe a)
forall (m :: * -> *) (f :: * -> *) a.
(MonadError ParserErrors m, MonadReader (ParserData f) m) =>
(DomPath -> ParserError) -> m a
throwParserError ((DomPath -> ParserError)
 -> ReaderT
      (ParserData Identity) (ExceptT ParserErrors m) (Maybe a))
-> (DomPath -> ParserError)
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ NameMatcher -> Text -> DomPath -> ParserError
PEAttributeWrongFormat NameMatcher
attrName Text
err
      Right a
a  -> Maybe a
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe a)
forall a.
a -> ReaderT (ParserData Identity) (ExceptT ParserErrors m) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe a
 -> ReaderT
      (ParserData Identity) (ExceptT ParserErrors m) (Maybe a))
-> Maybe a
-> ReaderT (ParserData Identity) (ExceptT ParserErrors m) (Maybe a)
forall a b. (a -> b) -> a -> b
$ a -> Maybe a
forall a. a -> Maybe a
Just a
a

-- | Retuns map of attributes of current element
--
-- @since 1.0.0
getCurrentAttributes
  :: (Monad m)
  => DomParserT Identity m (M.Map Name Text)
getCurrentAttributes :: forall (m :: * -> *).
Monad m =>
DomParserT Identity m (Map Name Text)
getCurrentAttributes = Getting (Map Name Text) (ParserData Identity) (Map Name Text)
-> ReaderT
     (ParserData Identity) (ExceptT ParserErrors m) (Map Name Text)
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view (Getting (Map Name Text) (ParserData Identity) (Map Name Text)
 -> ReaderT
      (ParserData Identity) (ExceptT ParserErrors m) (Map Name Text))
-> Getting (Map Name Text) (ParserData Identity) (Map Name Text)
-> ReaderT
     (ParserData Identity) (ExceptT ParserErrors m) (Map Name Text)
forall a b. (a -> b) -> a -> b
$ (Identity Element -> Const (Map Name Text) (Identity Element))
-> ParserData Identity
-> Const (Map Name Text) (ParserData Identity)
forall (f1 :: * -> *) (f2 :: * -> *) (f3 :: * -> *).
Functor f3 =>
(f1 Element -> f3 (f2 Element))
-> ParserData f1 -> f3 (ParserData f2)
pdElements ((Identity Element -> Const (Map Name Text) (Identity Element))
 -> ParserData Identity
 -> Const (Map Name Text) (ParserData Identity))
-> ((Map Name Text -> Const (Map Name Text) (Map Name Text))
    -> Identity Element -> Const (Map Name Text) (Identity Element))
-> Getting (Map Name Text) (ParserData Identity) (Map Name Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity Element -> Element)
-> (Element -> Const (Map Name Text) Element)
-> Identity Element
-> Const (Map Name Text) (Identity Element)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Identity Element -> Element
forall a. Identity a -> a
runIdentity ((Element -> Const (Map Name Text) Element)
 -> Identity Element -> Const (Map Name Text) (Identity Element))
-> ((Map Name Text -> Const (Map Name Text) (Map Name Text))
    -> Element -> Const (Map Name Text) Element)
-> (Map Name Text -> Const (Map Name Text) (Map Name Text))
-> Identity Element
-> Const (Map Name Text) (Identity Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Name Text -> Const (Map Name Text) (Map Name Text))
-> Element -> Const (Map Name Text) Element
Lens' Element (Map Name Text)
attrs

-- | Returns element with given name or 'Nothing'
--
-- @since 1.0.0
getCurrentAttribute
  :: (Monad m)
  => NameMatcher
  -> DomParserT Identity m (Maybe Text)
getCurrentAttribute :: forall (m :: * -> *).
Monad m =>
NameMatcher -> DomParserT Identity m (Maybe Text)
getCurrentAttribute NameMatcher
attrName
  = Getting (First Text) (ParserData Identity) Text
-> ReaderT
     (ParserData Identity) (ExceptT ParserErrors m) (Maybe Text)
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview (Getting (First Text) (ParserData Identity) Text
 -> ReaderT
      (ParserData Identity) (ExceptT ParserErrors m) (Maybe Text))
-> Getting (First Text) (ParserData Identity) Text
-> ReaderT
     (ParserData Identity) (ExceptT ParserErrors m) (Maybe Text)
forall a b. (a -> b) -> a -> b
$ (Identity Element -> Const (First Text) (Identity Element))
-> ParserData Identity -> Const (First Text) (ParserData Identity)
forall (f1 :: * -> *) (f2 :: * -> *) (f3 :: * -> *).
Functor f3 =>
(f1 Element -> f3 (f2 Element))
-> ParserData f1 -> f3 (ParserData f2)
pdElements ((Identity Element -> Const (First Text) (Identity Element))
 -> ParserData Identity -> Const (First Text) (ParserData Identity))
-> ((Text -> Const (First Text) Text)
    -> Identity Element -> Const (First Text) (Identity Element))
-> Getting (First Text) (ParserData Identity) Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Identity Element -> Element)
-> (Element -> Const (First Text) Element)
-> Identity Element
-> Const (First Text) (Identity Element)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Identity Element -> Element
forall a. Identity a -> a
runIdentity ((Element -> Const (First Text) Element)
 -> Identity Element -> Const (First Text) (Identity Element))
-> ((Text -> Const (First Text) Text)
    -> Element -> Const (First Text) Element)
-> (Text -> Const (First Text) Text)
-> Identity Element
-> Const (First Text) (Identity Element)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Name Text -> Const (First Text) (Map Name Text))
-> Element -> Const (First Text) Element
Lens' Element (Map Name Text)
attrs ((Map Name Text -> Const (First Text) (Map Name Text))
 -> Element -> Const (First Text) Element)
-> ((Text -> Const (First Text) Text)
    -> Map Name Text -> Const (First Text) (Map Name Text))
-> (Text -> Const (First Text) Text)
-> Element
-> Const (First Text) Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map Name Text -> [(Name, Text)])
-> ([(Name, Text)] -> Const (First Text) [(Name, Text)])
-> Map Name Text
-> Const (First Text) (Map Name Text)
forall (p :: * -> * -> *) (f :: * -> *) s a.
(Profunctor p, Contravariant f) =>
(s -> a) -> Optic' p f s a
to Map Name Text -> [(Name, Text)]
forall k a. Map k a -> [(k, a)]
M.toList
  (([(Name, Text)] -> Const (First Text) [(Name, Text)])
 -> Map Name Text -> Const (First Text) (Map Name Text))
-> ((Text -> Const (First Text) Text)
    -> [(Name, Text)] -> Const (First Text) [(Name, Text)])
-> (Text -> Const (First Text) Text)
-> Map Name Text
-> Const (First Text) (Map Name Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Text) -> Const (First Text) (Name, Text))
-> [(Name, Text)] -> Const (First Text) [(Name, Text)]
forall (f :: * -> *) a b.
Traversable f =>
IndexedTraversal Int (f a) (f b) a b
IndexedTraversal
  Int [(Name, Text)] [(Name, Text)] (Name, Text) (Name, Text)
traversed (((Name, Text) -> Const (First Text) (Name, Text))
 -> [(Name, Text)] -> Const (First Text) [(Name, Text)])
-> ((Text -> Const (First Text) Text)
    -> (Name, Text) -> Const (First Text) (Name, Text))
-> (Text -> Const (First Text) Text)
-> [(Name, Text)]
-> Const (First Text) [(Name, Text)]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Name, Text) -> Bool)
-> Optic' (->) (Const (First Text)) (Name, Text) (Name, Text)
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (LensLike' (Const Bool) (Name, Text) Name
-> (Name -> Bool) -> (Name, Text) -> Bool
forall s (m :: * -> *) r a.
MonadReader s m =>
LensLike' (Const r) s a -> (a -> r) -> m r
views LensLike' (Const Bool) (Name, Text) Name
forall s t a b. Field1 s t a b => Lens s t a b
Lens (Name, Text) (Name, Text) Name Name
_1 (NameMatcher
attrName NameMatcher
-> Getting (Name -> Bool) NameMatcher (Name -> Bool)
-> Name
-> Bool
forall s a. s -> Getting a s a -> a
^. Getting (Name -> Bool) NameMatcher (Name -> Bool)
Lens' NameMatcher (Name -> Bool)
nmMatch)) Optic' (->) (Const (First Text)) (Name, Text) (Name, Text)
-> ((Text -> Const (First Text) Text)
    -> (Name, Text) -> Const (First Text) (Name, Text))
-> (Text -> Const (First Text) Text)
-> (Name, Text)
-> Const (First Text) (Name, Text)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> Const (First Text) Text)
-> (Name, Text) -> Const (First Text) (Name, Text)
forall s t a b. Field2 s t a b => Lens s t a b
Lens (Name, Text) (Name, Text) Text Text
_2