{-# LANGUAGE CPP #-}

module Text.XML.Optics
  ( -- * Document
    Document (..),

    -- ** Lenses
    root,
    prologue,
    epilogue,

    -- * Node
    Node (..),

    -- ** Prisms
    _Element,
    _Content,
    CanbeInstruction (..),
    CanbeComment (..),

    -- * Element
    Element (..),

    -- ** Lenses
    attrs,
    nodes,
    name,

    -- ** Traversals

    -- *** Filtering elements
    el,
    named,
    attr,
    attributeSatisfies,
    withoutAttribute,
    attributeIs,

    -- *** Traversing subnodes
    lower,
    plate,
    text,
    comment,

    -- * Composing traversals
    (./),
    (.//),

    -- * Name
    Name (..),

    -- ** Lenses
    localName,
    namespace,
    prefix,
  )
where

import Data.Map.Strict (Map)
import Data.Maybe
import Data.Text (Text)
import Optics.Core
import Text.XML

root :: Lens' Document Element
root :: Lens' Document Element
root = (Document -> Element)
-> (Document -> Element -> Document) -> Lens' Document Element
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Document -> Element
documentRoot (\Document
d Element
r -> Document
d {documentRoot :: Element
documentRoot = Element
r})
{-# INLINE root #-}

prologue :: Lens' Document Prologue
prologue :: Lens' Document Prologue
prologue = (Document -> Prologue)
-> (Document -> Prologue -> Document) -> Lens' Document Prologue
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Document -> Prologue
documentPrologue (\Document
d Prologue
p -> Document
d {documentPrologue :: Prologue
documentPrologue = Prologue
p})
{-# INLINE prologue #-}

epilogue :: Lens' Document [Miscellaneous]
epilogue :: Lens' Document [Miscellaneous]
epilogue = (Document -> [Miscellaneous])
-> (Document -> [Miscellaneous] -> Document)
-> Lens' Document [Miscellaneous]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Document -> [Miscellaneous]
documentEpilogue (\Document
d [Miscellaneous]
e -> Document
d {documentEpilogue :: [Miscellaneous]
documentEpilogue = [Miscellaneous]
e})
{-# INLINE epilogue #-}

name :: Lens' Element Name
name :: Lens' Element Name
name = (Element -> Name)
-> (Element -> Name -> Element) -> Lens' Element Name
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Element -> Name
elementName (\Element
e Name
n -> Element
e {elementName :: Name
elementName = Name
n})
{-# INLINE name #-}

attrs :: Lens' Element (Map Name Text)
attrs :: Lens' Element (Map Name Text)
attrs = (Element -> Map Name Text)
-> (Element -> Map Name Text -> Element)
-> Lens' Element (Map Name Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Element -> Map Name Text
elementAttributes (\Element
e Map Name Text
a -> Element
e {elementAttributes :: Map Name Text
elementAttributes = Map Name Text
a})
{-# INLINE attrs #-}

nodes :: Lens' Element [Node]
nodes :: Lens' Element [Node]
nodes = (Element -> [Node])
-> (Element -> [Node] -> Element) -> Lens' Element [Node]
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Element -> [Node]
elementNodes (\Element
e [Node]
ns -> Element
e {elementNodes :: [Node]
elementNodes = [Node]
ns})
{-# INLINE nodes #-}

localName :: Lens' Name Text
localName :: Lens' Name Text
localName = (Name -> Text) -> (Name -> Text -> Name) -> Lens' Name Text
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Name -> Text
nameLocalName (\Name
n Text
lc -> Name
n {nameLocalName :: Text
nameLocalName = Text
lc})
{-# INLINE localName #-}

namespace :: Lens' Name (Maybe Text)
namespace :: Lens' Name (Maybe Text)
namespace = (Name -> Maybe Text)
-> (Name -> Maybe Text -> Name) -> Lens' Name (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Name -> Maybe Text
nameNamespace (\Name
n Maybe Text
ns -> Name
n {nameNamespace :: Maybe Text
nameNamespace = Maybe Text
ns})
{-# INLINE namespace #-}

prefix :: Lens' Name (Maybe Text)
prefix :: Lens' Name (Maybe Text)
prefix = (Name -> Maybe Text)
-> (Name -> Maybe Text -> Name) -> Lens' Name (Maybe Text)
forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
lens Name -> Maybe Text
namePrefix (\Name
n Maybe Text
pfx -> Name
n {namePrefix :: Maybe Text
namePrefix = Maybe Text
pfx})
{-# INLINE prefix #-}

_Element :: Prism' Node Element
_Element :: Prism' Node Element
_Element = (Element -> Node) -> (Node -> Maybe Element) -> Prism' Node Element
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Element -> Node
NodeElement (\case NodeElement Element
e -> Element -> Maybe Element
forall a. a -> Maybe a
Just Element
e; Node
_ -> Maybe Element
forall a. Maybe a
Nothing)
{-# INLINE _Element #-}

_Content :: Prism' Node Text
_Content :: Prism' Node Text
_Content = (Text -> Node) -> (Node -> Maybe Text) -> Prism' Node Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> Node
NodeContent (\case NodeContent Text
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c; Node
_ -> Maybe Text
forall a. Maybe a
Nothing)
{-# INLINE _Content #-}

class CanbeInstruction t where
  _Instruction :: Prism' t Instruction

class CanbeComment t where
  _Comment :: Prism' t Text

instance CanbeInstruction Node where
  _Instruction :: Prism' Node Instruction
_Instruction = (Instruction -> Node)
-> (Node -> Maybe Instruction) -> Prism' Node Instruction
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Instruction -> Node
NodeInstruction (\case NodeInstruction Instruction
i -> Instruction -> Maybe Instruction
forall a. a -> Maybe a
Just Instruction
i; Node
_ -> Maybe Instruction
forall a. Maybe a
Nothing)
  {-# INLINE _Instruction #-}

instance CanbeInstruction Miscellaneous where
  _Instruction :: Prism' Miscellaneous Instruction
_Instruction = (Instruction -> Miscellaneous)
-> (Miscellaneous -> Maybe Instruction)
-> Prism' Miscellaneous Instruction
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Instruction -> Miscellaneous
MiscInstruction (\case MiscInstruction Instruction
i -> Instruction -> Maybe Instruction
forall a. a -> Maybe a
Just Instruction
i; Miscellaneous
_ -> Maybe Instruction
forall a. Maybe a
Nothing)
  {-# INLINE _Instruction #-}

instance CanbeComment Node where
  _Comment :: Prism' Node Text
_Comment = (Text -> Node) -> (Node -> Maybe Text) -> Prism' Node Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> Node
NodeComment (\case NodeComment Text
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c; Node
_ -> Maybe Text
forall a. Maybe a
Nothing)
  {-# INLINE _Comment #-}

instance CanbeComment Miscellaneous where
  _Comment :: Prism' Miscellaneous Text
_Comment = (Text -> Miscellaneous)
-> (Miscellaneous -> Maybe Text) -> Prism' Miscellaneous Text
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Text -> Miscellaneous
MiscComment (\case MiscComment Text
c -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
c; Miscellaneous
_ -> Maybe Text
forall a. Maybe a
Nothing)
  {-# INLINE _Comment #-}

el :: Name -> AffineTraversal' Element Element
el :: Name -> AffineTraversal' Element Element
el Name
n =
  (Element -> Either Element Element)
-> (Element -> Element -> Element)
-> AffineTraversal' Element Element
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\Element
e -> if Element
e Element -> Lens' Element Name -> Name
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Element Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n then Element -> Either Element Element
forall a b. b -> Either a b
Right Element
e else Element -> Either Element Element
forall a b. a -> Either a b
Left Element
e)
    (\Element
e Element
e' -> if Element
e Element -> Lens' Element Name -> Name
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Element Name
name Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n then Element
e' else Element
e)
{-# INLINE el #-}

named :: Text -> AffineTraversal' Element Element
named :: Text -> AffineTraversal' Element Element
named Text
n =
  (Element -> Either Element Element)
-> (Element -> Element -> Element)
-> AffineTraversal' Element Element
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\Element
e -> if Element
e Element -> Optic' A_Lens '[] Element Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Element Name
name Lens' Element Name
-> Lens' Name Text -> Optic' A_Lens '[] Element Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' Name Text
localName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n then Element -> Either Element Element
forall a b. b -> Either a b
Right Element
e else Element -> Either Element Element
forall a b. a -> Either a b
Left Element
e)
    (\Element
e Element
e' -> if Element
e Element -> Optic' A_Lens '[] Element Text -> Text
forall k s (is :: IxList) a.
Is k A_Getter =>
s -> Optic' k is s a -> a
^. Lens' Element Name
name Lens' Element Name
-> Lens' Name Text -> Optic' A_Lens '[] Element Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Lens' Name Text
localName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text
n then Element
e' else Element
e)
{-# INLINE named #-}

attr :: Name -> AffineTraversal' Element Text
attr :: Name -> AffineTraversal' Element Text
attr Name
n = Lens' Element (Map Name Text)
attrs Lens' Element (Map Name Text)
-> Optic
     An_AffineTraversal '[] (Map Name Text) (Map Name Text) Text Text
-> AffineTraversal' Element Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Index (Map Name Text)
-> Optic'
     (IxKind (Map Name Text))
     '[]
     (Map Name Text)
     (IxValue (Map Name Text))
forall m. Ixed m => Index m -> Optic' (IxKind m) '[] m (IxValue m)
ix Index (Map Name Text)
Name
n
{-# INLINE attr #-}

attributeSatisfies :: Name -> (Maybe Text -> Bool) -> AffineTraversal' Element Element
attributeSatisfies :: Name -> (Maybe Text -> Bool) -> AffineTraversal' Element Element
attributeSatisfies Name
n Maybe Text -> Bool
f =
  (Element -> Either Element Element)
-> (Element -> Element -> Element)
-> AffineTraversal' Element Element
forall s t a b.
(s -> Either t a) -> (s -> b -> t) -> AffineTraversal s t a b
atraversal
    (\Element
e -> if Maybe Text -> Bool
f (Element
e Element -> AffineTraversal' Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Name -> AffineTraversal' Element Text
attr Name
n) then Element -> Either Element Element
forall a b. b -> Either a b
Right Element
e else Element -> Either Element Element
forall a b. a -> Either a b
Left Element
e)
    (\Element
e Element
e' -> if Maybe Text -> Bool
f (Element
e Element -> AffineTraversal' Element Text -> Maybe Text
forall k s (is :: IxList) a.
Is k An_AffineFold =>
s -> Optic' k is s a -> Maybe a
^? Name -> AffineTraversal' Element Text
attr Name
n) then Element
e' else Element
e)
{-# INLINE attributeSatisfies #-}

withoutAttribute :: Name -> AffineTraversal' Element Element
withoutAttribute :: Name -> AffineTraversal' Element Element
withoutAttribute Name
n = Name -> (Maybe Text -> Bool) -> AffineTraversal' Element Element
attributeSatisfies Name
n Maybe Text -> Bool
forall a. Maybe a -> Bool
isNothing
{-# INLINE withoutAttribute #-}

attributeIs :: Name -> Text -> AffineTraversal' Element Element
attributeIs :: Name -> Text -> AffineTraversal' Element Element
attributeIs Name
n Text
t = Name -> (Maybe Text -> Bool) -> AffineTraversal' Element Element
attributeSatisfies Name
n (Maybe Text -> Maybe Text -> Bool
forall a. Eq a => a -> a -> Bool
== Text -> Maybe Text
forall a. a -> Maybe a
Just Text
t)
{-# INLINE attributeIs #-}

-- | Traverse all the subnodes of an 'Element'
lower :: IxTraversal' Int Element Node
lower :: IxTraversal' Int Element Node
lower = Lens' Element [Node]
nodes Lens' Element [Node]
-> Optic A_Traversal (WithIx Int) [Node] [Node] Node Node
-> IxTraversal' Int Element Node
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic A_Traversal (WithIx Int) [Node] [Node] Node Node
forall i (f :: Type -> Type) a b.
TraversableWithIndex i f =>
IxTraversal i (f a) (f b) a b
itraversed
{-# INLINE lower #-}

-- | 'lower' then select all the 'NodeElement's
plate :: IxTraversal' Int Element Element
plate :: IxTraversal' Int Element Element
plate = IxTraversal' Int Element Node
lower IxTraversal' Int Element Node
-> Prism' Node Element -> IxTraversal' Int Element Element
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Prism' Node Element
_Element
{-# INLINE plate #-}

-- | 'lower' then select all the 'NodeContent's
text :: IxTraversal' Int Element Text
text :: IxTraversal' Int Element Text
text = IxTraversal' Int Element Node
lower IxTraversal' Int Element Node
-> Prism' Node Text -> IxTraversal' Int Element Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Prism' Node Text
_Content
{-# INLINE text #-}

-- | 'lower' then select all the 'NodeComment's
comment :: IxTraversal' Int Element Text
comment :: IxTraversal' Int Element Text
comment = IxTraversal' Int Element Node
lower IxTraversal' Int Element Node
-> Prism' Node Text -> IxTraversal' Int Element Text
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Prism' Node Text
forall t. CanbeComment t => Prism' t Text
_Comment
{-# INLINE comment #-}

infixr 9 ./

-- | Compose two 'Traversal'' using 'plate'
--
-- @t1 './' t2 = t1 '%' 'plate' '%' t2@
#if MIN_VERSION_optics_core(0,4,0)
(./) :: (JoinKinds k1 l m, JoinKinds k2 A_Traversal k1,
 AppendIndices is1 js ks, AppendIndices is2 (WithIx Int) is1) =>
  Optic k2 is2 s t Element Element
  -> Optic l js Element Element a b -> Optic m ks s t a b
#else
(./) :: (Is (Join k A_Traversal) (Join (Join k A_Traversal) l), Is l (Join (Join k A_Traversal) l), Is k (Join k A_Traversal), Is A_Traversal (Join k A_Traversal)) => Optic k is s t Element Element -> Optic l js Element Element a b -> Optic (Join (Join k A_Traversal) l) (Append (Append is (WithIx Int)) js) s t a b
#endif
Optic k2 is2 s t Element Element
o1 ./ :: Optic k2 is2 s t Element Element
-> Optic l js Element Element a b -> Optic m ks s t a b
./ Optic l js Element Element a b
o2 = Optic k2 is2 s t Element Element
o1 Optic k2 is2 s t Element Element
-> IxTraversal' Int Element Element
-> Optic k1 is1 s t Element Element
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% IxTraversal' Int Element Element
plate Optic k1 is1 s t Element Element
-> Optic l js Element Element a b -> Optic m ks s t a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l js Element Element a b
o2
{-# INLINE (./) #-}

infixr 9 .//

-- | A version of './' that ignores the index from 'plate'
--
-- @t1 './/' t1 = t1 '<%' 'plate' '%' t2@
#if MIN_VERSION_optics_core(0,4,0)
(.//) :: (AppendIndices is js ks, JoinKinds k1 l m,
 JoinKinds k2 A_Traversal k1) =>
  Optic k2 is s t Element Element
  -> Optic l js Element Element a b -> Optic m ks s t a b
#else
(.//) :: (Is (Join k A_Traversal) (Join (Join k A_Traversal) l), Is l (Join (Join k A_Traversal) l), Is k (Join k A_Traversal), Is A_Traversal (Join k A_Traversal)) => Optic k is s t Element Element -> Optic l js Element Element a b -> Optic (Join (Join k A_Traversal) l) (Append is js) s t a b
#endif
Optic k2 is s t Element Element
o1 .// :: Optic k2 is s t Element Element
-> Optic l js Element Element a b -> Optic m ks s t a b
.// Optic l js Element Element a b
o2 = Optic k2 is s t Element Element
o1 Optic k2 is s t Element Element
-> IxTraversal' Int Element Element
-> Optic k1 is s t Element Element
forall k l m u v a b (js :: IxList) (is :: IxList) s t.
(JoinKinds k l m, IxOptic l u v a b, NonEmptyIndices js) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m is s t a b
<% IxTraversal' Int Element Element
plate Optic k1 is s t Element Element
-> Optic l js Element Element a b -> Optic m ks s t a b
forall k l m (is :: IxList) (js :: IxList) (ks :: IxList) s t u v a
       b.
(JoinKinds k l m, AppendIndices is js ks) =>
Optic k is s t u v -> Optic l js u v a b -> Optic m ks s t a b
% Optic l js Element Element a b
o2
{-# INLINE (.//) #-}