{-# LANGUAGE Rank2Types, FlexibleContexts #-}
{-# OPTIONS_GHC -fno-warn-orphans #-}
-----------------------------------------------------------------------------
-- |
-- Module      :  Text.XML.Lens
-- Copyright   :  (C) 2015 Fumiaki Kinoshita
-- License     :  BSD-style (see the file LICENSE)
--
-- Maintainer  :  Fumiaki Kinoshita <fumiexcel@gmail.com>
-- Stability   :  provisional
-- Portability :  non-portable
--
----------------------------------------------------------------------------
module Text.XML.Lens (
    -- * Lenses, traversals for 'Element'
    Element(..)
    , (...)
    -- ** Names
    , name
    , localName
    , el
    , ell
    , named
    -- ** Attributes
    , attributeIs
    , attributeSatisfies
    , attributeSatisfies'
    , withoutAttribute
    , attr
    , attribute
    , attrs
    -- ** Contents
    , text
    , comment
    -- ** Children
    , nodes
    -- * Prisms for 'Node'
    , Node(..)
    , _Element
    , _Content
    , AsInstruction(..)
    , AsComment(..)
    -- * Lenses for 'Document'
    , Document(..)
    , root
    , prologue
    , epilogue
    , doctype
    -- * Lenses for 'Name'
    , Name(..)
    , _nameLocalName
    , _nameNamespace
    , _namePrefix
    -- * Lenses for 'Instruction'
    , Instruction(..)
    , _instructionTarget
    , _instructionData
    ) where
import Text.XML
import Control.Lens
import Data.Text (Text)
import Data.Map (Map)
import qualified Data.CaseInsensitive as CI
import Data.Maybe (isNothing)

prologue :: Lens' Document Prologue
prologue :: (Prologue -> f Prologue) -> Document -> f Document
prologue Prologue -> f Prologue
f Document
doc = (Prologue -> Document) -> f Prologue -> f Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Prologue
p -> Document
doc { documentPrologue :: Prologue
documentPrologue = Prologue
p} ) (f Prologue -> f Document) -> f Prologue -> f Document
forall a b. (a -> b) -> a -> b
$ Prologue -> f Prologue
f (Prologue -> f Prologue) -> Prologue -> f Prologue
forall a b. (a -> b) -> a -> b
$ Document -> Prologue
documentPrologue Document
doc
{-# INLINE prologue #-}

-- | The root element of the document.
root :: Lens' Document Element
root :: (Element -> f Element) -> Document -> f Document
root Element -> f Element
f Document
doc = (Element -> Document) -> f Element -> f Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Element
p -> Document
doc { documentRoot :: Element
documentRoot = Element
p} ) (f Element -> f Document) -> f Element -> f Document
forall a b. (a -> b) -> a -> b
$ Element -> f Element
f (Element -> f Element) -> Element -> f Element
forall a b. (a -> b) -> a -> b
$ Document -> Element
documentRoot Document
doc
{-# INLINE root #-}

epilogue :: Lens' Document [Miscellaneous]
epilogue :: ([Miscellaneous] -> f [Miscellaneous]) -> Document -> f Document
epilogue [Miscellaneous] -> f [Miscellaneous]
f Document
doc = ([Miscellaneous] -> Document) -> f [Miscellaneous] -> f Document
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Miscellaneous]
p -> Document
doc { documentEpilogue :: [Miscellaneous]
documentEpilogue = [Miscellaneous]
p} ) (f [Miscellaneous] -> f Document)
-> f [Miscellaneous] -> f Document
forall a b. (a -> b) -> a -> b
$ [Miscellaneous] -> f [Miscellaneous]
f ([Miscellaneous] -> f [Miscellaneous])
-> [Miscellaneous] -> f [Miscellaneous]
forall a b. (a -> b) -> a -> b
$ Document -> [Miscellaneous]
documentEpilogue Document
doc
{-# INLINE epilogue #-}

doctype :: Lens' Prologue (Maybe Doctype)
doctype :: (Maybe Doctype -> f (Maybe Doctype)) -> Prologue -> f Prologue
doctype Maybe Doctype -> f (Maybe Doctype)
f Prologue
doc = (Maybe Doctype -> Prologue) -> f (Maybe Doctype) -> f Prologue
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Maybe Doctype
p -> Prologue
doc { prologueDoctype :: Maybe Doctype
prologueDoctype = Maybe Doctype
p} ) (f (Maybe Doctype) -> f Prologue)
-> f (Maybe Doctype) -> f Prologue
forall a b. (a -> b) -> a -> b
$ Maybe Doctype -> f (Maybe Doctype)
f (Maybe Doctype -> f (Maybe Doctype))
-> Maybe Doctype -> f (Maybe Doctype)
forall a b. (a -> b) -> a -> b
$ Prologue -> Maybe Doctype
prologueDoctype Prologue
doc
{-# INLINE doctype #-}

class AsInstruction t where
    _Instruction :: Prism' t Instruction

_instructionTarget :: Lens' Instruction Text
_instructionTarget :: (Text -> f Text) -> Instruction -> f Instruction
_instructionTarget Text -> f Text
f (Instruction Text
t Text
d) = Text -> f Text
f Text
t f Text -> (Text -> Instruction) -> f Instruction
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
t' -> Text -> Text -> Instruction
Instruction Text
t' Text
d
{-# INLINE _instructionTarget #-}

_instructionData :: Lens' Instruction Text
_instructionData :: (Text -> f Text) -> Instruction -> f Instruction
_instructionData Text -> f Text
f (Instruction Text
t Text
d) = Text -> f Text
f Text
d f Text -> (Text -> Instruction) -> f Instruction
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
d' -> Text -> Text -> Instruction
Instruction Text
t Text
d'
{-# INLINE _instructionData #-}

instance AsInstruction Node where
    _Instruction :: p Instruction (f Instruction) -> p Node (f Node)
_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 ((Node -> Maybe Instruction) -> Prism' Node Instruction)
-> (Node -> Maybe Instruction) -> Prism' Node Instruction
forall a b. (a -> b) -> a -> b
$ \Node
s -> case Node
s of
        NodeInstruction Instruction
e -> Instruction -> Maybe Instruction
forall a. a -> Maybe a
Just Instruction
e
        Node
_ -> Maybe Instruction
forall a. Maybe a
Nothing
    {-# INLINE _Instruction #-}

instance AsInstruction Miscellaneous where
    _Instruction :: p Instruction (f Instruction) -> p Miscellaneous (f Miscellaneous)
_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 ((Miscellaneous -> Maybe Instruction)
 -> Prism' Miscellaneous Instruction)
-> (Miscellaneous -> Maybe Instruction)
-> Prism' Miscellaneous Instruction
forall a b. (a -> b) -> a -> b
$ \Miscellaneous
s -> case Miscellaneous
s of
        MiscInstruction Instruction
e -> Instruction -> Maybe Instruction
forall a. a -> Maybe a
Just Instruction
e
        Miscellaneous
_ -> Maybe Instruction
forall a. Maybe a
Nothing
    {-# INLINE _Instruction #-}

class AsComment t where
    _Comment :: Prism' t Text

instance AsComment Node where
    _Comment :: p Text (f Text) -> p Node (f Node)
_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 ((Node -> Maybe Text) -> Prism' Node Text)
-> (Node -> Maybe Text) -> Prism' Node Text
forall a b. (a -> b) -> a -> b
$ \Node
s -> case Node
s of
        NodeComment Text
e -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e
        Node
_ -> Maybe Text
forall a. Maybe a
Nothing
    {-# INLINE _Comment #-}

instance AsComment Miscellaneous where
    _Comment :: p Text (f Text) -> p Miscellaneous (f Miscellaneous)
_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 ((Miscellaneous -> Maybe Text) -> Prism' Miscellaneous Text)
-> (Miscellaneous -> Maybe Text) -> Prism' Miscellaneous Text
forall a b. (a -> b) -> a -> b
$ \Miscellaneous
s -> case Miscellaneous
s of
        MiscComment Text
e -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e
        Miscellaneous
_ -> Maybe Text
forall a. Maybe a
Nothing
    {-# INLINE _Comment #-}

_nameLocalName :: Lens' Name Text
_nameLocalName :: (Text -> f Text) -> Name -> f Name
_nameLocalName Text -> f Text
f Name
n = Text -> f Text
f (Name -> Text
nameLocalName Name
n) f Text -> (Text -> Name) -> f Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Text
x -> Name
n { nameLocalName :: Text
nameLocalName = Text
x }
{-# INLINE _nameLocalName #-}

_nameNamespace :: Lens' Name (Maybe Text)
_nameNamespace :: (Maybe Text -> f (Maybe Text)) -> Name -> f Name
_nameNamespace Maybe Text -> f (Maybe Text)
f Name
n = Maybe Text -> f (Maybe Text)
f (Name -> Maybe Text
nameNamespace Name
n) f (Maybe Text) -> (Maybe Text -> Name) -> f Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
x -> Name
n { nameNamespace :: Maybe Text
nameNamespace = Maybe Text
x }
{-# INLINE _nameNamespace #-}

_namePrefix :: Lens' Name (Maybe Text)
_namePrefix :: (Maybe Text -> f (Maybe Text)) -> Name -> f Name
_namePrefix Maybe Text -> f (Maybe Text)
f Name
n = Maybe Text -> f (Maybe Text)
f (Name -> Maybe Text
namePrefix Name
n) f (Maybe Text) -> (Maybe Text -> Name) -> f Name
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Maybe Text
x -> Name
n { namePrefix :: Maybe Text
namePrefix = Maybe Text
x }
{-# INLINE _namePrefix #-}

_Element :: Prism' Node Element
_Element :: p Element (f Element) -> p Node (f Node)
_Element = (Element -> Node)
-> (Node -> Maybe Element) -> Prism Node Node Element Element
forall b s a. (b -> s) -> (s -> Maybe a) -> Prism s s a b
prism' Element -> Node
NodeElement ((Node -> Maybe Element) -> Prism Node Node Element Element)
-> (Node -> Maybe Element) -> Prism Node Node Element Element
forall a b. (a -> b) -> a -> b
$ \Node
s -> case Node
s of
    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 :: p Text (f Text) -> p Node (f Node)
_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 ((Node -> Maybe Text) -> Prism' Node Text)
-> (Node -> Maybe Text) -> Prism' Node Text
forall a b. (a -> b) -> a -> b
$ \Node
s -> case Node
s of
    NodeContent Text
e -> Text -> Maybe Text
forall a. a -> Maybe a
Just Text
e
    Node
_ -> Maybe Text
forall a. Maybe a
Nothing
{-# INLINE _Content #-}

name :: Lens' Element Name
name :: (Name -> f Name) -> Element -> f Element
name Name -> f Name
f Element
e = Name -> f Name
f (Element -> Name
elementName Element
e) f Name -> (Name -> Element) -> f Element
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Name
x -> Element
e { elementName :: Name
elementName = Name
x }
{-# INLINE name #-}

localName :: Lens' Element Text
localName :: (Text -> f Text) -> Element -> f Element
localName = (Name -> f Name) -> Element -> f Element
Lens' Element Name
name ((Name -> f Name) -> Element -> f Element)
-> ((Text -> f Text) -> Name -> f Name)
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Name -> f Name
Lens' Name Text
_nameLocalName
{-# INLINE localName #-}

attrs :: Lens' Element (Map Name Text)
attrs :: (Map Name Text -> f (Map Name Text)) -> Element -> f Element
attrs Map Name Text -> f (Map Name Text)
f Element
e = (Map Name Text -> Element) -> f (Map Name Text) -> f Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Map Name Text
x -> Element
e { elementAttributes :: Map Name Text
elementAttributes = Map Name Text
x }) (f (Map Name Text) -> f Element) -> f (Map Name Text) -> f Element
forall a b. (a -> b) -> a -> b
$ Map Name Text -> f (Map Name Text)
f (Map Name Text -> f (Map Name Text))
-> Map Name Text -> f (Map Name Text)
forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
elementAttributes Element
e
{-# INLINE attrs #-}

nodes :: Lens' Element [Node]
nodes :: ([Node] -> f [Node]) -> Element -> f Element
nodes [Node] -> f [Node]
f Element
e = ([Node] -> Element) -> f [Node] -> f Element
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Node]
x -> Element
e { elementNodes :: [Node]
elementNodes = [Node]
x }) (f [Node] -> f Element) -> f [Node] -> f Element
forall a b. (a -> b) -> a -> b
$ [Node] -> f [Node]
f ([Node] -> f [Node]) -> [Node] -> f [Node]
forall a b. (a -> b) -> a -> b
$ Element -> [Node]
elementNodes Element
e
{-# INLINE nodes #-}

attr :: Name -> Traversal' Element Text
attr :: Name -> Traversal' Element Text
attr Name
n = (Map Name Text -> f (Map Name Text)) -> Element -> f Element
Lens' Element (Map Name Text)
attrs ((Map Name Text -> f (Map Name Text)) -> Element -> f Element)
-> ((Text -> f Text) -> Map Name Text -> f (Map Name Text))
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Name Text)
-> Traversal' (Map Name Text) (IxValue (Map Name Text))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Name Text)
Name
n
{-# INLINE attr #-}

attribute :: Name -> Lens' Element (Maybe Text)
attribute :: Name -> Lens' Element (Maybe Text)
attribute Name
n = (Map Name Text -> f (Map Name Text)) -> Element -> f Element
Lens' Element (Map Name Text)
attrs ((Map Name Text -> f (Map Name Text)) -> Element -> f Element)
-> ((Maybe Text -> f (Maybe Text))
    -> Map Name Text -> f (Map Name Text))
-> (Maybe Text -> f (Maybe Text))
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Name Text)
-> Lens' (Map Name Text) (Maybe (IxValue (Map Name Text)))
forall m. At m => Index m -> Lens' m (Maybe (IxValue m))
at Index (Map Name Text)
Name
n
{-# INLINE attribute #-}

-- | Traverse elements which has the specified *local* name (case-insensitive).
named :: CI.CI Text -> Traversal' Element Element
named :: CI Text -> Traversal' Element Element
named CI Text
n Element -> f Element
f Element
s
    | Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk (Name -> Text
nameLocalName (Element -> Name
elementName Element
s)) CI Text -> CI Text -> Bool
forall a. Eq a => a -> a -> Bool
== CI Text
n = Element -> f Element
f Element
s
    | Bool
otherwise = Element -> f Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
s
{-# INLINE named #-}

-- | Old name for 'named'
ell :: Text -> Traversal' Element Element
ell :: Text -> Traversal' Element Element
ell = CI Text -> (Element -> f Element) -> Element -> f Element
CI Text -> Traversal' Element Element
named (CI Text -> (Element -> f Element) -> Element -> f Element)
-> (Text -> CI Text)
-> Text
-> (Element -> f Element)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> CI Text
forall s. FoldCase s => s -> CI s
CI.mk

-- | Traverse elements which has the specified name.
el :: Name -> Traversal' Element Element
el :: Name -> Traversal' Element Element
el Name
n Element -> f Element
f Element
s
    | Element -> Name
elementName Element
s Name -> Name -> Bool
forall a. Eq a => a -> a -> Bool
== Name
n = Element -> f Element
f Element
s
    | Bool
otherwise = Element -> f Element
forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
s
{-# DEPRECATED el "Use named instead" #-}

attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
attributeSatisfies :: Name -> (Text -> Bool) -> Traversal' Element Element
attributeSatisfies Name
n Text -> Bool
p = Name -> (Maybe Text -> Bool) -> Traversal' Element Element
attributeSatisfies' Name
n (Bool -> (Text -> Bool) -> Maybe Text -> Bool
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Bool
False Text -> Bool
p)
{-# INLINE attributeSatisfies #-}

attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
attributeSatisfies' :: Name -> (Maybe Text -> Bool) -> Traversal' Element Element
attributeSatisfies' Name
n Maybe Text -> Bool
p = (Element -> Bool) -> Optic' (->) f Element Element
forall (p :: * -> * -> *) (f :: * -> *) a.
(Choice p, Applicative f) =>
(a -> Bool) -> Optic' p f a a
filtered (Maybe Text -> Bool
p (Maybe Text -> Bool) -> (Element -> Maybe Text) -> Element -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting (First Text) Element Text -> Element -> Maybe Text
forall s (m :: * -> *) a.
MonadReader s m =>
Getting (First a) s a -> m (Maybe a)
preview ((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))
-> Getting (First Text) Element Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Index (Map Name Text)
-> Traversal' (Map Name Text) (IxValue (Map Name Text))
forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix Index (Map Name Text)
Name
n))
{-# INLINE attributeSatisfies' #-}

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

attributeIs :: Name -> Text -> Traversal' Element Element
attributeIs :: Name -> Text -> Traversal' Element Element
attributeIs Name
n Text
v = Name -> (Text -> Bool) -> Traversal' Element Element
attributeSatisfies Name
n (Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
==Text
v)
{-# INLINE attributeIs #-}

-- | Traverse all contents of the element.
text :: Traversal' Element Text
text :: (Text -> f Text) -> Element -> f Element
text = ([Node] -> f [Node]) -> Element -> f Element
Lens' Element [Node]
nodes (([Node] -> f [Node]) -> Element -> f Element)
-> ((Text -> f Text) -> [Node] -> f [Node])
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> f Node) -> [Node] -> f [Node]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Node -> f Node) -> [Node] -> f [Node])
-> ((Text -> f Text) -> Node -> f Node)
-> (Text -> f Text)
-> [Node]
-> f [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Node -> f Node
Prism' Node Text
_Content
{-# INLINE text #-}

-- | Traverse all comments of the element.
comment :: Traversal' Element Text
comment :: (Text -> f Text) -> Element -> f Element
comment = ([Node] -> f [Node]) -> Element -> f Element
Lens' Element [Node]
nodes (([Node] -> f [Node]) -> Element -> f Element)
-> ((Text -> f Text) -> [Node] -> f [Node])
-> (Text -> f Text)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> f Node) -> [Node] -> f [Node]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Node -> f Node) -> [Node] -> f [Node])
-> ((Text -> f Text) -> Node -> f Node)
-> (Text -> f Text)
-> [Node]
-> f [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Text -> f Text) -> Node -> f Node
forall t. AsComment t => Prism' t Text
_Comment
{-# INLINE comment #-}

-- | 'plate' traverses over its sub-elements.
instance Plated Element where
    plate :: (Element -> f Element) -> Element -> f Element
plate = ([Node] -> f [Node]) -> Element -> f Element
Lens' Element [Node]
nodes (([Node] -> f [Node]) -> Element -> f Element)
-> ((Element -> f Element) -> [Node] -> f [Node])
-> (Element -> f Element)
-> Element
-> f Element
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Node -> f Node) -> [Node] -> f [Node]
forall (t :: * -> *) (f :: * -> *) a b.
(Traversable t, Applicative f) =>
(a -> f b) -> t a -> f (t b)
traverse ((Node -> f Node) -> [Node] -> f [Node])
-> ((Element -> f Element) -> Node -> f Node)
-> (Element -> f Element)
-> [Node]
-> f [Node]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Element -> f Element) -> Node -> f Node
Prism Node Node Element Element
_Element
    {-# INLINE plate #-}