{-# LANGUAGE DataKinds #-}
{-# LANGUAGE LambdaCase #-}
{-# language ExistentialQuantification #-}
{-# language OverloadedStrings #-}
{-# language RecordWildCards #-}
{-# language Rank2Types #-}
{-# options_ghc -Wno-unused-imports #-}
module Text.XML.Lens.Micro (
subtree,
remapAttributes,
root,
prologue,
epilogue,
named,
nodes,
attrs,
attributeSatisfies,
attributeIs,
withoutAttribute,
) where
import Data.Maybe (fromMaybe, isNothing)
import Data.Monoid (First(..), Any(..))
import qualified Data.CaseInsensitive as CI
import qualified Data.Map as M (Map, insert, lookup, singleton, fromList, foldrWithKey)
import Lens.Micro.GHC (to, Getting, Lens', (^.), Traversal', ix, filtered)
import Lens.Micro.Extras (preview)
import Data.Text (Text)
import Text.XML (Prologue(..), Doctype(..), Document(..), Element(..), Name(..), Node(..), Miscellaneous(..))
root :: Lens' Document Element
root :: Lens' Document Element
root Element -> f Element
f Document
doc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Element
p -> Document
doc { documentRoot :: Element
documentRoot = Element
p} ) forall a b. (a -> b) -> a -> b
$ Element -> f Element
f forall a b. (a -> b) -> a -> b
$ Document -> Element
documentRoot Document
doc
{-# INLINE root #-}
prologue :: Lens' Document Prologue
prologue :: Lens' Document Prologue
prologue Prologue -> f Prologue
f Document
doc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\Prologue
p -> Document
doc { documentPrologue :: Prologue
documentPrologue = Prologue
p} ) forall a b. (a -> b) -> a -> b
$ Prologue -> f Prologue
f forall a b. (a -> b) -> a -> b
$ Document -> Prologue
documentPrologue Document
doc
{-# INLINE prologue #-}
epilogue :: Lens' Document [Miscellaneous]
epilogue :: Lens' Document [Miscellaneous]
epilogue [Miscellaneous] -> f [Miscellaneous]
f Document
doc = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Miscellaneous]
p -> Document
doc { documentEpilogue :: [Miscellaneous]
documentEpilogue = [Miscellaneous]
p} ) forall a b. (a -> b) -> a -> b
$ [Miscellaneous] -> f [Miscellaneous]
f forall a b. (a -> b) -> a -> b
$ Document -> [Miscellaneous]
documentEpilogue Document
doc
{-# INLINE epilogue #-}
named :: CI.CI Text -> Traversal' Element Element
named :: CI Text -> Traversal' Element Element
named CI Text
n Element -> f Element
f Element
s
| forall s. FoldCase s => s -> CI s
CI.mk (Name -> Text
nameLocalName (Element -> Name
elementName Element
s)) forall a. Eq a => a -> a -> Bool
== CI Text
n = Element -> f Element
f Element
s
| Bool
otherwise = forall (f :: * -> *) a. Applicative f => a -> f a
pure Element
s
{-# INLINE named #-}
nodes :: Lens' Element [Node]
nodes :: Lens' Element [Node]
nodes [Node] -> f [Node]
f Element
e = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (\[Node]
x -> Element
e { elementNodes :: [Node]
elementNodes = [Node]
x }) forall a b. (a -> b) -> a -> b
$ [Node] -> f [Node]
f forall a b. (a -> b) -> a -> b
$ Element -> [Node]
elementNodes Element
e
{-# INLINE nodes #-}
attrs :: Lens' Element (M.Map Name Text)
attrs :: Lens' Element (Map Name Text)
attrs Map Name Text -> f (Map Name Text)
f Element
e = 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 }) forall a b. (a -> b) -> a -> b
$ Map Name Text -> f (Map Name Text)
f forall a b. (a -> b) -> a -> b
$ Element -> Map Name Text
elementAttributes Element
e
{-# INLINE attrs #-}
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 (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 = forall a. (a -> Bool) -> Traversal' a a
filtered (Maybe Text -> Bool
p forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a s. Getting (First a) s a -> s -> Maybe a
preview (Lens' Element (Map Name Text)
attrs forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall m. Ixed m => Index m -> Traversal' m (IxValue m)
ix 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 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 (forall a. Eq a => a -> a -> Bool
== Text
v)
{-# INLINE attributeIs #-}
subtree :: (Text -> Bool)
-> (Text -> Text -> Bool)
-> Getting r Element (Maybe Element)
subtree :: forall r.
(Text -> Bool)
-> (Text -> Text -> Bool) -> Getting r Element (Maybe Element)
subtree Text -> Bool
f Text -> Text -> Bool
h = forall s a. (s -> a) -> SimpleGetter s a
to ((Text -> Bool)
-> (Text -> Text -> Bool) -> Element -> Maybe Element
_subtree Text -> Bool
f Text -> Text -> Bool
h)
_subtree :: (Text -> Bool)
-> (Text -> Text -> Bool) -> Element -> Maybe Element
_subtree :: (Text -> Bool)
-> (Text -> Text -> Bool) -> Element -> Maybe Element
_subtree Text -> Bool
f Text -> Text -> Bool
h el :: Element
el@(Element Name
n Map Name Text
ats [Node]
nds) = case Text -> Bool
f (Name -> Text
nameLocalName Name
n) Bool -> Bool -> Bool
&& (Any -> Bool
getAny forall a b. (a -> b) -> a -> b
$ forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
M.foldrWithKey (\Name
k Text
v Any
acc -> Bool -> Any
Any (Text -> Text -> Bool
h (Name -> Text
nameLocalName Name
k) Text
v) forall a. Semigroup a => a -> a -> a
<> Any
acc) forall a. Monoid a => a
mempty Map Name Text
ats) of
Bool
True -> forall a. a -> Maybe a
Just Element
el
Bool
False -> forall a. First a -> Maybe a
getFirst forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) m a.
(Foldable t, Monoid m) =>
(a -> m) -> t a -> m
foldMap (forall a. Maybe a -> First a
First forall b c a. (b -> c) -> (a -> b) -> a -> c
. Node -> Maybe Element
g) [Node]
nds
where
g :: Node -> Maybe Element
g = \case
NodeElement Element
e -> (Text -> Bool)
-> (Text -> Text -> Bool) -> Element -> Maybe Element
_subtree Text -> Bool
f Text -> Text -> Bool
h Element
e
Node
_ -> forall a. Maybe a
Nothing
remapAttributes ::
(Name -> M.Map Name Text -> Maybe (M.Map Name Text))
-> Getting r Element Element
remapAttributes :: forall r.
(Name -> Map Name Text -> Maybe (Map Name Text))
-> Getting r Element Element
remapAttributes Name -> Map Name Text -> Maybe (Map Name Text)
f = forall s a. (s -> a) -> SimpleGetter s a
to ((Name -> Map Name Text -> Maybe (Map Name Text))
-> Element -> Element
_remapAttributes Name -> Map Name Text -> Maybe (Map Name Text)
f)
_remapAttributes :: (Name -> M.Map Name Text -> Maybe (M.Map Name Text))
-> Element -> Element
_remapAttributes :: (Name -> Map Name Text -> Maybe (Map Name Text))
-> Element -> Element
_remapAttributes Name -> Map Name Text -> Maybe (Map Name Text)
f el :: Element
el@(Element Name
n Map Name Text
ats [Node]
_) =
Element
el{ elementAttributes :: Map Name Text
elementAttributes = forall a. a -> Maybe a -> a
fromMaybe Map Name Text
ats (Name -> Map Name Text -> Maybe (Map Name Text)
f Name
n Map Name Text
ats),
elementNodes :: [Node]
elementNodes = forall a b. (a -> b) -> [a] -> [b]
map (\Node
nn -> case Node
nn of
NodeElement Element
e -> Element -> Node
NodeElement ((Name -> Map Name Text -> Maybe (Map Name Text))
-> Element -> Element
_remapAttributes Name -> Map Name Text -> Maybe (Map Name Text)
f Element
e)
Node
x -> Node
x
) forall a b. (a -> b) -> a -> b
$ Element -> [Node]
elementNodes Element
el }