module Text.XML.Hexml.Lens
(
_children
, XML(..)
, node
, multiple
) where
import Control.Arrow
import Control.Lens hiding (children)
import qualified Data.ByteString as Strict
import qualified Data.ByteString.Internal as Strict
import qualified Data.ByteString.Lazy as Lazy
import Data.ByteString.Lens
import Data.Functor.Contravariant
import Data.Profunctor.Unsafe
import Data.String
import qualified Data.Text as Strict
import qualified Data.Text.Encoding as Strict
import qualified Data.Text.Lazy as Lazy
import qualified Data.Text.Lazy.Encoding as Lazy
import Data.Text.Lens
import qualified Foundation as F
import qualified Foundation.Array.Internal as F
import qualified Foundation.String as F
import Text.XML.Hexml
_children :: Getter Node [Node]
_children = to children
class XML s where
_XML :: Prism' s Node
_contents :: Fold Node (Either s Node)
_inner :: Getter Node s
_outer :: Getter Node s
textContents :: Fold Node s
_Attribute :: s -> Getter Node (Maybe s)
iattributes :: IndexedFold String Node s
nodes :: s -> Getter Node [Node]
node :: XML s => s -> Fold Node Node
node n = nodes n . folded
instance XML String where
_XML = strictUtf8 . _XML @ Strict.ByteString
_contents = _contents . firsting (from strictUtf8)
_inner = _inner . from strictUtf8
_outer = _outer . from strictUtf8
textContents = textContents @Strict.ByteString . from strictUtf8
_Attribute n = _Attribute(n ^. packedChars).mapping(from strictUtf8)
iattributes = iattributes @ Strict.ByteString . unpackedChars
nodes name_ = nodes ( name_ ^. strictUtf8)
instance XML F.String where
_contents = _contents . lefting (foundation F.UTF8)
_inner = _inner . foundation F.UTF8
_outer = _outer . foundation F.UTF8
textContents = textContents . foundation F.UTF8
_Attribute n = pre $ to (`attributeBy` (F.toList n ^. packedChars)) . folded . to attributeValue . foundation F.UTF8
iattributes = iattributes . to fromString
nodes name_ = nodes ( F.toList name_ ^. strictUtf8)
instance XML Strict.Text where
_XML = strictTextUtf8 . _XML
_contents = _contents . firsting (from strictTextUtf8)
_inner = _inner . from strictTextUtf8
_outer = _outer . from strictTextUtf8
textContents = textContents . from strictTextUtf8
_Attribute n = _Attribute(n ^. strictTextUtf8).mapping(from strictTextUtf8)
iattributes = iattributes . packed
nodes name_ = nodes ( name_ ^. strictTextUtf8 )
instance XML Lazy.Text where
_XML = lazyTextUtf8 . _XML
_contents = _contents . firsting lazy
_inner = _inner . lazy
_outer = _outer . lazy
textContents = textContents . from lazyTextUtf8
_Attribute n = _Attribute(n ^. lazyTextUtf8).mapping(from lazyTextUtf8)
iattributes = iattributes . packed
nodes name_ = nodes ( name_ ^. lazyTextUtf8 )
instance XML Strict.ByteString where
_XML = prism' outer doParse where
doParse x =
case parse x of
Right n -> Just $ case children n of [y] -> y ; _ -> n
Left _ -> Nothing
_contents = folding contents
_inner = to inner
_outer = to outer
textContents = folding contents . _Left
_Attribute n = pre $ to(`attributeBy` n).folded.to(attributeValue)
iattributes = ifolding (map (\ (Attribute n v) -> (n^.from strictUtf8, v)) . attributes )
nodes name_ = to $ flip childrenBy name_
instance XML Lazy.ByteString where
_XML = strict . _XML @ Strict.ByteString
_contents = _contents . firsting lazy
_inner = _inner . lazy
_outer = _outer . lazy
textContents = textContents . lazy
_Attribute n = _Attribute(n^.strict).mapping(lazy)
iattributes = iattributes.lazy
nodes name_ = nodes (name_ ^. strict)
lazyTextUtf8 :: Iso' Lazy.Text Lazy.ByteString
lazyTextUtf8 = iso Lazy.encodeUtf8 Lazy.decodeUtf8
strictTextUtf8 :: Iso' Strict.Text Strict.ByteString
strictTextUtf8 = iso Strict.encodeUtf8 Strict.decodeUtf8
strictUtf8 :: Iso' String Strict.ByteString
strictUtf8 = packed . strictTextUtf8
foundation :: F.Encoding -> Getter Strict.ByteString F.String
foundation encoding = to (F.fromBytes encoding . fromByteString) . _1
where
fromByteString = F.fromForeignPtr . Strict.toForeignPtr
lefting :: Fold l l' -> Fold (Either l a) (Either l' a)
lefting fold = runFold (left $ Fold fold)
multiple :: Getting [a] s a -> IndexPreservingGetter s [a]
multiple l = dimap (getConst #. l (Const #. (:[]))) phantom